VBA – ChooseColor API x32 & x64

ChooseColor API Dialog

This is the first part, of a 2 part segment I’m working on, which explores how we can give user’s the ability to select colors within a database. In this post, I will go over using the ChooseColor API.
 

ChooseColor API

I though I’d break the code down into three versions:

  • 32-bit version
  • 64-bit version
  • Conditional Compiled version that works in both 32 and 64-bit versions

So you pick which version of the code you wish to use.

x32 Version

The following will work on 32-bit versions of Office applications.

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 Const CC_ANYCOLOR = &H100
'Private Const CC_ENABLEHOOK = &H10
'Private Const CC_ENABLETEMPLATE = &H20
'Private Const CC_ENABLETEMPLATEHANDLE = &H40
Private Const CC_FULLOPEN = &H2
Private Const CC_PREVENTFULLOPEN = &H4
Private Const CC_RGBINIT = &H1
Private Const CC_SHOWHELP = &H8
'Private Const CC_SOLIDCOLOR = &H80

Private Declare Function CHOOSECOLOR Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long


Public Function DialogColor(Optional lDefaultColor As Variant) As Long
    Dim CC                    As CHOOSECOLOR
    Dim lRetVal               As Long
    Static CustomColors(16)   As Long

    'Some predefined color, there are 16 slots available for predefined colors
    'You don't have to defined any, if you don't want to!
    CustomColors(0) = RGB(255, 255, 255)    'White
    CustomColors(1) = RGB(0, 0, 0)          'Black
    CustomColors(2) = RGB(255, 0, 0)        'Red
    CustomColors(3) = RGB(0, 255, 0)        'Green
    CustomColors(4) = RGB(0, 0, 255)        'Blue

    With CC
        .lStructSize = LenB(CC)
        .hwndOwner = Application.hWndAccessApp
        .flags = CC_ANYCOLOR Or CC_FULLOPEN Or CC_PREVENTFULLOPEN Or CC_RGBINIT
        If IsNull(lDefaultColor) = False _
           And IsMissing(lDefaultColor) = False Then .rgbResult = lDefaultColor    'Set the initial color of the dialog
        .lpCustColors = VarPtr(CustomColors(0))
    End With
    lRetVal = CHOOSECOLOR(CC)
    If lRetVal = 0 Then
        'Cancelled by the user
        DialogColor = RGB(255, 255, 255)    ' White
    Else
        DialogColor = CC.rgbResult
    End If
End Function

x64 Version

The following will work on 64-bit versions of Office applications.

Private Type ChooseColor
    lStructSize               As Long
    hwndOwner                 As LongPtr
    hInstance                 As LongPtr
    rgbResult                 As Long
    lpCustColors              As LongPtr
    flags                     As Long
    lCustData                 As LongPtr
    lpfnHook                  As LongPtr
    lpTemplateName            As String
End Type

Private Const CC_ANYCOLOR = &H100
'Private Const CC_ENABLEHOOK = &H10
'Private Const CC_ENABLETEMPLATE = &H20
'Private Const CC_ENABLETEMPLATEHANDLE = &H40
Private Const CC_FULLOPEN = &H2
Private Const CC_PREVENTFULLOPEN = &H4
Private Const CC_RGBINIT = &H1
'Private Const CC_SHOWHELP = &H8
'Private Const CC_SOLIDCOLOR = &H80

Private Declare PtrSafe Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As ChooseColor) As Long


Public Function DialogColor(Optional lDefaultColor As Variant) As Long
    Dim CC                    As ChooseColor
    Dim lRetVal               As Long
    Static CustomColors(16)   As Long

    'Some predefined color, there are 16 slots available for predefined colors
    'You don't have to defined any, if you don't want to!
    CustomColors(0) = RGB(255, 255, 255) 'White
    CustomColors(1) = RGB(0, 0, 0)       'Black
    CustomColors(2) = RGB(255, 0, 0)     'Red
    CustomColors(3) = RGB(0, 255, 0)     'Green
    CustomColors(4) = RGB(0, 0, 255)     'Blue

    With CC
        .lStructSize = LenB(CC)
        .hwndOwner = Application.hWndAccessApp
        .flags = CC_ANYCOLOR Or CC_FULLOPEN Or CC_PREVENTFULLOPEN Or CC_RGBINIT
        If IsNull(lDefaultColor) = False _
            And IsMissing(lDefaultColor) = False Then .rgbResult = lDefaultColor    'Set the initial color of the dialog
        .lpCustColors = VarPtr(CustomColors(0))
    End With
    lRetVal = ChooseColor(CC)
    If lRetVal = 0 Then
        'Cancelled by the user
        DialogColor = RGB(255, 255, 255)    ' White -> 16777215
    Else
        DialogColor = CC.rgbResult
    End If
