'================================================================
'= 角度のある文字列印刷
'=    (RotatePrint.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 RECT
    Left   As Long
    Top    As Long
    Right  As Long
    Bottom As Long
End Type

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

' 指定されたデバイスコンテキストのオブジェクトを選択
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_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_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 hDC As Long
Var Shared mDC As Long
Var Shared mBitmap As Long

'================================================================
'=
'================================================================
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(0))
    mBitmap = Api_CreateCompatibleBitmap(Api_GetDC(0), GetWidth, GetHeight)
        
    Ret = Api_SelectObject(mDC, mBitmap)
    Ret = Api_SetRect(rct, 0, 0, GetWidth, GetHeight)
    Ret = Api_FillRect(mDC, rct, Api_GetSysColorBrush(COLOR_WINDOW))

    Ret = Api_DeleteObject(Api_SelectObject(mDC, CreateMyFont(14, 15)))
    Ret = Api_TextOut(mDC, 5, GetHeight - 105, MSG, Len(MSG))

    Ret = Api_DeleteObject(Api_SelectObject(mDC, CreateMyFont(14, 0)))
    Ret = Api_TextOut(mDC, 5, GetHeight - 85, MSG, Len(MSG))
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    hDC = Api_GetDC(GethWnd)
    DrawText
End Sub

'================================================================
'= 印刷
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var DevName As String
    Var di As DOCINFO
    Var pd As PRINTER_DEFAULTS
    Var rct As RECT
    Var phDC As Long                'プリンタのデバイスコンテキスト
    Var ex As Long
    Var Ret As Long

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

    '通常使うプリンタ(型式番号だけではなくプロパティでの名称)
    'プリンタ名の取得は、「プリンタの対応する用紙を取得」参照
    DevName = "pdfFactory Pro"
'   DevName = "EPSON PX-G920"
'   DevName = "KONICA MINOLTA magicolor 2400W"

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

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

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

    di.cbSize = Len(di)
    di.lpszOutput = StrAdr(Chr$(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, (GetHeight - 105) * ex, MSG, Len(MSG))

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

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

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

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

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

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