'================================================================
'= プリンタの印刷部数を設定
'=    (PrinterDmCopies.bas)
'================================================================
#include "Windows.bi"

#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_DEFAULT &H1        'デフォルトのプリンタに関する情報を列挙
#define PRINTER_ENUM_LOCAL &H2          'Nameの設定を無視して、ローカルプリンタを列挙
#define PRINTER_ENUM_NAME &H8           'Nameで指定されたプリンタを列挙
#define PRINTER_ENUM_SHARED &H20        '共有属性を持つプリンタを列挙
#define MAX_DEVICENAME 64

#define CCHDEVICENAME 32                'デバイス名の長さを示す定数
#define CCHFORMNAME 32                  'フォーム名の長さを示す定数
#define DM_COPIES &H100                 '用紙が有効であること示す定数

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

Type DEVMODE
    dmDeviceName(CCHDEVICENAME - 1) As Byte
    dmSpecVersion      As Integer
    dmDriverVersion    As Integer
    dmSize             As Integer
    dmDriverExtra      As Integer
    dmFields           As Long
    dmOrientation      As Integer
    dmPaperSize        As Integer
    dmPaperLength      As Integer
    dmPaperWidth       As Integer
    dmScale            As Integer
    dmCopies           As Integer
    dmDefaultSource    As Integer
    dmPrintQuality     As Integer
    dmColor            As Integer
    dmDuplex           As Integer
    dmYResolution      As Integer
    dmTTOption         As Integer
    dmCollate          As Integer
    dmFormName(CCHFORMNAME - 1) As Byte
    dmLogPixels        As Integer
    dmBitsPerPel       As Long
    dmPelsWidth        As Long
    dmPelsHeight       As Long
    dmDisplayFlags     As Long
    dmDisplayFrequency As Long
End Type

Type PRINTER_INFO_2
    pServerName         As Long
    pPrinterName        As Long
    pShareName          As Long
    pPortName           As Long
    pDriverName         As Long
    pComment            As Long
    pLocation           As Long
    pDevMode            As Long
    pSepFile            As Long
    pPrintProcessor     As Long
    pDatatype           As Long
    pParameters         As Long
    pSecurityDescriptor As Long
    Attributes          As Long
    Priority            As Long
    DefaultPriority     As Long
    StartTime           As Long
    UntilTime           As Long
    Status              As Long
    cJobs               As Long
    AveragePPM          As Long
End Type

Type PRINTER_INFO_5
    pPrinterName             As Long
    pPortName                As Long
    Attributes               As Long
    DeviceNotSelectedTimeOut As Long
    TransmissionRetryTimeOut As Long
End Type

' 使用可能なプリンタ・プリントサーバーなどを列挙する
Declare Function Api_EnumPrinters& Lib "winspool.drv" Alias "EnumPrintersA" (ByVal Flags&, ByVal Name$, ByVal Level&, pPrinterEnum As Any, ByVal cbBuf&, pcbNeededed&, pcReturned&)

' ある位置から別の位置にメモリブロックを移動
Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length&)

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

' プリンタの詳細な情報を取得
Declare Function Api_GetPrinter& Lib "winspool.drv" Alias "GetPrinterA" (ByVal hPrinter&, ByVal Level&, pPrinter As Any, ByVal cbBuf&, pcbNeeded&)

' プリンタの詳細な情報を設定
Declare Function Api_SetPrinter& Lib "winspool.drv" Alias "SetPrinterA" (ByVal hPrinter&, ByVal Level&, pPrinter As Any, ByVal Command&)

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

Var Shared Text1 As Object
Var Shared text2 As Object
Var Shared Edit1 As Object
Var Shared Combo1 As Object
Var Shared Button1 As Object

