By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
445,704 Members | 1,867 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 445,704 IT Pros & Developers. It's quick & easy.

Combo box to select colors

P: n/a
Hi,

How can I use then Windows' color picker from Access?

Thx
May 20 '06 #1
Share this Question
Share on Google+
4 Replies


P: n/a
You can use API calls. Paste the following into a standard module. There
is an example of it's use at the bottom.

Option Explicit

Private Const CDERR_DIALOGFAILURE = &HFFFF
Private Const CDERR_FINDRESFAILURE = &H6
Private Const CDERR_GENERALCODES = &H0
Private Const CDERR_INITIALIZATION = &H2
Private Const CDERR_LOADRESFAILURE = &H7
Private Const CDERR_LOADSTRFAILURE = &H5
Private Const CDERR_LOCKRESFAILURE = &H8
Private Const CDERR_MEMALLOCFAILURE = &H9
Private Const CDERR_MEMLOCKFAILURE = &HA
Private Const CDERR_NOHINSTANCE = &H4
Private Const CDERR_NOHOOK = &HB
Private Const CDERR_NOTEMPLATE = &H3
Private Const CDERR_REGISTERMSGFAIL = &HC
Private Const CDERR_STRUCTSIZE = &H1

Private Const CC_FULLOPEN = &H2
Private Const CC_PREVENTFULLOPEN = &H4
Private Const CC_RGBINIT = &H1

Private Type CHOOSECOLOR
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 ChooseColorDlg _
Lib "comdlg32.dll" Alias "ChooseColorA" ( _
pChoosecolor As CHOOSECOLOR _
) As Long

Private Declare Function CommDlgExtendedError _
Lib "comdlg32.dll" () As Long

Private Declare Sub CopyMemory _
Lib "kernel32" Alias "RtlMoveMemory" ( _
Destination As Any, _
Source As Any, _
ByVal Length As Long _
)
Public Function GetColor(lngHwnd As Long, arrCustColors() As Long, InitColor
As Long) As Boolean
Dim lngRet As Long
Dim intCount As Integer
Dim CC As CHOOSECOLOR

With CC
.lStructSize = Len(CC)
.flags = CC_FULLOPEN + CC_RGBINIT
.hwndOwner = lngHwnd
.lpCustColors = VarPtr(arrCustColors(0))
.rgbResult = InitColor
End With

GetColor = CBool(ChooseColorDlg(CC))
If GetColor Then
ReDim arrRet(0 To 15)
Call CopyMemory(arrRet(0), ByVal CC.lpCustColors, 64)
InitColor = CC.rgbResult
Else
lngRet = CommDlgExtendedError
Debug.Print lngRet
Select Case lngRet
Case CDERR_DIALOGFAILURE
Case CDERR_FINDRESFAILURE
Case CDERR_MEMLOCKFAILURE
Case CDERR_INITIALIZATION
Case CDERR_NOHINSTANCE
Case CDERR_LOCKRESFAILURE
Case CDERR_NOHOOK
Case CDERR_LOADRESFAILURE
Case CDERR_NOTEMPLATE
Case CDERR_LOADSTRFAILURE
Case CDERR_STRUCTSIZE
Case CDERR_MEMALLOCFAILURE
End Select
End If
End Function

Create a new form and put a command button (Command0) on the form pate th
ollowing code into the ommand buttons click event.

Private Sub Command0_Click()
Dim lngColor As Long
Dim arrCustColors() As Long

lngColor = Me.Command0.ForeColor
ReDim arrCustColors(0 To 15)
If GetColor(Me.Hwnd, arrCustColors(), lngColor) Then
Me.Command0.ForeColor = lngColor
End If

End Sub

Change to Form view click on the button and select a colour from the dialog.

Note: The arrCustColors array returns the colour values of any custom
colours you define. You can then persist these and reinitialize the dialog
pasing those values back in to initialise the custom colours.
--

Terry Kreft
"Michel" <mi***********@yahoo.ca> wrote in message
news:1n*********************@wagner.videotron.net. ..
Hi,

How can I use then Windows' color picker from Access?

Thx

May 21 '06 #2

P: n/a
Thanks

"Terry Kreft" <te*********@mps.co.uk> a écrit dans le message de news:
Ha********************@karoo.co.uk...
You can use API calls. Paste the following into a standard module. There
is an example of it's use at the bottom.

