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

' 指定の属性を持つ論理フォントを作成
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&)

' 指定されたウィンドウのデバイスコンテキストのハンドルを取得
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_SelectObject& Lib "gdi32" Alias "SelectObject" (ByVal hDC&, ByVal hObject&)

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

#define DEFAULT_CHARSET 1       'デフォルトの文字セット
#define FW_BOLD 700             'フォントの線幅
#define FW_DONTCARE 0           'デフォルト

Var Shared Picture1 As Object
Var Shared Edit1 As Object
Var Shared Button1 As Object

Picture1.Attach GetDlgItem("Picture1")
Edit1.Attach GetDlgItem("Edit1") : Edit1.SetFontSize 14
Button1.Attach GetDlgItem("button1") : Button1.SetFontSize 14

'================================================================
'=
'================================================================
Declare Sub sFontPreview(fSize As Integer, FontName As String, fDig As Integer, fBold As Integer, Top As Single, Left As Single, MyText As String)
Sub sFontPreview(fSize As Integer, FontName As String, fDig As Integer, fBold As Integer, Top As Single, Left As Single, MyText As String)
    Var hDC As Long
    Var Bold As Long
    Var ObjhDC1 As Long
    Var ObjhDC2 As Long
    Var Ret As Long

    If fBold = True Then
        Bold = FW_BOLD
    Else
        Bold = FW_DONTCARE
    End If

    fDig = 450

    'Picture1 のハンドル取得
    hDC = Api_GetDC(Picture1.GethWnd)

    ObjhDC1 = Api_CreateFont(fSize, 10, fDig, fDig, Bold, 0, 0, 0, DEFAULT_CHARSET, 0, 0, 0, 0, FontName)
    ObjhDC2 = Api_SelectObject(hDC, ObjhDC1)

　　'表示位置の設定
    Ret = Api_TextOut(hDC, Top, Left, MyText$, Len(MyText$))

　　'元のフォントに戻す
    Ret = Api_SelectObject(hDC, ObjhDC2)

　　'取得したハンドルを開放（システムリソースを開放する）
    Ret = Api_DeleteObject(ObjhDC1)
    Ret = Api_DeleteObject(ObjhDC2)
    Ret = Api_ReleaseDC(Picture1.GethWnd, hDC)
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var FontName As String

    FontName = Edit1.GetWindowText
    sFontPreview 60, FontName, 0, False, 10, 80, "札幌市白石区"
End Sub

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