'================================================================
'= 文字列を描画(�U)
'=    (CreateFontIndirect.bas)
'================================================================
#include "Windows.bi"

#define LF_FACESIZE 32
#define GM_ADVANCED &H2            'WinNT･2K･XPグラフィックモード
#define OPAQUE 2                   '背景色を設定する

Type LOGFONT
    lfHeight         As Long       '文字セルまたは文字の高さ
    lfWidth          As Long       '平均文字幅
    lfEscapement     As Long       '文字送りの方向とX軸との角度
    lfOrientation    As Long       'ベースラインとX軸との角度
    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 * 32'(LF_FACESIZE) As Byte'フォント名
End Type

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

' 指定されたデバイスコンテキストのグラフィックスモードを設定
Declare Function Api_SetGraphicsMode& Lib "gdi32" Alias "SetGraphicsMode" (ByVal hDC&, ByVal iMode&)

' 指定されたデバイスコンテキストのオブジェクトを選択
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_GetDC& Lib "user32" Alias "GetDC" (ByVal hWnd&)

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

' 純色で論理ブラシを作成
Declare Function Api_CreateSolidBrush& Lib "gdi32" Alias "CreateSolidBrush" (ByVal crColor&)

' バックグラウンドの塗りつぶしモード設定
Declare Function Api_SetBkMode& Lib "gdi32" Alias "SetBkMode" (ByVal hDC&, ByVal iBkMode&)

' デバイスコンテキストの背景色を設定
Declare Function Api_SetBkColor& Lib "gdi32" Alias "SetBkColor" (ByVal hDC&, ByVal crColor&)

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

Var Shared Button1 As Object
Var Shared Radio(3) As Object
Var Shared Check1 As Object
Var Shared Edit1 As Object

Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14
Check1.Attach GetDlgItem("Check1") : Check1.SetFontSize 14
Edit1.Attach GetDlgItem("Edit1") : Edit1.SetFontSize 14
For i = 0 To 3
    Radio(i).Attach GetDlgItem("Radio" & Trim$(Str$(i + 1)))
    Radio(i).SetFontSize 14
Next

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var lf As LOGFONT
    Var rFont As Long
    Var hDC As Long
    Var OldGM As Long
    Var rgbColor As Long
    Var txt As String
    Var Ret As Long

    txt = "札幌"

    'Formの色
    rgbColor = RGB(192, 192, 192)

    '30度傾斜をつける
    If Check1.GetCheck Then lf.lfOrientation = 300

    lf.lfHeight = 60
    lf.lfItalic = Radio(1).GetCheck
    lf.lfUnderline = Radio(2).GetCheck
    lf.lfStrikeOut = Radio(3).GetCheck

    'Shift JIS に設定(設定しない場合全角が文字化けする)
    lf.lfCharSet = 128

    'フォント名の最後尾にChr$(0)は必須
    lf.lfFaceName = Edit1.GetWindowText & Chr$(0)

    'Edit1の背景色のモードを設定
    Ret = Api_SetBkMode(hDC, OPAQUE)

    'DC取得
    hDC = Api_GetDC(GethWnd)

    '描画色を設定
    colBrush = Api_CreateSolidBrush(rgbColor)

    'グラフィックモードを設定
    OldGM = Api_SetGraphicsMode(hDC, GM_ADVANCED)

    '背景色を設定
    Ret = Api_SetBkColor(hDC, rgbColor)

    Cls

    '論理フォントを作成
    rFont = Api_CreateFontIndirect(lf)

    'オブジェクトを選択
    Ret = Api_SelectObject(hDC, rFont)

    '文字を描画
    Ret = Api_TextOut(hDC, 0, 60, txt, Len(txt))

    'グラフィックモードを元に戻す
    Ret = Api_SetGraphicsMode(hDC, OldGM)

    Ret = Api_ReleaseDC(GethWnd, hDC)
    Ret = Api_DeleteObject(rFont)
End Sub

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