'================================================================
'= APIを使った印刷
'=    (PrintRoundRect.bas)
'================================================================
#include "Windows.bi"

Type DOCINFO
    cbSize      As Long
    lpszDocName As Long
    lpszOutput  As Long
End Type

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

Type POINTAPI
    x As Long
    y As Long
End Type

Type LOGPEN
    lopnStyle As Long
    lopnWidth As POINTAPI
    lopnColor As Long
End Type

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

' 指定されたデバイスのデバイスコンテキストを、指定された名前で作成
Declare Function Api_CreateDC& Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName$, ByVal lpDevName$, ByVal lpOutput$, ByVal lpInitData&)

' LOGPEN構造体を定義して論理ペンを作成
Declare Function Api_CreatePenIndirect& Lib "gdi32" Alias "CreatePenIndirect" (lpLogPen As LOGPEN)

' 角の丸い矩形を描画
Declare Function Api_RoundRect& Lib "gdi32" Alias "RoundRect" (ByVal hDC&, ByVal nLeftRect&, ByVal nTopRect&, ByVal nRightRect&, ByVal nBottomRect&, ByVal nWidth&, ByVal nHeight&)

' 指定されたデバイスコンテキストのオブジェクトを選択
Declare Function Api_SelectObject& Lib "gdi32" Alias "SelectObject" (ByVal hDC&, ByVal hObject&)

' 論理オブジェクトを削除し、そのオブジェクトに関連付けられていたすべてのシステムリソースを解放
Declare Function Api_DeleteObject& Lib "gdi32" Alias "DeleteObject" (ByVal hObject&)

' 印刷ジョブを開始
Declare Function Api_StartDoc& Lib "gdi32" Alias "StartDocA" (ByVal hDC&, lpdi As DOCINFO)

' プリンタドライバがデータを受け取る準備をさせる
Declare Function Api_StartPage& Lib "gdi32" Alias "StartPage" (ByVal hDC&)

' 1ページ書き込みの終了を通知
Declare Function Api_EndPage& Lib "gdi32" Alias "EndPage" (ByVal hDC&)

' 印刷ジョブを終了
Declare Function Api_EndDoc& Lib "gdi32" Alias "EndDoc" (ByVal hDC&)

' 指定されたデバイスコンテキストを削除
Declare Function Api_DeleteDC& Lib "gdi32" Alias "DeleteDC" (ByVal hDC&)

' 指定されたウィンドウのクライアント領域または画面全体を表すディスプレイデバイスコンテキストのハンドルを取得
Declare Function Api_GetDC& Lib "user32" Alias "GetDC" (ByVal hWnd&)

' デバイスコンテキストを解放
Declare Function Api_ReleaseDC& Lib "user32" Alias "ReleaseDC" (ByVal hWnd&, ByVal hDC&)

#define PS_SOLID 0
#define PRINTER_ACCESS_ADMINISTER &H4   'プリンタアクセス権の管理者権限を示す定数の宣言
#define PRINTER_ACCESS_USE &H8          'プリンタアクセス権のユーザー権限を示す定数の宣言

#define vbWhite &HFFFFFF                '白のカラーコード
#define vbBlack &H000000                '黒のカラーコード
#define vbBlue &HFF0000                 '青のカラーコード
#define vbRed &H0000FF                  '赤のカラーコード
#define vbNullString ByVal 0            '値0の文字列。値0を持つ文字列。空文字列ではない

Var Shared lp As LOGPEN
Var Shared pa As POINTAPI
Var Shared hndPen As Long
Var Shared oldPen As Long
Var Shared x1 As Long
Var Shared y1 As Long
Var Shared x2 As Long
Var Shared y2 As Long
Var Shared x3 As Long
Var Shared y3 As Long
Var Shared w As Long

Var Shared Button1 As Object

Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14

'================================================================
'= フォームに描画
'================================================================
Declare Sub MainForm_MouseMove edecl ()
Sub MainForm_MouseMove()
    Var hDC As Long
    Var Ret As Long

    hDC = Api_GetDC(GethWnd)

    'ペン太さ・色
    w = 4
    pa.x = w
    lp.lopnColor = vbRed
    lp.lopnStyle = PS_SOLID
    lp.lopnWidth = pa

    'ペンオブジェクト作成
    hndPen = Api_CreatePenIndirect(lp)

    'プリンタデバイスコンテキストにペンオブジェクト選択
    oldPen = Api_SelectObject(hDC, hndPen)

    '左上座標
    x1 = 6
    y1 = 3

    '右下座標
    x2 = 120
    y2 = 90

    'コーナー
    x3 = 20
    y3 = 20

    'プリンタデバイスコンテキストに角を丸めた長方形を描画
    Ret = Api_RoundRect(hDC, x1, y1, x2, y2, x3, y3)

    'ペン削除
    Ret = Api_DeleteObject(hndPen)
    Ret = Api_ReleaseDC(GethWnd, hDC)
End Sub

'================================================================
'= 印刷
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var DevName As String
    Var di As DOCINFO
    Var pd As PRINTER_DEFAULTS
    Var prhDC As Long
    Var ex As Long
    Var Ret As Long

    ex = 10

    '通常使うプリンタ
    'プリンタ名の取得は、「プリンタの対応する用紙を取得」参照
    DevName = "pdfFactory Pro"

    'プリンタ初期化
    pd.pDatatype = StrAdr(Chr$(0))
    pd.pDevMode = 0
    pd.DesiredAccess = PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE

    'プリンタオープン
    Ret = Api_OpenPrinter(DevName, prhDC, pd)

    'プリンタデバイスコンテキストを取得
    prhDC = Api_CreateDC("WINSPOOL", DevName, vbNullString, 0)
    If prhDC = 0 Then GoTo *cleanup

    di.cbSize = Len(di)
    di.lpszOutput = StrAdr(Chr$(0))

    '印刷プロセス開始
    Ret = Api_StartDoc(prhDC, di)
    Ret = Api_StartPage(prhDC)
   
    'ペン太さ・色
    pa.x = w * ex
    lp.lopnColor = vbRed
    lp.lopnStyle = PS_SOLID
    lp.lopnWidth = pa

    'ペンオブジェクト作成
    hndPen = Api_CreatePenIndirect(lp)

    'プリンタデバイスコンテキストにペンオブジェクト選択
    oldPen = Api_SelectObject(prhDC, hndPen)

    'プリンタデバイスコンテキストに角を丸めた長方形を描画
    Ret = Api_RoundRect(prhDC, x1 * ex, y1 * ex, x2 * ex, y2 * ex, x3 * ex, y3 * ex)

    'ペン削除
    Ret = Api_DeleteObject(hndPen)

    '印刷プロセス終了
    Ret = Api_EndPage(prhDC)
    If Ret >= 0 Then Ret = Api_EndDoc(prhDC)

*cleanup
    If prhDC <> 0 Then Ret = Api_DeleteDC(prhDC)
End Sub

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