'================================================================
'= アイコンタイトルフォントを設定
'=     (SetIconTitleFont.bas)
'================================================================
#include "Windows.bi"

#define LF_FACESIZE 32

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(LF_FACESIZE - 1) As Byte
End Type

#define SPI_GETICONTITLELOGFONT 31      'アイコンのタイトルに使われるフォントのLOGFONT構造体を取得
#define SPI_SETICONTITLELOGFONT 34      'アイコンのタイトルに使われるフォントを設定
#define SPIF_SENDWININICHANGE &H2       '全てのアプリケーションに通知して更新する
#define SPIF_UPDATEINIFILE &H1          'ユーザープロファイルの更新を指定

' システム全体に関するパラメータを取得・設定
Declare Function Api_SystemParametersInfo& Lib "user32" Alias "SystemParametersInfoA" (ByVal uiAction&, ByVal uiParam&, pvParam As Any, ByVal fWinIni&)

' 文字列をコピーする
Declare Function Api_lstrcpy$ Lib "Kernel32" Alias "lstrcpyA" (lpszString1 As Any, ByVal lpszString2$)

Var Shared OriginalFont As LOGFONT

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

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

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    Var Ret As Long

    Text1.SetWindowText "HG創英角ﾎﾟｯﾌﾟ体"

    Ret = Api_SystemParametersInfo(SPI_GETICONTITLELOGFONT, Len(OriginalFont), OriginalFont, 0)
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var lf As LOGFONT
    Var LogFont As String * 255
    Var Ret As Long

    'アイコンの表示要素を取得
    Ret = Api_SystemParametersInfo(SPI_GETICONTITLELOGFONT, Len(lf), lf, 0)

    'アイコンの表示要素を表示
    Text1.SetWindowText "HG創英角ﾎﾟｯﾌﾟ体"

    'アイコンのフォント名を指定
    LogFont = "HG創英角ﾎﾟｯﾌﾟ体" & Chr$(0)
    LogFont = Api_lstrcpy(lf.lfFaceName(0), LogFont)

    'アイコンの表示要素を設定
    Ret = Api_SystemParametersInfo(SPI_SETICONTITLELOGFONT, Len(lf), lf, SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE)
End Sub

'================================================================
'=
'================================================================
Declare Sub Button2_on edecl ()
Sub Button2_on()
    Var Ret As Long

    Text1.SetWindowText "MS UI Gothic"

    'アイコンの表示要素を設定
    Ret = Api_SystemParametersInfo(SPI_SETICONTITLELOGFONT, Len(OriginalFont), OriginalFont, SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE)
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_QueryClose edecl ()
Sub MainForm_QueryClose()
    Button2_on
End Sub

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