フォントハンドル

VBでフォントのハンドルを取得するのは案外面倒。hFontは使い終わったらDeleteObjectすること。nSizeはポイント数ではなく高さであることに注意。単位はピクセル。

Public Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal H As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, ByVal W As Long, ByVal i As Long, ByVal u As Long, ByVal s As Long, ByVal C As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal F As String) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Public Const FW_NORMAL = 400
Public Const SHIFTJIS_CHARSET = 128
Public Const OUT_DEFAULT_PRECIS = 0
Public Const CLIP_DEFAULT_PRECIS = 0
Public Const FIXED_PITCH = 1
Public Const FF_DONTCARE = 0
Public Const ANTIALIASED_QUALITY = 4

'フォントハンドルを取得する
Public Function GetFontHandle(ByVal sName As String, ByVal nSize As Long) As Long
    Dim nWidth As Long
    Dim nHeight As Long

    Dim hFont As Long

    nHeight = nSize
    nWidth = 0
    
    hFont = CreateFont(nHeight, nWidth, 0, 0, _
      FW_NORMAL, False, False, False, _
      SHIFTJIS_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, _
      ANTIALIASED_QUALITY, FIXED_PITCH, _
      sName)
      
    If hFont Then
        GetFontHandle = hFont
    Else
        GetFontHandle = 0
    End If

End Function

ここのところわりと忙しいので、ランチャーとかエディターとか弄る暇がそれほどないのが残念でならない。