文字列の回転表示(U) <TOP>
CreateFont
指定の属性を持つ論理フォントを作成
SelectObject 指定されたデバイスコンテキストのオブジェクトを選択
DeleteObject 論理オブジェクトを削除し、そのオブジェクトに関連付けられていたすべてのシステムリソースを解放
TextOut 文字を描画
GetDC
指定されたウィンドウのデバイスコンテキストのハンドルを取得
ReleaseDC
デバイスコンテキストを解放
'================================================================ '= 文字列の回転表示(U) '= (CreateFont2.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_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 Button1 As Object Var Shared Button2 As Object Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14 Button2.Attach GetDlgItem("Button2") : Button2.SetFontSize 14 '================================================================ '= '================================================================ Declare Sub tOut (x As Long, y As Long, Angle As Long, Size As Integer, Txt As String) Sub tOut(x As Long, y As Long, Angle As Long, Size As Integer, Txt As String) Var hDC As Long Var hFont As Long Var FontMem As Long Var Bold As Long Var Ret As Long hDC = Api_GetDC(GethWnd) x = GetWidth / 3 y = GetHeight / 1.8 hFont = Api_CreateFont(Size, 0, Angle * 10, 0, 0, 0, 0, 0, 1, 4, &H10, 2, 4, "") FontMem = Api_SelectObject(hDC, hFont) Ret = Api_TextOut(hDC, x, y, Txt, Len(Txt)) Ret = Api_SelectObject(hDC, FontMem) Ret = Api_DeleteObject(hFont) Ret = Api_ReleaseDC(GethWnd, hDC) End Sub '================================================================ '= '================================================================ Declare Sub MainForm_Start edecl () Sub MainForm_Start() MaximizeWindow End Sub '================================================================ '= '================================================================ Declare Sub Button1_on edecl () Sub Button1_on() Var x As Long Var y As Long Var z As Long Var n As Integer n = 60 For z = 0 To 360 Step 15 If n > 10 Then n = n - 2 Else If n > 2 Then n = n - 1 End If tOut x, y, z, n, " F-Basic Programming Tips" 'Wait 20 Next z End Sub '================================================================ '= '================================================================ Declare Sub Button2_on edecl () Sub Button2_on() Cls Refresh End Sub '================================================================ '= '================================================================ While 1 WaitEvent Wend Stop End