ホーム > カテゴリ > Visual Basic >

カラー選定ダイアログを表示する

カラー選定ダイアログを表示するサンプルです。

サンプルの実行画面

APIの宣言

[ColorDlg.bas]

'------------------------------------------
'カラー選定ダイアログボックスを表示するAPI関数
'------------------------------------------
 
 'pChoosecolor:PAPY構造体（本当はCHOOSECOLOR構造体だがType名を変更しないと使用できない）
 '戻り値:OKボタンを押した時1, キャンセルボタンを押した時0

Public Declare Function CHOOSECOLOR Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As PAPY) As Long
  
Public Type PAPY
   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 String       'テンプレート名
 End Type
  
  
'----------------------------------------------
'メモリブロックを確保してそのハンドルを返すAPI関数
'----------------------------------------------
  
  'wFlags：定数（GHND_××参照）
  'dwBytes：確保するバイト数
  '戻り値：メモリブロックのハンドル

Public Declare Function GlobalAlloc Lib "KERNEL32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
     
Public Const GMEM_MOVEABLE = &H2                      '利用可能なメモリを確保
Public Const GMEM_ZEROINIT = &H40                     '新しく確保するメモリブロックの内容を0で初期化
Public Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)


'-------------------------------------
'メモリブロックのロックを解放するAPI関数
'-------------------------------------
  
  'hMem：メモリブロックのハンドル
  '戻り値：正常終了0

Public Declare Function GlobalFree Lib "KERNEL32" (ByVal hMem As Long) As Long
      
'---------------------------------------------------------
'グローバルヒープに確保されたメモリブロックをロックするAPI関数
'---------------------------------------------------------

  'hMem:GlobalAllocで戻ったハンドル
  '戻り値：メモリブロックの先頭を示すアドレス
   
Public Declare Function GlobalLock Lib "KERNEL32" (ByVal hMem As Long) As Long
    
'-------------------------------------
'メモリブロックのロックを解除するAPI関数
'-------------------------------------
  
  'hMem:グローバルメモリブロックのハンドル
  '戻り値：解除された時0

 Public Declare Function GlobalUnlock Lib "KERNEL32" (ByVal hMem As Long) As Long
      
'---------------------------------
'メモリの指定領域をコピーするAPI関数
'---------------------------------
 
  'Dest:コピー先のポインタ
  'Source:コピー元のポインタ
  'length:コピーするバイト数
  '戻り値：なし

Public Declare Sub MoveMemory Lib "KERNEL32" Alias "RtlMoveMemory" (Dest As Any, Source As Any, ByVal length As Long)
 
'------------------------------------------------------------------------
'■関数名　 ColorDlg
'■用途　　 カラー選定ダイアログボックスを表示して選択したカラー値を取得する
'■引数　　 nHandle:ウインドウハンドル, nColor:現在のカラー値
'■戻り値　 OKボタンを押した時、選択したカラー値、キャンセルボタンを押した時-1
'------------------------------------------------------------------------
Public Function ColorDlg(nHandle As Long, nColor As Long) As Long
  
  Dim Dlg As PAPY               'PAPY構造体
  Dim Ret As Long               '戻り値
  Dim hMem As Long              'メモリブロックハンドル
  Dim Address As Long           'カスタムカラー配列へのポインタ
  Dim Choose(15) As Long        '「作成した色」のカラー配列
  Dim i As Long                 '
     
     
        'ダイアログボックスの「作成した色」をすべて白にする
        For i = 0 To 15
            Choose(i) = &HFFFFFF
        Next
     
       'メモリブロックを確保してそのハンドルを取得
       hMem = GlobalAlloc(GHND, 64)
       'グローバルヒープに確保されたメモリブロックをロックする
       Address = GlobalLock(hMem)
       'メモリの領域をコピーする
       Call MoveMemory(ByVal Address, Choose(0), 64)


  'ダイアログボックスを呼び出す準備
   With Dlg
        .lStructSize = Len(Dlg)            '構造体のサイズを設定
        .hwndOwner = nHandle               'ウインドウハンドルを設定
        .hInstance = App.hInstance         'インスタンスハンドルを設定
        .rgbResult = nColor                '現在のカラー値を設定
        .lpCustColors = Address            'カスタムカラー配列へのポインタを設定
   End With
   
     'ダイアログボックスを呼び出す
     Ret = CHOOSECOLOR(Dlg)

    
    If Ret = 0 Then               'キャンセルボタンを押した時の処理
       ColorDlg = True
    Else                          'OKボタンを押した時の処理
       ColorDlg = Dlg.rgbResult      'カラー値を取得
    End If

     'メモリブロックのロックを解除する
     Ret = GlobalUnlock(hMem)
     'メモリブロックのロックを解放する
     Ret = GlobalFree(hMem)

 
End Function

APIの呼び出し

[ColorDlg.frm]

Private Sub Command1_Click()
  Dim Color As Long
      
   Color = ColorDlg(Form1.hWnd, Form1.ForeColor)
    
  '色を選択した場合にPictureBoxのバックカラーを選択した色にする
  '色を選択した場合に選択したカラー値をForm1のキャプションに表示する
     If Color <> -1 Then
        Form1.Caption = "カラー値　#" & Hex(Color)
        Picture1.BackColor = Color
     End If
    
End Sub

Private Sub Command2_Click()
Unload Me
End
End Sub

ソースコード一式のダウンロード

vbapi_colordlg.zip 2.97 KB (3,049 バイト)

このサンプルの動作環境について

このサンプルは 「Windows98」及び「Microsoft Visual Basic 5.0 Professional Edition」で確認しております。環境が異なる場合は正常に動作しない場合もございますのでご了承下さい。





関連記事


前の記事：アニメーションコントロールを作成する
次の記事：ダイアログ付きでファイルをコピーする

公開日：2015年03月03日
記事NO：00319