'================================================================
'= 文字列の回転
'=    (CreateFont3.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_SetBkMode& Lib "gdi32" Alias "SetBkMode" (ByVal hDC&, ByVal iBkMode&)

' 指定されたデバイスコンテキストのオブジェクトを選択
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&)

#define CLIP_LH_ANGLES 16               ' Needed for tilted fonts.
#define PI 3.14159625
#define PI_180 (PI / 180#)
#define TRANSPARENT 1                   '背景色を設定しない
#define DEFAULT_CHARSET 1               'デフォルトの文字セット
#define FW_NORMAL 800

Var Shared Timer1 As Object

Timer1.Attach GetDlgItem("Timer1")

Var Shared hDC As Long

'================================================================
'=
'================================================================
Declare Sub DrawRotatedText(txt$, ByVal X!, ByVal Y!, font_name$, ByVal size&, ByVal weight&, ByVal escapement&, ByVal use_italic%, ByVal use_underline%, ByVal use_strikethrough%)
Sub DrawRotatedText(txt$, ByVal X!, ByVal Y!, font_name$, ByVal size&, ByVal weight&, ByVal escapement&, ByVal use_italic%, ByVal use_underline%, ByVal use_strikethrough%)
    Var newfont As Long
    Var oldfont As Long
    Var Ret As Long

    newfont = Api_CreateFont(size&, 0, escapement&, escapement&, weight&, use_italic%, use_underline%, use_strikethrough%, DEFAULT_CHARSET, 0, CLIP_LH_ANGLES, 0, 0, font_name$)
    
    '新規フォント選択
    oldfont = Api_SelectObject(hDC, newfont)
    
    Ret = Api_SetBkMode(hDC, TRANSPARENT)
    Ret = Api_TextOut(hDC, X, Y, txt$, Len(txt$))

    '元のフォントに戻す
    newfont = Api_SelectObject(hDC, oldfont)
    
    'リソース解放
    Ret = Api_DeleteObject(newfont)
End Sub

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

    Timer1.SetInterval 5
    Timer1.Enable -1
End Sub

'================================================================
'=
'================================================================
Declare Sub Timer1_Timer edecl ()
Sub Timer1_Timer()
    Static angle As Long        '角度

    Cls
    
    DrawRotatedText "札幌", 115, 100, "AR丸ゴシック体E", 50, FW_NORMAL, angle * 10, False, False, False

    angle = angle + 10
End Sub

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

    Ret = Api_ReleaseDC(GethWnd, hDC)
End Sub

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