'================================================================
'= 印刷ダイアログ作成と文字列の回転印刷
'=    (PrintDlg3.bas)
'================================================================
#include "Windows.bi"

#define PD_DISABLEPRINTTOFILE &H80000   '「ファイルへ出力」チェックボックスを無効にする
#define PD_PAGENUMS &H2                 '「ページ設定」ボタンが選択された状態であることを示す
#define PD_PRINTSETUP &H40              '「プリンタの設定」ダイアログボックスを表示する
#define PD_PRINTTOFILE &H20             '「ファイルへ出力」チェックボックスがチェック状態であることを示す
#define PD_RETURNDC &H100               'hDCにデバイスコンテキストを格納することを表す
#define PD_RETURNDEFAULT &H400          'ダイアログを表示せず、システム設定のデフォルトプリンタで初期化する
#define PD_RETURNIC &H200               'hDCに情報コンテキストを格納することを表す
#define PD_SELECTION &H1                '「選択した部分」ボタンが選択されていることを示す
#define PD_SHOWHELP &H800               '「ヘルプ」ボタンを表示する
#define PD_USEDEVMODECOPIES &H40000     'PD_USEDEVMODECOPIESANDCOLLATEと同じ

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

Type PRINTER_DEFAULTS
    pDatatype     As String * 8
    pDevMode      As Long
    DesiredAccess As Long
End Type

Type RECT
    Left   As Long
    Top    As Long
    Right  As Long
    Bottom As Long
End Type

Type PRINTDLG
    lStructSize    As Long              '構造体のサイズをバイト単位で指定
    hwndOwner      As Long              '親ウィンドウのハンドルを指定
    hDevMode       As Long              'DEVMODE構造体を含んでいるグローバルメモリオブジェクトのハンドルを指定
    hDevNames      As Long              'DEVNAMES構造体を含んだグローバルメモリオブジェクトのハンドルを指定
    hdc            As Long              'デバイスコンテキスト
    flags          As Long              '印刷ダイアログボックスを初期化するために使われるビットフラグのセットを指定
    nFromPage      As Integer           'スタートページの初期値
    nToPage        As Integer           '最後のページの初期値
    nMinPage       As Integer           'ページ範囲の最小値
    nMaxPage       As Integer           'ページエディットコントロールの最大値
    nCopies        As Integer           '印刷部数の初期値
    hInstance      As Long              'インスタンスハンドル
    lCustData      As Long              'フック関数に渡すアプリケーション定義のデータ
    lpfnPrintHook  As Long              'フックプロシージャのポインタ
    lpfnSetupHook  As Long              'フックプロシージャのポインタ
    lpPrintTemplateName As String * 32  'ダイアログボックステンプレートの名前
    lpSetupTemplateName As String * 32  'ダイアログボックステンプレートの名前
    hPrintTemplate As Long              'DEVNAMES構造体の文字列がデフォルトのプリンターかどうかを表す
    hSetupTemplate As Long              '
End Type

Type DEVNAMES
    wDriverOffset As Integer            'デバイスドライバのファイル名を表す文字列へのオフセットアドレス
    wDeviceOffset As Integer            'デバイスの名前を表す文字列へのオフセットアドレス
    wOutputOffset As Integer            '出力ポートのデバイス名をあらわす文字列へのオフセットアドレス
    wDefault      As Integer            '
    extra         As String * 100       '
End Type