Text1.Attach GetDlgItem("Text1") : Text1.SetFontSize 14
Text2.Attach GetDlgItem("Text2") : Text2.SetFontSize 14
Edit1.Attach GetDlgItem("Edit1") : Edit1.SetFontSize 14
Combo1.Attach GetDlgItem("Combo1") : Combo1.SetFontSize 14
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14

Var Shared PrinterName As String

'================================================================
'= 接続プリンタを列挙
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    Var PrintServer As String
    Var Needed As Long
    Var Returned As Long
    Var Level As Long
    Var CT As Long
    Var Ret As Long

    'ローカルプリンタから検索
    PrintServer = ""

    'PRINTER_INFO_5構造体を受け取る
    Level = 5

    'バッファに必要なバイト数を調べる
    Ret = Api_EnumPrinters(PRINTER_ENUM_NAME, PrintServer, Level, Chr$(0), 0, Needed, Returned)
    If Needed = 0 Then End

    '全プリンタ情報を得る
    Var Buffer(Needed - 1) As Byte
    Ret = Api_EnumPrinters(PRINTER_ENUM_NAME, PrintServer, Level, Buffer(0), Needed, Needed, Returned)

    '構造体リストの準備
    Var PI_5(Returned - 1) As PRINTER_INFO_5

    For CT = 0 To Returned - 1

        'バッファから構造体1つ分を抜き取る
        CopyMemory PI_5(CT), Buffer(CT * Len(PI_5(CT))), Len(PI_5(CT))

        'プリンタ名を得る
        PrinterName = String$(MAX_DEVICENAME, Chr$(0))
        CopyMemory PrinterName, ByVal PI_5(CT).pPrinterName, Len(PrinterName)
        PrinterName = KLeft$(PrinterName, kInStr(1, PrinterName, Chr$(0)) - 1)

        Combo1.AddString PrinterName
    Next
End Sub

'================================================================
'= 印刷部数を設定
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var PrtDevName As String
    Var pd As PRINTER_DEFAULTS
    Var hPrinter As Long
    Var Level As Long
    Var Needed As Long
    Var pi2 As PRINTER_INFO_2
    Var dm As DEVMODE
    Var Ret As Long

    'プリンタ名を指定
    PrinterName = Combo1.GetText(Combo1.GetCursel)
    If PrinterName = "" Then
        A% = MessageBox(GetWindowText, "プリンタを選択してください！", 0, 2)
        Exit Sub
    End If

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

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

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

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

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

    '詳細なプリンタ情報を取得
    Ret = Api_GetPrinter(hPrinter, Level, Buffer(0), Needed, Needed)

    '取得した詳細なプリンタ情報を構造体へ移動
    CopyMemory pi2, Buffer(0), Len(pi2)

    '取得した詳細なプリンタデバイス情報を構造体へ移動
    CopyMemory dm, ByVal pi2.pDevMode, Len(dm)

    '部数が指定できるときは
    If dm.dmFields And DM_COPIES Then

        '部数を指定
        dm.dmCopies = Val(Edit1.GetWindowtext)

        '構造体を取得した詳細なプリンタデバイス情報へ移動
        CopyMemory ByVal pi2.pDevMode, dm, Len(dm)

        '詳細なプリンタ情報を書き戻し
        Ret = Api_SetPrinter(hPrinter, Level, pi2, 0)
    End If

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

'================================================================
'= 文字入力 + Enter
'================================================================
Declare Sub Edit1_Change edecl ()
Sub Edit1_Change()
    Var EPos As Integer

    Ed$ = Edit1.GetWindowText

    EPos = InStr(Ed$, Chr$(13, 10))
    If EPos <> 0 Then
        Ed$ = Mid$(Ed$, 1, EPos - 1) & Mid$(Ed$, EPos + 2)
        Edit1.SetWindowText Ed$
        If Val(Ed$) < 1 Or Val(Ed$) > 99 Then
            Edit1.SetWindowText ""
            Edit1.SetFocus
        Else
            Button1.SetFocus
        End If
    End If
End Sub

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