#343
Windows APIを使って「色の設定」ダイアログを表示させる方法です。
まず、標準モジュールに次のようなコードを記述します。これはいずれも色の設定ダイアログを利用するためのAPIに関する宣言で、モジュールのDeclarationsセクションに記述します。
Private Type ChooseColor
lStructSize As Long
hWndOwner As Long
hInstance As Long
rgbResult As Long
lpCustColors As String
flags As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Declare Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" _
(pChoosecolor As ChooseColor) As Long
Private Const CC_RGBINIT = &H1 '色のデフォルト値を設定
Private Const CC_LFULLOPEN = &H2 '色の作成を行う部分を表示
Private Const CC_PREVENTFULLOPEN = &H4 '色の作成ボタンを無効にする
Private Const CC_SHOWHELP = &H8 'ヘルプボタンを表示
続いて、次のようなFunctionプロシージャを標準モジュール内に作成します。これは「色の設定ダイアログを表示してそこで選択された色を返す」一連の処理をひとまとめにしたプロシージャです。これを自分で作ったフォームなどのモジュールから呼び出すことで、簡単な記述で汎用的に利用することができます。
Public Function GetColorDlg(lngDefColor As Long) As Long
'機能 ： 色の設定ダイアログを表示し、そこで選択された色のRGB値を返す
'引数 ： lngDefColor デフォルト表示する色
'返値 ： 成功時 RGB値 キャンセル時-1 エラー時 -2 （ゼロは黒なので注意）
Dim udtChooseColor As ChooseColor
Dim lngRet As Long
With udtChooseColor
'ダイアログの設定
.lStructSize = Len(udtChooseColor)
.hWndOwner = Application.hWndAccessApp
.lpCustColors = String$(64, Chr$(0))
.flags = CC_RGBINIT + CC_LFULLOPEN
.rgbResult = lngDefColor
'ダイアログを表示
lngRet = ChooseColor(udtChooseColor)
'ダイアログからの返り値をチェック
If lngRet <> 0 Then
If .rgbResult > RGB(255, 255, 255) Then
'エラー
GetColorDlg = -2
Else
'正常終了、RGB値を返り値にセット
GetColorDlg = .rgbResult
End If
Else
'キャンセルが押されたとき
GetColorDlg = -1
End If
End With
End Function
次のプログラムならびに画面は、上記プロシージャの実際のフォームでの利用例です。[色の変更]ボタンをクリックすると、色の設定ダイアログが表示され、"ボックス1"という名前の四角形コントロールの背景色をその色に変更します。
Private Sub cmd色の変更_Click()
Me!ボックス1.BackColor = GetColorDlg(Me!ボックス1.BackColor)
End Sub
Me!ボックス1.BackColor = GetColorDlg(Me!ボックス1.BackColor)
End Sub