Type DEVMODE
    dmDeviceName       As String * 32   'ドライバがサポートするデバイス名
    dmSpecVersion      As Integer       '構造体の基準になった初期化データ仕様のバージョン番号
    dmDriverVersion    As Integer       'プリンタドライバのバージョン番号
    dmSize             As Integer       'この構造体のサイズ(バイト単位)
    dmDriverExtra      As Integer       'この構造体に続くドライバ データのバイト数
    dmFields           As Long          '
    dmOrientation      As Integer       'DMORIENT_PORTRAIT(縦置き)、DMORIENT_LANDSCAPE(横置き)
    dmPaperSize        As Integer       '用紙サイズ
    dmPaperLength      As Integer       'dmPaperSizeメンバで指定した用紙の長さをオーバーライド
    dmPaperWidth       As Integer       'dmPaperSizeメンバで指定した用紙の幅をオーバーライド
    dmScale            As Integer       '印刷出力をスケーリングするときの、スケーリング係数
    dmCopies           As Integer       'デバイスが複数の部数に対応する場合、印刷する部数
    dmDefaultSource    As Integer       '予約済み(0)
    dmPrintQuality     As Integer       'プリンタの解像度(ドット/インチ)
    dmColor            As Integer       'カラープリンタの場合(DMCOLOR_COLOR･DMCOLOR_MONOCHROME)
    dmDuplex           As Integer       '両面印刷が可能なプリンタ(DMDUP_SIMPLEX･DMDUP_HORIZONTAL･DMDUP_VERTICAL)
    dmYResolution      As Integer       'プリンタのy方向の解像度(ドット/インチ)
    dmTTOption         As Integer       'TrueTypeフォントの印刷方法
    dmCollate          As Integer       '複数部数を印刷するときにページ順にそろえるかどうか
    dmFormName         As String * 32   'フォーム名を指定
    dmUnusedPadding    As Integer       '使用しない
    dmBitsPerPixel     As Integer       'ディスプレイ デバイスの解像度をピクセルあたりのビット数で指定
    dmPelsWidth        As Long          '可視のデバイスの表面の幅をピクセル単位で指定
    dmPelsHeight       As Long          '可視のデバイスの表面の高さをピクセル単位で指定
    dmDisplayFlags     As Long          'デバイスのディスプレイ モードを指定
    dmDisplayFrequency As Long          'ディスプレイデバイスのリフレッシュレート(垂直同期周波数)を1秒当たりのサイクル数(Hz)で指定
    dmICMMethod        As Long          '非ICMアプリケーションの場合に、ICMが使用可能かどうかを指定
    dmICMIntent        As Long          'カラーマッチング方法のデフォルトを指定
    dmMediaType        As Long          '印刷メディアのタイプを指定
    dmDitherType       As Long          'ディザリング方法を指定
    dmReserved1        As Long          '予約済み(0)
    dmReserved2        As Long          '予約済み(0)
    dmPanningWidth     As Long          'NT系(0)
    dmPanningHeight    As Long          'NT系(0)
End Type

' 印刷ダイアログボックスを作成
Declare Function Api_PrintDlg& Lib "comdlg32" Alias "PrintDlgA" (lpPrintdlg As PRINTDLG)

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

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

' ヒープに確保されたメモリをロック
Declare Function Api_GlobalLock& Lib "kernel32" Alias "GlobalLock" (ByVal hMem&)

' メモリブロックのロックを解除
Declare Function Api_GlobalUnlock& Lib "kernel32" Alias "GlobalUnlock" (ByVal hMem&)

' メモリブロックのロックを解放
Declare Function Api_GlobalFree& Lib "kernel32" Alias "GlobalFree" (ByVal hMem&)

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

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

' 指定されたデバイスコンテキストのオブジェクトを選択
Declare Function Api_SelectObject& Lib "gdi32" Alias "SelectObject" (ByVal hDC&, 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_CreateDC& Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName$, ByVal lpDevName$, ByVal lpOutput$, ByVal lpInitData&)

' デバイス固有の情報を取得
Declare Function Api_GetDeviceCaps& Lib "gdi32" Alias "GetDeviceCaps" (ByVal hDC&, ByVal nIndex&)

' 指定の属性を持つ論理フォントを作成
Declare Function Api_CreateFont& Lib "gdi32" Alias "CreateFontA" (ByVal Hei&, ByVal Wid&, ByVal Esc&, ByVal Ori&, ByVal Wei&, ByVal Ita&, ByVal Und&, ByVal Stk&, ByVal Chr&, ByVal Out&, ByVal Clp&, ByVal Qua&, ByVal Pit&, ByVal Face$)

' 文字を描画
Declare Function Api_TextOut& Lib "gdi32" Alias "TextOutA" (ByVal hDC&, ByVal nXStart&, ByVal nYStart&, ByVal lpString$, ByVal cbString&)

' 2つの符号付き32ビット整数を乗算(64ビット)し、その結果を1つの符号付き32ビット整数で除算
Declare Function Api_MulDiv& Lib "Kernel32" Alias "MulDiv" (ByVal nNumber&, ByVal nNumerator&, ByVal nDenominator&)

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

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

