フォントの回転          <TOP>


フォントを回転及び拡大描画します。

CreateFontIndirect 論理フォントを作成

SelectObject 指定されたデバイスコンテキストのオブジェクトを選択

TextOut 文字列を描画

 

 

'================================================================
'= 文字列の回転
'=    (RotateFont.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(LF_FACESIZE) As Byte'フォント名
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_TextOut& Lib "gdi32" Alias "TextOutA" (ByVal hDC&, ByVal x&, ByVal y&, ByVal lpString$, ByVal nCount&)

' 指定されたウィンドウのクライアント領域または画面全体を表すディスプレイデバイスコンテキストのハンドルを取得
Declare Function Api_GetDC& Lib "user32" Alias "GetDC" (ByVal hWnd&)

' デバイスコンテキストを解放
Declare Function Api_ReleaseDC& Lib "user32" Alias "ReleaseDC" (ByVal hWnd&, ByVal hDC&)

Var Shared Text1 As Object

Text1.Attach GetDlgItem("Text1") : Text1.SetFontSize 14

Var Shared Txt As String

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    Txt = ":-)"

    Point(10, 10)
    Print Txt
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_On edecl ()
Sub Button1_On()
    Var lf As LOGFONT
    Var rFont As Long
    Var hDC As Long
    Var Deg As Integer
    Var Size As Integer
    Var i As Long
    Var Ret As Long

    Deg = 10
    Size = 60

    'デバイスコンテキスト取得
    hDC = Api_GetDC(GethWnd)

    For i = 1 To 360
        'オブジェクトを選択
        Ret = Api_SelectObject(hDC, rFont)

        '文字高さ設定
        lf.lfHeight = Size

        '角度設定
        lf.lfEscapement = Deg * i

        '論理フォントの作成
        rFont = Api_CreateFontIndirect(lf)

        '文字列描画
        Ret = Api_TextOut(hDC, 110, 80, Txt, Len(Txt))

        Text1.SetWindowText Str$(Deg * i)

        Wait 1
    Next

    'デバイスコンテキスト解放
    Ret = Api_ReleaseDC(GethWnd, hDC)
End Sub

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