'================================================================
'= フォントリソースをロード
'=    (AddFontResource.bas)
'================================================================
#include "Windows.bi"
#include "File.bi"

' フォントリソースをディスクファイルからシステムフォントテーブルにロード
Declare Function Api_AddFontResource& Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFileName$)

' システムからフォントを削除
Declare Function Api_RemoveFontResource& Lib "gdi32" Alias "RemoveFontResourceA" (ByVal lpFilename$)

Var Shared Text1 As Object
Var Shared Button1 As Object
Var Shared Button2 As Object

Text1.Attach GetDlgItem("Text1") : Text1.SetFontSize 30
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14
Button2.Attach GetDlgItem("Button2") : Button2.SetFontSize 14

Var Shared fFileName As String

'================================================================
'= ロードするパス名とフォント名取得
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    fFileName = CrDir$("")
    If Right$(fFileName, 1) <> "\" Then fFileName = fFileName & "\"
    fFileName = fFileName & "quake.ttf"
    Text1.SetWindowText "QUAKE"
End Sub

'================================================================
'= フォントテーブルにロード
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var Ret As Long

    Ret = Api_AddFontResource(fFileName)
    Text1.SetFontName "Quake"
    Text1.SetWindowText "QUAKE"
End Sub

'================================================================
'= テーブルから削除(元のフォントに戻しておく)
'================================================================
Declare Sub Button2_on edecl ()
Sub Button2_on()
    Var Ret As Long

    Ret = Api_RemoveFontResource(fFileName)
    Text1.SetFontName "ＭＳ ゴシック"
    Text1.SetWindowText "QUAKE"
End Sub

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