Option Explicit

Private Const CDERR_DIALOGFAILURE = &HFFFF
Private Const CDERR_FINDRESFAILURE = &H6
Private Const CDERR_GENERALCODES = &H0
Private Const CDERR_INITIALIZATION = &H2
Private Const CDERR_LOADRESFAILURE = &H7
Private Const CDERR_LOADSTRFAILURE = &H5
Private Const CDERR_LOCKRESFAILURE = &H8
Private Const CDERR_MEMALLOCFAILURE = &H9
Private Const CDERR_MEMLOCKFAILURE = &HA
Private Const CDERR_NOHINSTANCE = &H4
Private Const CDERR_NOHOOK = &HB
Private Const CDERR_NOTEMPLATE = &H3
Private Const CDERR_REGISTERMSGFAIL = &HC
Private Const CDERR_STRUCTSIZE = &H1

Private Const CC_FULLOPEN = &H2
Private Const CC_PREVENTFULLOPEN = &H4
Private Const CC_RGBINIT = &H1

Private Type CHOOSECOLOR
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 ChooseColorDlg _
Lib "comdlg32.dll" Alias "ChooseColorA" ( _
pChoosecolor As CHOOSECOLOR _
) As Long

Private Declare Function CommDlgExtendedError _
Lib "comdlg32.dll" () As Long

Private Declare Sub CopyMemory _
Lib "kernel32" Alias "RtlMoveMemory" ( _
Destination As Any, _
Source As Any, _
ByVal Length As Long _
)
Public Function GetColor(lngHwnd As Long, arrCustColors() As Long, InitColor As Long) As Boolean
Dim lngRet As Long
Dim intCount As Integer
Dim CC As CHOOSECOLOR

With CC
.lStructSize = Len(CC)
.flags = CC_FULLOPEN + CC_RGBINIT
.hwndOwner = lngHwnd
.lpCustColors = VarPtr(arrCustColors(0))
.rgbResult = InitColor
End With

GetColor = CBool(ChooseColorDlg(CC))
If GetColor Then
ReDim arrRet(0 To 15)
Call CopyMemory(arrRet(0), ByVal CC.lpCustColors, 64)
InitColor = CC.rgbResult
Else
lngRet = CommDlgExtendedError
Debug.Print lngRet
Select Case lngRet
Case CDERR_DIALOGFAILURE
Case CDERR_FINDRESFAILURE
Case CDERR_MEMLOCKFAILURE
Case CDERR_INITIALIZATION
Case CDERR_NOHINSTANCE
Case CDERR_LOCKRESFAILURE
Case CDERR_NOHOOK
Case CDERR_LOADRESFAILURE
Case CDERR_NOTEMPLATE
Case CDERR_LOADSTRFAILURE
Case CDERR_STRUCTSIZE
Case CDERR_MEMALLOCFAILURE
End Select
End If
End Function

Create a new form and put a command button (Command0) on the form pate th
ollowing code into the ommand buttons click event.

Private Sub Command0_Click()
Dim lngColor As Long
Dim arrCustColors() As Long

lngColor = Me.Command0.ForeColor
ReDim arrCustColors(0 To 15)
If GetColor(Me.Hwnd, arrCustColors(), lngColor) Then
Me.Command0.ForeColor = lngColor
End If

End Sub

Change to Form view click on the button and select a colour from the dialog.
Note: The arrCustColors array returns the colour values of any custom
colours you define. You can then persist these and reinitialize the dialog pasing those values back in to initialise the custom colours.
--

Terry Kreft
"Michel" <mi***********@yahoo.ca> wrote in message
news:1n*********************@wagner.videotron.net. ..
Hi,

How can I use then Windows' color picker from Access?

Thx


May 21 '06 #3

P: n/a
Thanks, but how and where do I define arrRet(0)?
It doesn't compile as it is.

"Terry Kreft" <te*********@mps.co.uk> a écrit dans le message de news:
Ha********************@karoo.co.uk...
You can use API calls. Paste the following into a standard module. There
is an example of it's use at the bottom.

Option Explicit