' ブラシで矩形領域を塗りつぶす
Declare Function Api_FillRect& Lib "user32" Alias "FillRect" (ByVal hDC&, ByRef r As RECT, ByVal hBrush&)

' RECT構造体の値を設定
Declare Function Api_SetRect& Lib "user32" Alias "SetRect" (lpRect As RECT, ByVal X1&, ByVal Y1&, ByVal X2&, ByVal Y2&)

' デバイスコンテキストと互換性のあるビットマップを作成
Declare Function Api_CreateCompatibleBitmap& Lib "gdi32" Alias "CreateCompatibleBitmap" (ByVal hDC&, ByVal nWidth&, ByVal nHeight&)

' 指定されたデバイスコンテキストに関連するデバイスと互換性のあるメモリデバイスコンテキストを作成
Declare Function Api_CreateCompatibleDC& Lib "gdi32" Alias "CreateCompatibleDC" (ByVal hDC&)

' ビットブロック転送を行う。コピー元からコピー先のデバイスコンテキストへ、指定された長方形内の各ピクセルの色データをコピー
Declare Function Api_BitBlt& Lib "gdi32" Alias "BitBlt" (ByVal hDestDC&, ByVal X&, ByVal Y&, ByVal nWidth&, ByVal nHeight&, ByVal hSrcDC&, ByVal xSrc&, ByVal ySrc&, ByVal dwRop&)

#define PS_SOLID 0
#define PRINTER_ACCESS_ADMINISTER &H4   'プリンタアクセス権の管理者権限を示す
#define PRINTER_ACCESS_USE &H8          'プリンタアクセス権のユーザー権限を示す
#define vbNullString ByVal 0            '値0の文字列。値0を持つ文字列。空文字列ではない
#define DEFAULT_PITCH 0                 '文字ピッチデフォルト
#define PROOF_QUALITY 2                 'フォントの文字品質が、論理フォントの属性を正確に一致させることよりも重視
#define CLIP_DEFAULT_PRECIS 0
#define OUT_DEFAULT_PRECIS 0
#define FW_NORMAL 400
#define DEFAULT_CHARSET 1
#define TRANSPARENT 1                   '背景色を設定しない
#define LOGPIXELSX 88                   'スクリーン幅において１論理インチあたりのピクセル数
#define LOGPIXELSY 90                   'スクリーン高さにおいて１論理インチあたりのピクセル数
#define COLOR_WINDOW 5                  'ウィンドウの背景色
#define SRCCOPY &HCC0020                'そのまま転送
#define MSG "北海道札幌市白石区菊水"

Var Shared Text1 As Object
Var Shared Picture1 As Object
Var Shared Button1 As Object

Text1.Attach GetDlgItem("Text1") : Text1.SetFontSize 14
Picture1.Attach GetDlgItem("Picture1")
Button1.Attach getDlgItem("Button1") : Button1.SetFontSize 14

Var Shared hDC As Long
Var Shared mDC As Long
Var Shared mBitmap As Long
Var Shared DevName As String

'================================================================
'=
'================================================================
Declare Function CreateMyFont(nSize As Integer, nDegrees As Long) As Long
Function CreateMyFont(nSize As Integer, nDegrees As Long) As Long
    CreateMyFont = Api_CreateFont(-Api_MulDiv(nSize, Api_GetDeviceCaps(Api_GetDC(0), LOGPIXELSY), 72), 0, nDegrees * 10, 0, FW_NORMAL, 0, 0, 0, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, PROOF_QUALITY, DEFAULT_PITCH, "ＭＳ 明朝")
End Function

'================================================================
'=
'================================================================
Declare Sub DrawText edecl ()
Sub DrawText()
    Var rct As RECT
    Var Ret As Long
    
    mDC = Api_CreateCompatibleDC(Api_GetDC(Picture1.GethWnd))
    mBitmap = Api_CreateCompatibleBitmap(Api_GetDC(Picture1.GethWnd), Picture1.GetWidth, Picture1.GetHeight)
        
    Ret = Api_SelectObject(mDC, mBitmap)
    Ret = Api_SetRect(rct, 0, 0, Picture1.GetWidth, Picture1.GetHeight)
    Ret = Api_FillRect(mDC, rct, Api_GetSysColorBrush(COLOR_WINDOW))

    Ret = Api_DeleteObject(Api_SelectObject(mDC, CreateMyFont(14, 15)))
    Ret = Api_TextOut(mDC, 5, 80, MSG, Len(MSG))

    Ret = Api_DeleteObject(Api_SelectObject(mDC, CreateMyFont(20, 0)))
    Ret = Api_TextOut(mDC, 5, 100, MSG, Len(MSG))
