'================================================================
'= 文字列の回転表示(�V)
'=    (CreateFontIndirect3.bas)
'================================================================
#include "Windows.bi"

#define LF_FACESIZE 32

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 * LF_FACESIZE 'フォント名
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_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&)

Var Shared Picture1 As Object
Var Shared VScroll1 As Object
Var Shared Timer1 As Object
Var Shared Button1 As Object

Picture1.Attach GetDlgItem("Picture1")
VScroll1.Attach GetDlgItem("VScroll1")
Timer1.Attach GetDlgItem("Timer1")
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14

Var Shared hDC As Long
Var Shared txt As String
Var Shared i As Integer

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    txt = "回転文字"
    hDC = Api_GetDC(Picture1.GethWnd)
    VScroll1.SetScrollRange 0, 3600
    VScroll1.SetScrollStep 360, 36
    VScroll1.SetScrollPos 0
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    If Timer1.IsEnabled = False Then
        Timer1.Enable True
        Button1.SetWindowText "回転停止"
        VScroll1.EnableWindow False
    Else
        Timer1.Enable False
        Button1.SetWindowText "文字回転"
        VScroll1.EnableWindow True
    End If
End Sub

'================================================================
'=
'================================================================
Declare Sub Timer1_Timer edecl ()
Sub Timer1_Timer()
    Var lf As LOGFONT
    Var prevFont As Long
    Var hFont As Long
    Var Ret As Long

    i = i + 30

    If i >= 1800 * 2 Then i = 0

    Static FONTSIZE As Long
    FONTSIZE = 22

    Picture1.Cls
    lf.lfEscapement = i
    lf.lfFaceName = "ＡＲＰ丸ゴシック体Ｍ" & Chr$(0)
    lf.lfHeight = FONTSIZE
    lf.lfCharSet = 128
    lf.lfWeight = 800

    hFont = Api_CreateFontIndirect(lf)
    prevFont = Api_SelectObject(hDC, hFont)
    Ret = Api_DeleteObject(hFont)

    '文字を描画
    Ret = Api_TextOut(hDC, 100, 100, txt, Len(txt))
End Sub

'================================================================
'=
'================================================================
Declare Sub VScroll1_Change edecl ()
Sub VScroll1_Change()
    Var lf As LOGFONT
    Var prevFont As Long
    Var hFont As Long
    Var Ret As Long

    Static FONTSIZE As Long
    FONTSIZE = 22

    Picture1.Cls

    lf.lfEscapement = VScroll1.GetScrollPos
    lf.lfFaceName = "ＭＳ 明朝" & Chr$(0)
    lf.lfHeight = FONTSIZE
    lf.lfCharSet = 128

    hFont = Api_CreateFontIndirect(lf)
    prevFont = Api_SelectObject(hDC, hFont)
    Ret = Api_DeleteObject(hFont)

    '文字を描画
    Ret = Api_TextOut(hDC, 100, 100, txt, Len(txt))
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