'================================================================
'= カラー選択ダイアログを開く
'=    (ChooseColor.bas)
'================================================================
#include "Windows.bi"

Type CHOOSECOLORSTRUCT
    lStructSize    As Long
    hwndOwner      As Long
    hInstance      As Long
    rgbResult      As Long
    lpCustColors   As Long
    flags          As Long
    lCustData      As Long
    lpfnHook       As Long
    lpTemplateName As Long
End Type

' カラー選択ダイアログボックスを開く
Declare Function Api_ChooseColor& Lib "comdlg32" Alias "ChooseColorA" (lpcc As CHOOSECOLORSTRUCT)

#define CC_RGBINIT              &H1     'crDef で指定された色を初期選択として使用
#define CC_FULLOPEN             &H2     '｢色の作成｣コントロールを開いた状態
#define CC_PREVENTFULLOPEN      &H4     '｢色の作成｣コントロールの使用を禁止
#define CC_SHOWHELP             &H8     '｢ヘルプ｣ボタンを表示
#define CC_ENABLEHOOK           &H10
#define CC_ENABLETEMPLATE       &H20    'nInstanceメンバとlpTemplateNameメンバで指定されたダイアログボックステンプレートを使ってダイアログを作成
#define CC_ENABLETEMPLATEHANDLE &H40
#define CC_SOLIDCOLOR           &H80    '基本色のうち、純色だけを表示
#define CC_ANYCOLOR             &H100   '利用可能な基本色をすべて表示

Var Shared Radio(2) As Object
Var Shared Button1 As Object

For i = 0 To 2
    Radio(i).Attach GetDlgItem("Radio" & Trim$(Str$(i+1)))
    Radio(i).SetFontSize 14
Next
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var cc As CHOOSECOLORSTRUCT
    Var Ret As Long

    cc.lStructSize = Len(CC)
    cc.hwndOwner = GethWnd
    If Radio(0).GetCheck = 1 Then cc.flags = CC_ANYCOLOR
    If Radio(1).GetCheck = 1 Then cc.flags = CC_ANYCOLOR Or CC_FULLOPEN
    If Radio(2).GetCheck = 1 Then cc.flags = CC_ANYCOLOR Or CC_PREVENTFULLOPEN
    cc.rgbResult = RGB(192, 192, 192)
    cc.lpCustColors = Varadr(BDF(0))

    Ret = Api_ChooseColor(cc)

    If Ret <> 0 Then
        BackColor = cc.rgbResult
        SetBackColor BackColor
        Cls
    End If
End Sub

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