Visual Basic Common Dialog Routines
ChooseColor: Using the ChooseColor Common Dialog API
Posted:   Wednesday March 27, 2002
Updated:   Monday December 26, 2011
Applies to:   VB4-32, VB5, VB6
Developed with:   VB4-32, Windows 95
Revised with:   VB6, Windows NT4; VB6,  Windows XP
OS restrictions:   None
Author:   VBnet - Randy Birch
Related:   ChooseColor: Using the ChooseColor Common Dialog API
ChooseColor: Centering and Customizing the ChooseColor Common Dialog

One of the simplest of the Common Dialog APIs to call, the ChooseColor dialog presents the standard Windows color-picker just like the Common Dialog OCX's ShowColor method.

Although the API uses a structure to pass parameters to the ChooseColor API, the dialog can be shown by providing just the flags, hwndOwner, lStructSize and lpCustColors members completed. Other options, such as a hook, can be added to provide additional functionality such as positioning, custom captions, renaming and / or reorganizing the controls. VB does not easily support the use of Templates, so the lpTemplateName member will not be discussed.

This is just about the simplest code to demo the ChooseColor API. Code populates an array of longs with a series of gray values used as the Custom Colors when initially displaying the dialog. With the array declared at form level its values remain persistent between calls. (A simple Binary file save would write the array to disk to provide for persistence between sessions.)  Flags specified by the option and check boxes are OR'd, a pointer to the custom colour array is assigned to lpCustColors, and the API is called.

To complete the demo, the return value from the call is assigned as the form's BackColor. To enable the demo to maintain readability regardless of color selected, some additional code is tossed in to extract the constituent R, G, and B values from the color and based on the values, toggle the text color of the option/check buttons to a contrasting color.

 BAS Module Code

 Form Code
To a new project form add two command buttons (Command1, Command2), three option buttons (Option1, Option2, Option3), and a checkbox (Check1). Add the following code to the form:

Option Explicit
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
'static array to contain the custom
'colours selected by the user
Private dwCustClrs(0 To 15) As Long

'ChooseColor structure flag constants
Private Const CC_RGBINIT         As Long = &H1
Private Const CC_FULLOPEN        As Long = &H2
Private Const CC_PREVENTFULLOPEN As Long = &H4
Private Const CC_SOLIDCOLOR      As Long = &H80
Private Const CC_ANYCOLOR        As Long = &H100

   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

Private Declare Function ChooseColor Lib "comdlg32.dll" _
   Alias "ChooseColorA" _

Private Sub Form_Load()
  'initialize the custom colours
  'with a series of gray shades
   Dim cnt As Long
   For cnt = 240 To 15 Step -15
      dwCustClrs((cnt \ 15) - 1) = RGB(cnt, cnt, cnt)
  'initialize controls
   Option1.Caption = "Display normally"
   Option1.Value = True
   Option2.Caption = "Display with Define Custom Colors open"
   Option3.Caption = "Disable Define Custom Colors button"
   Check1.Caption = "Specify initial colour is form BackColor"
   Command1.Caption = "Choose Color"
End Sub

Private Sub Command1_Click()

   Dim r As Long
   Dim g As Long
   Dim b As Long
   With cc
     'set the flags based on the
     'check and option buttons
      .flags = CC_ANYCOLOR
      If Option2.Value = True Then .flags = .flags Or CC_FULLOPEN
      If Option3.Value = True Then .flags = .flags Or CC_PREVENTFULLOPEN
      If Check1.Value = 1 Then
         .flags = .flags Or CC_RGBINIT
         .rgbResult = Form1.BackColor
      End If
      'size of structure
      .lStructSize = Len(cc)
      'owner of the dialog
      .hwndOwner = Me.hWnd
      'assign the custom colour selections
      .lpCustColors = VarPtr(dwCustClrs(0))
   End With
   If ChooseColor(cc) = 1 Then
     'assign the selected colour
     'as the form background
      Me.BackColor = cc.rgbResult
     'bonus .. assure the text remains
     'readable regardless of colour
     'by splitting out the respective
     'RGB values, and adjusting the text
     'colour to contrast
      Call GetRBGFromCLRREF(cc.rgbResult, r, g, b)
      Call UpdateControlShadeSelection(r, g, b)
   End If

End Sub

Private Sub UpdateControlShadeSelection(r As Long, g As Long, b As Long)

   Dim ctlcolor As Long
   Dim ctl As Control
  'if the value of the colour passed
  '(representing the current colour)
  'is less than 128, show white text
  'otherwise show black text
   If (r < 128) And (g < 128) Or _
      (g < 128) And (b < 128) Or _
      (r < 128) And (b < 128) Then
      ctlcolor = vbWhite
      ctlcolor = vbWindowText
   End If
  'set the option and check backcolor
  'to the form backcolor, and the
  'control's text to the contrasting
   For Each ctl In Controls
      If TypeOf ctl Is OptionButton Or _
         TypeOf ctl Is CheckBox Then
         ctl.BackColor = RGB(r, g, b)
         ctl.ForeColor = ctlcolor
      End If
End Sub

Private Sub GetRBGFromCLRREF(ByVal clrref As Long, _
                             r As Long, g As Long, b As Long)
  'pass a hex colour, return the rgb components
   b = (clrref \ 65536) And &HFF
   g = (clrref \ 256) And &HFF
   r = clrref And &HFF
End Sub

Private Sub Command2_Click()

   Unload Me

End Sub
VB4-32 users will need to define VarPtr as an API from the runtime. See the MSDN for the API declaration.


PayPal Link
Make payments with PayPal - it's fast, free and secure!


Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy


Hit Counter