 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.
|
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
Private 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 String
End Type
Private Declare Function ChooseColor Lib "comdlg32.dll" _
Alias "ChooseColorA" _
(lpcc As CHOOSECOLORSTRUCT) As Long
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)
Next
'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 cc As CHOOSECOLORSTRUCT
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
Else
ctlcolor = vbWindowText
End If
'set the option and check backcolor
'to the form backcolor, and the
'control's text to the contrasting
'shade
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
Next
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
|