End Sub

'================================================================
'= 印刷
'================================================================
Declare Sub InsatuOn edecl ()
Sub InsatuOn()
    Var di As DOCINFO
    Var pd As PRINTER_DEFAULTS
    Var rct As RECT
    Var hPrinter As Long
    Var phDC As Long
    Var ex As Long
    Var Ret As Long

    'フォーム描画とプリントアウト時の倍率
    ex = 5

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

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

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

    di.cbSize = Len(di)
    di.lpszDocName = StrAdr("回転文字の印刷" & Chr$(0))
    di.lpszOutput = 0

    '印刷プロセス開始
    Ret = Api_StartDoc(phDC, di)
    Ret = Api_StartPage(phDC)
   
    '斜め15°の回転文字印刷
    Ret = Api_DeleteObject(Api_SelectObject(phDC, CreateMyFont(14 * ex, 15)))
    Ret = Api_TextOut(phDC, 5, 800, MSG, Len(MSG))

    '水平の文字印刷
    Ret = Api_DeleteObject(Api_SelectObject(phDC, CreateMyFont(20 * ex, 0)))
    Ret = Api_TextOut(phDC, 5, 1000, MSG, Len(MSG))

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

*Cleanup
    If phDC <> 0 Then Ret = Api_DeleteDC(phDC)
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    ShowWindow -1
    hDC = Api_GetDC(Picture1.GethWnd)
    DrawText
End Sub

'================================================================
'= 印刷ダイアログ作成とプリンタ選択
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var pMemMode As Long
    Var pMemName As Long
    Var pd As PRINTDLG
    Var dm As DEVMODE
    Var dn As DEVNAMES
    Var Ret As Long

    '印刷ダイアログを表示
    pd.hInstance = GethInst
    pd.hwndOwner = GethWnd
    pd.lStructSize = 66       'Len(pd)

    pd.flags = PD_RETURNDC                   '印刷ダイアログ   　　　　　　　　

    '適当に指定している
    pd.nFromPage = 1
    pd.nToPage = 15
    pd.nMinPage = 1
    pd.nMaxPage = 15

    dm.dmPaperSize = 13

    Ret = Api_PrintDlg(pd)

    '「印刷」<> 0、「キャンセル」= 0
    If Ret = 0 Then
        Text1.SetWindowText "「キャンセル」が選択されました"
        Ret = Api_GlobalFree(pd.hDevMode)
        Ret = Api_GlobalFree(pd.hDevNames)
        Exit Sub
    End If

    pMemMode = Api_GlobalLock(pd.hDevMode)
    MoveMemory dm, ByVal pMemMode, Len(dm)
    Ret = Api_GlobalUnlock(pd.hDevMode)
    Ret = Api_GlobalFree(pd.hDevMode)

    pMemName = Api_GlobalLock(pd.hDevNames)
    MoveMemory dn, ByVal pMemName, Len(dn)
    Ret = Api_GlobalUnlock(pd.hDevNames)
    Ret = Api_GlobalFree(pd.hDevNames)

    DevName = Left$(dm.dmDeviceName, InStr(dm.dmDeviceName, Chr$(0)) - 1)
    Text1.SetWindowText "「" & DevName & "」で印刷します" & Str$(dm.dmPaperSize)
    Ret = Api_DeleteObject(pd.hdc)

    InsatuOn
End Sub

'================================================================
'= 再描画
'================================================================
Declare Sub MainForm_MouseMove edecl ()
Sub MainForm_MouseMove()
    Var Ret As Long

    Ret = Api_BitBlt(hDC, 0, 0, Picture1.GetWidth, Picture1.GetHeight, mDC, 0, 0, SRCCOPY)
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_QueryClose edecl ()
Sub MainForm_QueryClose()
    Var Ret As Long

    Ret = Api_ReleaseDC(Picture1.GethWnd, hDC)
End Sub

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