Private Type udtCHOOSECOLOR
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
Public Enum ColorDialogFlags
UseInitialColor = &H1
ShowCustomColorsOnLoad = &H2
DisableCustomColors = &H4
ShowHelp = &H8
OnlySolidColors = &H80
AllowAnyColor = &H100
Default = &H1 Or &H100
End Enum
Private CDColor As udtCHOOSECOLOR
Private Declare Function ChooseColor Lib "comdlg32.dll" _
Alias "ChooseColorA" (pChoosecolor As udtCHOOSECOLOR) As Long
Private Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
Public Function GetColor(ByVal T_hWnd As Long, ByVal Flags As ColorDialogFlags, _
Optional ByVal InitialColor As Long) As Long
'Dimension a variable.
Dim CustColors(0 To 15) As Long
'Set up the colour configuration.
For I = 0 To 15
CustColors(I) = vbWhite
Next
CDColor.Flags = Flags
CDColor.hWndOwner = T_hWnd
CDColor.hInstance = App.hInstance
CDColor.lpCustColors = VarPtr(CustColors(0))
CDColor.lStructSize = Len(CDColor)
CDColor.rgbResult = InitialColor
lngResult = ChooseColor(CDColor)
'Get the colour that is selected.
If lngResult = 1 And CommDlgExtendedError = 0 Then
GetColor = CDColor.rgbResult
Else
GetColor = -1
End If
End Function
No comments:
Post a Comment