End Function

x32 and x64 Conditional Compilation Version

The following, through Conditional Compilation, will work on both 32-bit and 64-bit versions of Office applications. So this is probably your best bet moving forward.

#If VBA7 Then
Private Type ChooseColor
    lStructSize               As Long
    hwndOwner                 As LongPtr
    hInstance                 As LongPtr
    rgbResult                 As Long
    lpCustColors              As LongPtr
    flags                     As Long
    lCustData                 As LongPtr
    lpfnHook                  As LongPtr
    lpTemplateName            As String
End Type
#Else
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
#End If

Private Const CC_ANYCOLOR = &H100
'Private Const CC_ENABLEHOOK = &H10
'Private Const CC_ENABLETEMPLATE = &H20
'Private Const CC_ENABLETEMPLATEHANDLE = &H40
Private Const CC_FULLOPEN = &H2
Private Const CC_PREVENTFULLOPEN = &H4
Private Const CC_RGBINIT = &H1
'Private Const CC_SHOWHELP = &H8
'Private Const CC_SOLIDCOLOR = &H80

#If VBA7 Then
    Private Declare PtrSafe Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As ChooseColor) As Long
#Else
    Private Declare Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As ChooseColor) As Long
#End If

Public Function DialogColor(Optional lDefaultColor As Variant) As Long
    Dim CC                    As ChooseColor
    Dim lRetVal               As Long
    Static CustomColors(16)   As Long

    'Some predefined color, there are 16 slots available for predefined colors
    'You don't have to defined any, if you don't want to!
    CustomColors(0) = RGB(255, 255, 255)    'White
    CustomColors(1) = RGB(0, 0, 0)       'Black
    CustomColors(2) = RGB(255, 0, 0)     'Red
    CustomColors(3) = RGB(0, 255, 0)     'Green
    CustomColors(4) = RGB(0, 0, 255)     'Blue

    With CC
        .lStructSize = LenB(CC)
        .hwndOwner = Application.hWndAccessApp
        .flags = CC_ANYCOLOR Or CC_FULLOPEN Or CC_PREVENTFULLOPEN Or CC_RGBINIT
        If IsNull(lDefaultColor) = False _
           And IsMissing(lDefaultColor) = False Then .rgbResult = lDefaultColor    'Set the initial color of the dialog
        .lpCustColors = VarPtr(CustomColors(0))
    End With
    lRetVal = ChooseColor(CC)
    If lRetVal = 0 Then
        'Cancelled by the user
        DialogColor = RGB(255, 255, 255)    ' White -> 16777215
    Else
        DialogColor = CC.rgbResult
    End If
End Function

 

Portability of this Code

In a general sense, this code should be portable within other Office Applications (Excel, Word, …) although there may be better solutions for other application. That said, there is one element that would need to be adapted depending on the Application you are intending to use it in, and that is the 

.hwndOwner = Application.hWndAccessApp

line, as Application.hWndAccessApp is Access specific, so you’d need to adjust that to whatever Hwnd method is used by your application. So say for Excel, you’d need to use Application.Hwnd and in Word you might do something like ActiveWindow.Hwnd.

Please, don’t ask me why Microsoft couldn’t standardize something as simple as retrieving an application’s Hwnd?! This is exactly the nonsensical thing that drives me nuts!

Disclaimer/Notes:

If you do not have Microsoft Access, simply download and install the freely available runtime version (this permits running MS Access databases, but not modifying their design):

Microsoft Access 2010 Runtime
Microsoft Access 2013 Runtime
Microsoft Access 2016 Runtime
Microsoft 365 Access Runtime

All code samples, download samples, links, ... on this site are provided 'AS IS'.

In no event will Devhut.net or CARDA Consultants Inc. be liable to the client/end-user or any third party for any damages, including any lost profits, lost savings or other incidental, consequential or special damages arising out of the operation of or inability to operate the software which CARDA Consultants Inc. has provided, even if CARDA Consultants Inc. has been advised of the possibility of such damages.

Download a Demo Database

Feel free to download a 100% unlocked demo copy by using the link provided below:

