Option Compare Database
Option Explicit
' プリンタアクセス権を定義する構造体の宣言
Type PRINTER_DEFAULTS
pDatatype As Long
pDevMode As Long
DesiredAccess As Long
End Type
' 標準的な権利を要求することを示す定数の宣言
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
' プリンタアクセス権の管理者権限を示す定数の宣言
Public Const PRINTER_ACCESS_ADMINISTER = &H4&
' プリンタアクセス権のユーザー権限を示す定数の宣言
Public Const PRINTER_ACCESS_USE = &H8&
' プリンタアクセス権すべての権限を示す定数の宣言
Public Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or
PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)
' プリンタのオブジェクトハンドルを取得する関数の宣言
Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal
pPrinterName As String, phPrinter As Long, pDefault As Any) As Long
' 幅と高さを定義する構造体の宣言
Type SIZEL
cx As Long
cy As Long
End Type
' 矩形を定義する構造体の宣言
Type RECTL
left As Long
top As Long
right As Long
bottom As Long
End Type
' 用紙情報を定義する構造体の宣言
Type FORM_INFO_1
Flags As Long
pName As Long
Size As SIZEL
ImageableArea As RECTL
End Type
' ユーザー定義の用紙を示す定数の宣言
Public Const FORM_USER = &H0&
' ユーザー定義の用紙を示す定数の宣言
Public Const FORM_BUILTIN = &H1&
' ユーザー定義の用紙を示す定数の宣言
Public Const FORM_PRINTER = &H2&
' プリンタの用紙情報を追加する関数の宣言
Declare Function AddForm Lib "winspool.drv" Alias "AddFormA" (ByVal hPrinter
As Long, ByVal Level As Long, pForm As Any) As Long
' プリンタの用紙情報を削除する関数の宣言
Declare Function DeleteForm Lib "winspool.drv" Alias "DeleteFormA" (ByVal
hPrinter As Long, ByVal pFormName As String) As Long
' プリンタのオブジェクトハンドルを破棄する関数の宣言
Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As
Long
Public Sub PaperMake(strPaperName As String, lngHaba As Long, lngHight As
Long)
Dim strPrinterDeviceName As String
Dim udtPrinterDefaults As PRINTER_DEFAULTS
Dim lngPrinterHandle As Long
Dim lngFormInfo1Level As Long
Dim strFormInfo1Name As String
Dim udtFormInfo1 As FORM_INFO_1
Dim lngWin32apiResultCode As Long
' プリンタ名を指定
strPrinterDeviceName = Printer.DeviceName
' プリンタアクセス権を指定
With udtPrinterDefaults
.DesiredAccess = PRINTER_ALL_ACCESS
End With
' プリンタのオブジェクトハンドルを取得
lngWin32apiResultCode = OpenPrinter(strPrinterDeviceName, lngPrinterHandle,
udtPrinterDefaults)
' 構造体のレベルを指定
' 用紙名を一旦削除
strFormInfo1Name = strPaperName
' 用紙情報を削除
lngWin32apiResultCode = DeleteForm(lngPrinterHandle, strFormInfo1Name)
'
lngFormInfo1Level = 1
' 特性を指定
With udtFormInfo1
' 特性にユーザー定義を指定
.Flags = FORM_USER
' 用紙名を指定
strFormInfo1Name = StrConv(strPaperName, vbFromUnicode)
.pName = StrPtr(strFormInfo1Name)
' 幅と高さを指定
.Size.cx = lngHaba * 1000
.Size.cy = lngHight * 1000
' 印刷範囲を指定
.ImageableArea.left = 0
.ImageableArea.top = 0
.ImageableArea.right = lngHaba * 1000
.ImageableArea.bottom = lngHight * 1000
End With
' 用紙情報を追加
lngWin32apiResultCode = AddForm(lngPrinterHandle, lngFormInfo1Level,
udtFormInfo1)
'lngWin32apiResultCode=(1:OK 0：NG)
' プリンタオブジェクトをクローズ
lngWin32apiResultCode = ClosePrinter(lngPrinterHandle)
End Sub
|
