'================================================================
'= APIを使った印刷(文字列を指定角度で)
'=    (PrintRotatedText.bas)
'================================================================
#include "Windows.bi"

#define LF_FACESIZE 32

Type LOGFONT
    lfHeight         As Long
    lfWidth          As Long
    lfEscapement     As Long
    lfOrientation    As Long
    lfWeight         As Long
    lfItalic         As Byte
    lfUnderline      As Byte
    lfStrikeOut      As Byte
    lfCharSet        As Byte
    lfOutPrecision   As Byte
    lfClipPrecision  As Byte
    lfQuality        As Byte
    lfPitchAndFamily As Byte
    lfFaceName As String * LF_FACESIZE
End Type

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

' 論理フォントを作成
Declare Function Api_CreateFontIndirect& Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT)

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

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

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

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

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

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

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

#define DESIREDFONTSIZE 12

Var Shared Text1 As Object
Var Shared Edit1 As Object
Var Shared Button1 As Object

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

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var OutString As String  '回転文字列
    Var lf As LOGFONT        '回転フォントの構造体
    Var hOldfont As Long     '旧フォント情報を待避
    Var hPrintDc As Long     'プリンタのデバイスコンテキスト
    Var hFont As Long        '新規フォントのハンドル
    Var di As DOCINFO        'ドキュメント情報の構造体
    Var Ret As Long          '戻り値

    '回転させる文字列
    OutString = "Hello World"

    '文字サイズ・回転角度を設定
    lf.lfEscapement = Val(Edit1.GetWindowText) * 10
    lf.lfHeight = (DESIREDFONTSIZE * 16)

    '回転文字フォントを作成
    hFont = Api_CreateFontIndirect(lf)
    di.cbSize = Len(di)
    di.lpszDocName = StrAdr("My Document" & Chr$(0))

    'デフォルトプリンタのデバイスコンテキストを作成
    hPrintDc = Api_CreateDC(ByVal 0, "FinePrint", 0, 0)

    '印刷開始処理
    Ret = Api_StartDoc(hPrintDc, di)
    Ret = Api_StartPage(hPrintDc)

    'プリンタデバイスコンテキストを選択
    hOldfont = Api_SelectObject(hPrintDc, hFont)

    '回転テキストを開始位置(1000, 1000)に送る
    Ret = Api_TextOut(hPrintDc, 1000, 1000, OutString, Len(OutString))

    '以前のオブジェクトに戻る
    Ret = Api_SelectObject(hPrintDc, hOldfont)

    '通常のテキストを描画
    Ret = Api_TextOut(hPrintDc, 1000, 1000, OutString, Len(OutString))

    '印刷終了処理
    Ret = Api_EndPage(hPrintDc)
    Ret = Api_EndDoc(hPrintDc)

    '解放処理
    Ret = Api_DeleteDC(hPrintDc)
    Ret = Api_DeleteObject(hFont)
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$) < 0 Or Val(Ed$) > 360 Then
            Edit1.SetWindowText ""
            Edit1.SetFocus
        Else
            Button1.SetFocus
        End If
    End If
End Sub

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