Private Const CDERR_DIALOGFAILURE = &HFFFF
Private Const CDERR_FINDRESFAILURE = &H6
Private Const CDERR_GENERALCODES = &H0
Private Const CDERR_INITIALIZATION = &H2
Private Const CDERR_LOADRESFAILURE = &H7
Private Const CDERR_LOADSTRFAILURE = &H5
Private Const CDERR_LOCKRESFAILURE = &H8
Private Const CDERR_MEMALLOCFAILURE = &H9
Private Const CDERR_MEMLOCKFAILURE = &HA
Private Const CDERR_NOHINSTANCE = &H4
Private Const CDERR_NOHOOK = &HB
Private Const CDERR_NOTEMPLATE = &H3
Private Const CDERR_REGISTERMSGFAIL = &HC
Private Const CDERR_STRUCTSIZE = &H1

Private Const CC_FULLOPEN = &H2
Private Const CC_PREVENTFULLOPEN = &H4
Private Const CC_RGBINIT = &H1

Private Type CHOOSECOLOR
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 ChooseColorDlg _
Lib "comdlg32.dll" Alias "ChooseColorA" ( _
pChoosecolor As CHOOSECOLOR _
) As Long

Private Declare Function CommDlgExtendedError _
Lib "comdlg32.dll" () As Long

Private Declare Sub CopyMemory _
Lib "kernel32" Alias "RtlMoveMemory" ( _
Destination As Any, _
Source As Any, _
ByVal Length As Long _
)
Public Function GetColor(lngHwnd As Long, arrCustColors() As Long, InitColor As Long) As Boolean
Dim lngRet As Long
Dim intCount As Integer
Dim CC As CHOOSECOLOR

With CC
.lStructSize = Len(CC)
.flags = CC_FULLOPEN + CC_RGBINIT
.hwndOwner = lngHwnd
.lpCustColors = VarPtr(arrCustColors(0))
.rgbResult = InitColor
End With

GetColor = CBool(ChooseColorDlg(CC))
If GetColor Then
ReDim arrRet(0 To 15)
Call CopyMemory(arrRet(0), ByVal CC.lpCustColors, 64)
InitColor = CC.rgbResult
Else
lngRet = CommDlgExtendedError
Debug.Print lngRet
Select Case lngRet
Case CDERR_DIALOGFAILURE
Case CDERR_FINDRESFAILURE
Case CDERR_MEMLOCKFAILURE
Case CDERR_INITIALIZATION
Case CDERR_NOHINSTANCE
Case CDERR_LOCKRESFAILURE
Case CDERR_NOHOOK
Case CDERR_LOADRESFAILURE
Case CDERR_NOTEMPLATE
Case CDERR_LOADSTRFAILURE
Case CDERR_STRUCTSIZE
Case CDERR_MEMALLOCFAILURE
End Select
End If
End Function

Create a new form and put a command button (Command0) on the form pate th
ollowing code into the ommand buttons click event.

Private Sub Command0_Click()
Dim lngColor As Long
Dim arrCustColors() As Long

lngColor = Me.Command0.ForeColor
ReDim arrCustColors(0 To 15)
If GetColor(Me.Hwnd, arrCustColors(), lngColor) Then
Me.Command0.ForeColor = lngColor
End If

End Sub

Change to Form view click on the button and select a colour from the dialog.
Note: The arrCustColors array returns the colour values of any custom
colours you define. You can then persist these and reinitialize the dialog pasing those values back in to initialise the custom colours.
--

Terry Kreft
"Michel" <mi***********@yahoo.ca> wrote in message
news:1n*********************@wagner.videotron.net. ..
Hi,

How can I use then Windows' color picker from Access?

Thx


May 21 '06 #4

P: n/a

It does compile I tested it before I posted.

There is sample code at the end, I'll post it again here. See the comment in
the code as the answer to your question.

Create a new form and put a command button (Command0) on the form paste the
following code into the command buttons click event.
Private Sub Command0_Click()
Dim lngColor As Long
Dim arrCustColors() As Long

lngColor = Me.Command0.ForeColor

' ************************************************** ***
' To answer your question this is where arrCustColors is dimensioned
' before it is passed to the GetColor function
' ************************************************** ***
ReDim arrCustColors(0 To 15)
If GetColor(Me.Hwnd, arrCustColors(), lngColor) Then
Me.Command0.ForeColor = lngColor
End If
End Sub
--

