'================================================================
'= システムフォント情報を取得

'=    (GetTextMetrics.bas)
'================================================================
#include "Windows.bi"

Type TEXTMETRIC
    tmHeight           As Long   'フォントの高さ(tmAscent+tmDescent)
    tmAscent           As Long   'ベースラインから一番上までの高さ
    tmDescent          As Long   'ベースラインから一番下までの高さ
    tmInternalLeading  As Long   'tmHeightメンバが示す高さに含まれる、上部スペースの高さ
    tmExternalLeading  As Long   'フォントを描画する際の、行同士の幅
    tmAveCharWidth     As Long   'フォントの平均の幅(イタリック体では超える場合もある)
    tmMaxCharWidth     As Long   'フォントを描画する際に必要な幅(最も広い幅)
    tmWeight           As Long   'フォントの太さ(700以上がBold)
    tmOverhang         As Long   '太字やイタリック体などのフォントに付加される幅
    tmDigitizedAspectX As Long   'デバイス コンテキストの水平アスペクト値
    tmDigitizedAspectY As Long   'デバイス コンテキストの垂直アスペクト値
    tmFirstChar        As Byte   'フォントに含まれる文字中の、先頭の文字コード
    tmLastChar         As Byte   'フォントに含まれる文字中の、最後の文字コード
    tmDefaultChar      As Byte   'フォントに含まれない文字を描画するための文字コード
    tmBreakChar        As Byte   '単語と単語の間を示す文字コード
    tmItalic           As Byte   'フォントがイタリック体のときは0以外の値
    tmUnderlined       As Byte   '下線付きフォントのときは0以外の値
    tmStruckOut        As Byte   '打ち消しフォントのときは0以外の値
    tmPitchAndFamily   As Byte   '下位4ビットにフォントのピッチおよび属性
    tmCharSet          As Byte   'フォントの文字セット
End Type

' フォントに関する情報を取得
Declare Function Api_GetTextMetrics& Lib "gdi32" Alias "GetTextMetricsA" (ByVal hDC&, lpMetrics As TEXTMETRIC)

' Windowsのデスクトップウィンドウを識別。返されるポインタは、一時的なポインタ。後で使用するために保存しておくことはできない
Declare Function Api_GetDesktopWindow& Lib "user32" Alias "GetDesktopWindow" ()

' ウィンドウ全体のデバイスコンテキストを取得
Declare Function Api_GetWindowDC& Lib "user32" Alias "GetWindowDC" (ByVal hWnd&)

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

' 指定のデバイスコンテキストのマッピングモードを設定
Declare Function Api_SetMapMode& Lib "gdi32" Alias "SetMapMode" (ByVal hDC&, ByVal nMapMode&)

Var Shared List1 As Object
Var Shared Button1 As Object

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

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var tm As TEXTMETRIC
    Var hDC As Long
    Var hWnd As Long
    Var PrevMapMode As Long
    Var txt As String
    Var Ret As Long

    'デスクトップのウィンドウハンドル取得
    hWnd = Api_GetDesktopWindow()

    'デスクトップのデバイスコンテキスト取得
    hDC = Api_GetWindowDC(hWnd)
    If hDC Then
        'マッピングモードをピクセルに設定
        PrevMapMode = Api_SetMapMode(hDC, MM_TEXT)

        'システムフォントのサイズを取得
        Ret = Api_GetTextMetrics(hDC, tm)

        'マッピングモードを設定
        PrevMapMode = Api_SetMapMode(hDC, PrevMapMode)

        List1.Resetcontent
        List1.AddString "tmHeight           : " & Str$(tm.tmHeight)
        List1.AddString "tmAscent           : " & Str$(tm.tmAscent)
        List1.AddString "tmInternalLeading  : " & Str$(tmInternalLeading)
        List1.AddString "tmExternalLeading  : " & Str$(tm.tmExternalLeading)
        List1.AddString "tmAveCharWidth     : " & Str$(tm.tmAveCharWidth)
        List1.AddString "tmMaxCharWidth     : " & Str$(tm.tmMaxCharWidth)
        List1.AddString "tmWeight           : " & Str$(tm.tmWeight)
        List1.AddString "tmOverhang         : " & Str$(tm.tmOverhang)
        List1.AddString "tmDigitizedAspectX : " & Str$(tm.tmDigitizedAspectX)
        List1.AddString "tmDigitizedAspectY : " & Str$(tm.tmDigitizedAspectY)
        List1.AddString "tmFirstChar        : " & Str$(tm.tmFirstChar)
        List1.AddString "tmLastChar         : " & Str$(tm.tmLastChar)
        List1.AddString "tmDefaultChar      : " & Str$(tm.tmDefaultChar)
        List1.AddString "tmBreakChar        : " & Str$(tm.tmBreakChar)
        List1.AddString "tmItalic           : " & Str$(tm.tmItalic)
        List1.AddString "tmUnderlined       : " & Str$(tm.tmUnderlined)
        List1.AddString "tmStruckOut        : " & Str$(tm.tmStruckOut)
        List1.AddString "tmPitchAndFamily   : " & Str$(tm.tmPitchAndFamily)
        List1.AddString "tmCharSet          : " & Str$(tm.tmCharSet)

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

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