Private Declare Function ChooseColorA Lib "comdlg32.dll" (pChoosecolor As tChooseColor) As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Type tChooseColor
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
'Purpose : Shows the Choose Color Dialog
'Inputs : N/A
'Outputs : Returns -1 if the user pressed cancel, else returns the selected color
Function ShowColor() As Long
Dim tColor As tChooseColor
Dim Custcolor(16) As Long
Dim lReturn As Long, lThisColor As Long
Dim abytCustomColors(0 To 16 * 4 - 1) As Byte
For lThisColor = LBound(abytCustomColors) To UBound(abytCustomColors)
abytCustomColors(lThisColor) = 0
Next
tColor.lStructSize = Len(tColor)
tColor.hwndOwner = GetActiveWindow 'or Me.hwnd in VB
tColor.hInstance = 1 'or App.hInstance in VB
'Convert the custom colors to Unicode
tColor.lpCustColors = StrConv(abytCustomColors, vbUnicode)
tColor.flags = 0
'Show the dialog
If ChooseColorA(tColor) <> 0 Then
ShowColor = tColor.rgbResult
Else
ShowColor = -1
End If
End Function
No comments:
Post a Comment