'================================================================
'= 文字列を描画(�Z)
'=    (TextOut4.bas)
'================================================================
#include "Windows.bi"

Type LOGFONT
    lfHeight         As Long
    lfWidth          As Long
    lfEscapement     As Long
    lfOrientation    As Long
    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 * 32
End Type

#define SYMBOL_CHARSET 2                'シンボル文字セット
#define COLOR_BTNFACE 15                '3Dオブジェクトの表面色
#define TRANSPARENT 1                   '背景色を設定しない

' 文字を描画
Declare Function Api_TextOut& Lib "gdi32" Alias "TextOutA" (ByVal hDC&, ByVal nXStart&, ByVal nYStart&, lpString As Any, ByVal cbString&)

' 論理オブジェクトを削除し、そのオブジェクトに関連付けられていたすべてのシステムリソースを解放
Declare Function Api_DeleteObject& Lib "gdi32" Alias "DeleteObject" (ByVal hObject&)

' 論理フォントを作成
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_SetBkMode& Lib "gdi32" Alias "SetBkMode" (ByVal hDC&, ByVal iBkMode&)

' 指定されたウィンドウのデバイスコンテキストのハンドルを取得
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

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

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var hDC As Long
    Var lf As LOGFONT
    Var chars(257) As Byte
    Var DispChar As Integer
    Var NumDispchar As Integer
    Var hFont As Long
    Var StartASCII As Integer
    Var StopASCII As Integer
    Var StartRow As Integer
    Var NumOfChars As Integer
    Var i As Integer
    Var j As Integer
    Var EndRow As Integer
    Var NewStart As Integer
    Var tmp As Integer
    Var xd As Long
    Var xt As Long
    Var xs As Long
    Var fCaption As String
    Var Ret As Long

    lf.lfCharSet = SYMBOL_CHARSET
    lf.lfFaceName = "WingDings" & Chr$(0)
    lf.lfClipPrecision = 64
    lf.lfOutPrecision = 0
    lf.lfEscapement = 0
    lf.lfItalic = 0
    lf.lfWidth = 16
    lf.lfHeight = 32
    lf.lfOrientation = 0

    hDC = Api_GetDC(GethWnd)

    fCaption = Left$(lf.lfFaceName, InStr(lf.lfFaceName, Chr$(0)) - 1)

    hFont = Api_CreateFontIndirect(lf)
    xs = Api_SelectObject(hDC, hFont)

    DispChar = 32           '一行に表示するキャラクタ数
    StartASCII = 32         '最初のキャラクタのアスキー値
    StopASCII = 255         '最後のキャラクタのアスキー値
    StartRow = 1

    If StartASCII < 0 Then StartASCII = 32
    If StopASCII > 255 Then StopASCII = 255

    If StartASCII > StopASCII Then
        tmp = StartASCII
        StartASCII = StopASCII
        StopASCII = tmp
    End If

    NumOfChars = StopASCII - StartASCII + 1

    If Int(NumOfChars / DispChar) = (NumOfChars) / DispChar Then
        EndRow = Int(NumOfChars / DispChar)
    Else
        EndRow = Int(NumOfChars / DispChar) + 1
    End If

    For i = StartASCII To StopASCII
        chars(i) = i
    Next i

    Ret = Api_SetBkMode(hDC, TRANSPARENT)
    Cls

    For j = StartRow To EndRow
        NewStart = StartASCII + (j - 1) * DispChar

        If NumOfChars < DispChar And NumOfChars > 0 Then
            NumDispchar = NumOfChars
        Else
            NumDispchar = DispChar
        End If

        xt = Api_TextOut(hDC, 0, (j * lf.lfHeight + 2) - 32, chars(NewStart), NumDispchar)
        NumOfChars = NumOfChars - NumDispchar
    Next j

    xd = Api_DeleteObject(hFont)

    fCaption = fCaption & "   From " & Str$(StartASCII) & " to " & Str$(StopASCII)
    SetWindowText fCaption

    Ret = Api_ReleaseDC(GethWnd, hDC)
End Sub

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