Download “Access - ChooseColor API Demo (x32 and x64)” Color_Picker_V1.000.zip – Downloaded 8422 times – 28.04 KB  

Looking For An Alternative

If you want another possible solution, be sure to check out:

Access - Color Picker
In my first part of this exploration of how to enable users to make color selections within a database, I demonstrated how we can use the built-in ChooseColor API dialog. This time round, I wanted to explore using an HTML color picker. Why, you might ask, well, I wanted to see what could be used…

Continue reading →

 

Page History

Date Summary of Changes
2020-12-13 Initial Public Release
2023-02-07 Added the Looking For An Alternative section

9 responses on “VBA – ChooseColor API x32 & x64”

  1. Greg Sevior

    Hi daniel

    You may want to take a look at the following Color picker as well. A lot less convoluted than the option you currently have posted here. It might be useful for someone.
    It will operate with 32/64 Bit. Full or Runtime.
    ———————————————————————————-
    Option Compare Database
    Option Explicit

    ‘Call: Me!ControlName.BackColor = ChooseWebColor(Me!ControlName.BackColor )

    ‘————————————————————————————–

    #If VBA7 Then
    Declare PtrSafe Sub wlib_AccColorDialog Lib “msaccess.exe” Alias “#53” (ByVal hwnd As LongPtr, lngRGB As LongPtr)
    #Else
    Declare Sub wlib_AccColorDialog Lib “msaccess.exe” Alias “#53” (ByVal Hwnd As Long, lngRGB As Long)
    #End If

    Public Function ChooseWebColor(DefaultWebColor As Variant) As String
    Dim lngColor
    lngColor = CLng(“&H” & Right(“000000” + Replace(Nz(DefaultWebColor, “”), “#”, “”), 6))
    wlib_AccColorDialog Screen.ActiveForm.hwnd, lngColor
    ChooseWebColor = Color_Hex_To_Long(“#” & Right(“000000” & Hex(lngColor), 6))

    End Function

    Public Function Color_Hex_To_Long(strColor As String) As Long

    Dim iRed As Integer
    Dim iGreen As Integer
    Dim iBlue As Integer

    strColor = Replace(strColor, “#”, “”)
    strColor = Right(“000000” & strColor, 6)
    iBlue = Val(“&H” & Mid(strColor, 1, 2))
    iGreen = Val(“&H” & Mid(strColor, 3, 2))
    iRed = Val(“&H” & Mid(strColor, 5, 2))

    Color_Hex_To_Long = RGB(iRed, iGreen, iBlue)
    End Function

    Function ForeColor_Contrast(lColor As Long) As Long
    On Error GoTo Err_Handler

    Dim HEXcolor As String
    Dim R As Integer
    Dim G As Integer
    Dim B As Integer

    HEXcolor = Right(“000000” & Hex(lColor), 6)

    ‘Determine current RGB color code
    R = CInt(“&H” & Right(HEXcolor, 2))
    G = CInt(“&H” & Mid(HEXcolor, 3, 2))
    B = CInt(“&H” & Left(HEXcolor, 2))

    If (R + G + B) > 255 Then
    ForeColor_Contrast = 2697513 ‘(dark)
    Else
    ForeColor_Contrast = 16514043 ‘(White)
    End If

    Exit_Handler:
    Exit Function
    Err_Handler:
    MsgBox “The following error has occurred.” & vbCrLf & vbCrLf & Err.Description, 16, “Select Color Error: ” & Err
    Resume Exit_Handler
    End Function

  4. Vapor

    Hello. Can you please tell me how i close the dialog of ChooseColor window in case i don’t hit ok or cancel or [x] … i ask because i need first close it in case it is open an i bring front my basic form. Thank you!

  5. rabid follower

    Daniel’s method works better than Greg’s in that the former pre-chooses the existing color and also lets me retain the original color. E.g. if the existing color is green, Daniel’s color picker automatically highlights green, whereas Greg’s color picker always highlights black. To retain the original color when I click Cancel, I do have to modify Daniel’s code a bit. Daniel’s code returns the white color when the user hits Cancel, and I have to change it to have it return the original color (lDefaultColor). But it’s impossible to do it with Greg’s code, since pressing Cancel always returns Black.

  7. John Winterbottom

    Thanks for this. One small comment, if you are using this in Access and calling the function from a form you might want to pass in the hwnd of the form (Me.hwnd) and use that instead of Application.hWndAccessApp so that color picker opens as a modal dialog.