文字列の回転表示(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