'================================================================
'= アイコンを設定する
'=    (SetClassLong.bas)
'================================================================
#include "Windows.bi"

' クラスに関連付けてる補足データ域から Long 値を取得
Declare Function Api_GetClassLong& Lib "user32" Alias "GetClassLongA" (ByVal hWnd&, ByVal nIndex&)

' クラスに関連付けている補足データ域に Long 値を設定
Declare Function Api_SetClassLong& Lib "user32" Alias "SetClassLongA" (ByVal hWnd&, ByVal nIndex&, ByVal dwNewLong&)

' ウィンドウクラス名を取得
Declare Function Api_GetClassName& Lib "user32" Alias "GetClassNameA" (ByVal hWnd&, ByVal lpClassName$, ByVal nMaxCount&)

' 指定されたウィンドウプロシージャにメッセージ情報を渡す関数
Declare Function Api_CallWindowProc& Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc&, ByVal hWnd&, ByVal Msg&, ByVal WParam&, ByVal lParam&)

' 画像ファイルの読み込み
Declare Function Api_LoadImage& Lib "user32" Alias "LoadImageA" (ByVal hInst&, ByVal lpszName$, ByVal uType&, ByVal cxDesired&, ByVal cyDesired&, ByVal fuLoad&)

#define GCL_CBCLSEXTRA -20              'クラスに関連付けられている拡張クラスメモリのサイズをバイト単位で設定
#define GCL_CBWNDEXTRA -18              'ウィンドウに関連付けられている拡張ウィンドウメモリのサイズをバイト単位で設定
#define GCL_HBRBACKGROUND -10           'クラスに関連付けられている背景ブラシのハンドルを書き換える
#define GCL_HCURSOR -12                 'クラスに関連付けられているマウスカーソルのハンドルを書き換える
#define GCL_HICON -14                   'クラスに関連付けられているアイコンのハンドルを書き換える
#define GCL_HMODULE -16                 'クラスを登録したモジュールのハンドルを書き換える
#define GCL_MENUNAME -8                 'メニュー名が入った文字列のアドレスを書き換える
#define GCL_STYLE -26                   'ウィンドウクラスのスタイルビットを書き換える
#define GCL_WNDPROC -24                 'クラスに関連付けられているウィンドウプロシージャのアドレスを書き換える

#define IMAGE_BITMAP 0                  'ビットマップ
#define IMAGE_ICON 1                    'アイコン
#define IMAGE_CURSOR 2                  'カーソル
#define IMAGE_ENHMETAFILE 3             '拡張メタファイル

#define LR_CREATEDIBSECTION &H2000      'デバイス独立ビットマップとしてロードする
#define LR_DEFAULTCOLOR &H0             'デフォルト
#define LR_DEFAULTSIZE &H40             '幅・高さの指定がゼロであれば、システムメトリック値のサイズを採用する
#define LR_LOADFROMFILE &H10            '外部ファイルからロードする
#define LR_LOADMAP3DCOLORS &H1000       'カラーテーブルを走査して、３Ｄカラーをシステム値に置き換える
#define LR_LOADTRANSPARENT &H20         '最初のピクセルデータを背景色と見なし、システム値に置き換える
#define LR_MONOCHROME &H1               '白黒イメージとしてロード
#define LR_SHARED &H8000                'イメージハンドルを固定する
#define LR_COPYFROMSOURCE &H4000        'リソースから読み込む
#define WM_CLOSE &H10                   'ウインドウ或いはアプリケーションをクローズされた

Var Shared hIcon As Long

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

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

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()

    Text2.SetWindowText "↑ アイコンは設定されていません！"
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var Buffer As String * 256
    Var Ret As Long

    Ret = Api_GetClassName(GethWnd, Buffer, Len(Buffer))
    If Ret = 0 Then
        Text1.SetWindowText "クラス名を取得できません！"
    Else
        Text1.SetWindowText "クラス名は " & Left$(Buffer, Ret) & " です！"
    End If

    hIcon = Api_LoadImage(GethInst, "TEST.ico", IMAGE_ICON, 32, 32, LR_LOADFROMFILE)
    If hIcon = 0 Then
        Text2.SetWindowText "アイコンはありません！"
        Wait 50
        Exit Sub
    End If

    Ret = Api_SetClassLong(GethWnd, GCL_HICON, hIcon)
    If Ret = 0 Then
        Text2.SetWindowText "アイコンを設定できません！"
    Else
        Text2.SetWindowText "↑ アイコンを設定しました！"
    End If
End Sub

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

    ProcAddress = Api_GetClassLong(GethWnd, GCL_WNDPROC)
    If ProcAddress = 0 Then
        Text1.SetWindowText "ウィンドウクラス名の取得はできません！"
        Wait 50
        End
    End If

    Ret = Api_CallWindowProc(ProcAddress, GethWnd, WM_CLOSE, 0, 0)
End Sub

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