Access Tips #343 色の設定ダイアログによって色を選択させる方法

#343

色の設定ダイアログによって色を選択させる方法

VBA、API

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

| Index | Prev | Next |