Terry Kreft
"Michel" <mi***********@yahoo.ca> wrote in message
news:wf********************@wagner.videotron.net.. .
Thanks, but how and where do I define arrRet(0)?
It doesn't compile as it is.

"Terry Kreft" <te*********@mps.co.uk> a écrit dans le message de news:
Ha********************@karoo.co.uk...
You can use API calls. Paste the following into a standard module. There is an example of it's use at the bottom.

Option Explicit

Private Const CDERR_DIALOGFAILURE = &HFFFF
Private Const CDERR_FINDRESFAILURE = &H6
Private Const CDERR_GENERALCODES = &H0
Private Const CDERR_INITIALIZATION = &H2
Private Const CDERR_LOADRESFAILURE = &H7
Private Const CDERR_LOADSTRFAILURE = &H5
Private Const CDERR_LOCKRESFAILURE = &H8
Private Const CDERR_MEMALLOCFAILURE = &H9
Private Const CDERR_MEMLOCKFAILURE = &HA
Private Const CDERR_NOHINSTANCE = &H4
Private Const CDERR_NOHOOK = &HB
Private Const CDERR_NOTEMPLATE = &H3
Private Const CDERR_REGISTERMSGFAIL = &HC
Private Const CDERR_STRUCTSIZE = &H1

Private Const CC_FULLOPEN = &H2
Private Const CC_PREVENTFULLOPEN = &H4
Private Const CC_RGBINIT = &H1

Private Type CHOOSECOLOR
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 ChooseColorDlg _
Lib "comdlg32.dll" Alias "ChooseColorA" ( _
pChoosecolor As CHOOSECOLOR _
) As Long

Private Declare Function CommDlgExtendedError _
Lib "comdlg32.dll" () As Long

Private Declare Sub CopyMemory _
Lib "kernel32" Alias "RtlMoveMemory" ( _
Destination As Any, _
Source As Any, _
ByVal Length As Long _
)
Public Function GetColor(lngHwnd As Long, arrCustColors() As Long,

InitColor
As Long) As Boolean
Dim lngRet As Long
Dim intCount As Integer
Dim CC As CHOOSECOLOR

With CC
.lStructSize = Len(CC)
.flags = CC_FULLOPEN + CC_RGBINIT
.hwndOwner = lngHwnd
.lpCustColors = VarPtr(arrCustColors(0))
.rgbResult = InitColor
End With

GetColor = CBool(ChooseColorDlg(CC))
If GetColor Then
ReDim arrRet(0 To 15)
Call CopyMemory(arrRet(0), ByVal CC.lpCustColors, 64)
InitColor = CC.rgbResult
Else
lngRet = CommDlgExtendedError
Debug.Print lngRet
Select Case lngRet
Case CDERR_DIALOGFAILURE
Case CDERR_FINDRESFAILURE
Case CDERR_MEMLOCKFAILURE
Case CDERR_INITIALIZATION
Case CDERR_NOHINSTANCE
Case CDERR_LOCKRESFAILURE
Case CDERR_NOHOOK
Case CDERR_LOADRESFAILURE
Case CDERR_NOTEMPLATE
Case CDERR_LOADSTRFAILURE
Case CDERR_STRUCTSIZE
Case CDERR_MEMALLOCFAILURE
End Select
End If
End Function

Create a new form and put a command button (Command0) on the form pate th ollowing code into the ommand buttons click event.

Private Sub Command0_Click()
Dim lngColor As Long
Dim arrCustColors() As Long

lngColor = Me.Command0.ForeColor
ReDim arrCustColors(0 To 15)
If GetColor(Me.Hwnd, arrCustColors(), lngColor) Then
Me.Command0.ForeColor = lngColor
End If

End Sub

Change to Form view click on the button and select a colour from the

dialog.

Note: The arrCustColors array returns the colour values of any custom
colours you define. You can then persist these and reinitialize the

dialog
pasing those values back in to initialise the custom colours.
--

Terry Kreft
"Michel" <mi***********@yahoo.ca> wrote in message
news:1n*********************@wagner.videotron.net. ..
Hi,

How can I use then Windows' color picker from Access?

Thx



May 22 '06 #5

This discussion thread is closed

Replies have been disabled for this discussion.