'================================================================
'= プリンタの用紙情報を取得
'=    (GetForm.bas)
'================================================================
#include "Windows.bi"

Type PRINTER_DEFAULTS
    pDatatype     As Long
    pDevMode      As Long
    DesiredAccess As Long
End Type

Type SIZE
    cx As Long
    cy As Long
End Type

Type RECT
    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 SIZE
    ImageableArea As RECT
End Type

Type PRINTER_INFO_5
    pPrinterName             As Long
    pPortName                As Long
    Attributes               As Long
    DeviceNotSelectedTimeout As Long
    TransmissionRetryTimeout As Long
End Type

#define STANDARD_RIGHTS_REQUIRED &HF0000 '標準的な権利を要求することを示す定数
#define PRINTER_ACCESS_ADMINISTER &H4   'プリンタアクセス権の管理者権限を示す
#define PRINTER_ACCESS_USE &H8          'プリンタアクセス権のユーザー権限を示す
#define PRINTER_ALL_ACCESS (&HF0000 or &H4 or &H8) '
#define PRINTER_ENUM_NAME &H8           'Nameで指定されたプリンタを列挙
#define MAX_DEVICENAME 64               '
#define FORM_USER &H0                   '
#define FORM_BUILTIN &H1                '
#define FORM_PRINTER &H2                '

' プリンタ用の指定されたフォームを記述するデータで FORM_INFO_1 構造体を初期化
Declare Function Api_GetForm& Lib "winspool.drv" Alias "GetFormA" (ByVal hPrinter&, ByVal pFormName$, ByVal Level&, pForm As Any, ByVal cbBuf&, pcbNeeded&)

' プリンタの詳細な情報を取得
Declare Function Api_EnumPrinters& Lib "winspool.drv" Alias "EnumPrintersA" (ByVal Flags&, ByVal Name$, ByVal Level&, pPrinterEnum As Any, ByVal cdBuf&, pcbNeededed&, pcReturned&)

' プリンタオブジェクトをオープン
Declare Function Api_OpenPrinter& Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName$, phPrinter&, pDefault As Any)

' メモリの指定領域をコピー
Declare Sub MoveMemory Lib "Kernel32" Alias "RtlMoveMemory" (Dest As Any, Source As Any, ByVal Length&)

' 文字列をコピーする
Declare Function Api_lstrcpy& Lib "Kernel32" Alias "lstrcpy" (lpszString1 As Any, lpszString2 As Any)

' プリンタオブジェクトを閉じる
Declare Function Api_ClosePrinter& Lib "winspool.drv" Alias "ClosePrinter" (ByVal hPrinter&)

Var Shared Edit1 As Object
Var Shared List1 As Object
Var Shared Combo1 As Object
Var Shared Button1 As Object

Edit1.Attach GetDlgItem("Edit1") : Edit1.SetFontSize 14
List1.Attach GetDlgItem("List1") : List1.SetFontSize 14
List1.SetWindowSize 216, 74
Combo1.Attach GetDlgItem("Combo1") : Combo1.SetFontSize 14
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize　14

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    Var PrinterServer As String
    Var PrinterName As String
    Var PortName As String
    Var Needed As Long
    Var Returned As Long
    Var Level As Long
    Var cnt As Long
    Var Ret As Long

    PrinterServer = ""
    Level = 5

    Ret = Api_EnumPrinters(PRINTER_ENUM_NAME, PrinterServer, Level, Chr$(0), 0, Needed, Returned)
    If Needed = 0 Then End

    Var Buffer(Needed - 1) As Byte
    Ret = Api_EnumPrinters(PRINTER_ENUM_NAME, PrinterServer, Level, Buffer(0), Needed, Needed, Returned)

    Var pi5(Returned - 1) As PRINTER_INFO_5

    For cnt = 0 To Returned - 1
        MoveMemory pi5(cnt), Buffer(cnt * Len(pi5(cnt))), Len(pi5(cnt))

        'プリンタ名取得
        PrinterName = String$(MAX_DEVICENAME, Chr$(0))
        MoveMemory PrinterName, ByVal pi5(cnt).pPrinterName, Len(PrinterName)
        PrinterName = Left$(PrinterName, InStr(PrinterName, Chr$(0)) - 1)
        Combo1.AddString PrinterName
    Next
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var DeviceName  As String
    Var pd As PRINTER_DEFAULTS
    Var hPrinter As Long
    Var InfoName As String
    Var Level As Long
    Var Needed As Long
    Var fi1 As FORM_INFO_1
    Var strFormName As String * 64
    Var txt As String
    Var Ret As Long

    'リストボックスを初期化
    List1.Resetcontent

    'プリンタ名を指定
    DeviceName = Combo1.GetWindowText

    'プリンタアクセス権を指定
    pd.DesiredAccess = PRINTER_ALL_ACCESS

    'プリンタのオブジェクトハンドルを取得
    Ret = Api_OpenPrinter(DeviceName, hPrinter, pd)

    '用紙名を指定
    InfoName = Edit1.GetWindowText

    '構造体のレベルを指定
    Level = 1

    'バッファに必要なサイズを取得
    Ret = Api_GetForm(hPrinter, InfoName, Level, ByVal 0, 0, Needed)

    'フォーム情報が取得できないときは
    If Needed <= 0 Then
        List1.AddString "取得できません。"

        '取得できないときの終了処理へ分岐
        GoTo *ClosePrt
    End If

    'バッファを確保
    Var Buffer(Needed - 1)  As Byte

    '用紙情報を取得
    Ret = Api_GetForm(hPrinter, InfoName, Level, Buffer(0), Needed, Needed)

    '取得した用紙情報を構造体へ移動
    MoveMemory fi1, Buffer(0), Len(fi1)

    '用紙情報を列挙(用紙名を複写)
    Ret = Api_lstrcpy(strFormName, ByVal fi1.pName)

    '用紙名を表示
    List1.AddString "用紙名　：" & Left$(strFormName, InStr(strFormName, Chr$(0)) - 1)

    '特性を表示
    Select Case fi1.Flags
        'ユーザー定義のとき
        Case FORM_USER
            txt =  "特性　 ：ユーザー定義 "

        'スプーラ定義のとき
        Case FORM_BUILTIN
            txt = "特性　　：スプーラ定義 "

        'プリンタ定義のとき
        Case FORM_PRINTER
            txt = "特性　　：プリンタ定義 "

        'その他のとき
        Case Else
            txt = "特性　　：不明"
    End Select
    List1.AddString txt

    '幅と高さを表示
    List1.AddString "幅と高さ：" & Format$(fi1.Size.cx / 1000, "###.#mm") & "," & Format$(fi1.Size.cy / 1000, "###.#mm")

    '範囲左上を表示
    List1.AddString "範囲左上：" & Format$(fi1.ImageableArea.left / 1000, "###.#mm") & "," & Format$(fi1.ImageableArea.top / 1000, "###.#mm")

    '範囲右下を表示
    List1.AddString "範囲右下：" & Format$(fi1.ImageableArea.right / 1000, "###.#mm") & "," & Format$(fi1.ImageableArea.bottom / 1000, "###.#mm")

*ClosePrt
    'プリンタオブジェクトをクローズ
    Ret = Api_ClosePrinter(hPrinter)
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End