ACC: Sample Function to Use the COMMDLG Color Dialog Box

• Microsoft Access versions 1.0, 1.1, 2.0

SUMMARY

Advanced: Requires expert coding, interoperability, and multiuser skills.

The Palette in Microsoft Access provides a limited selection of colors for database objects and does not allow you to create custom colors. However, the BackColor, ForeColor, and BorderColor properties of forms and reports will accept any valid RGB color value.

This article lists a sample Access Basic function called ChooseColor() that uses the Microsoft Windows standard Color dialog box so that you can choose from a greater selection of colors or create your own custom color.

NOTE: In Access for Windows 95, the new Color Builder Wizard is included which replaces the functionality of the ChooseColor function. For more information about the Color Builder, search for "Color Builder" using the Microsoft Access for Windows 95 Help Index.

This article assumes that you are familiar with Access Basic and with creating Microsoft Access applications using the programming tools provided with Microsoft Access. For more information on Access Basic, please refer to the "Introduction to Programming" manual in Microsoft Access version 1.x, or the "Building Applications" manual, Chapter 3, "Introducing Access Basic" in version 2.0.

MORE INFORMATION

To set up the sample function ChooseColor(), create a new module with the following Declarations section and function:

NOTE: In the following sample code, an underscore (_) is used as a line- continuation character. Remove the underscore when re-creating this code in Access Basic.

   '********************************************************************
   ' MODULE DECLARATION SECTION
   '********************************************************************
   Option Explicit

   '
   ' Required COMMDLG Declarations
   '
   Type ChooseColor
      lStructSize As Long
      hwndOwner As Integer
      hInstance  As Integer
      RgbResult As Long
      lpCustColors As Long
      Flags As Long
      lCustData As Long
      lpfnHook As Long
      lpTemplateName As Long
   End Type

   Global Const CC_RGBINIT = &H1
   Global Const CC_FULLOPEN = &H2

   Declare Function ChooseColor_API Lib "COMMDLG.DLL" Alias _
      "ChooseColor" (pCHOOSECOLOR As ChooseColor) As Integer
   Declare Function CommDlgExtendedError Lib "COMMDLG.DLL" () As Long

   '
   ' Global Memory Declarations
   '
   Declare Function GlobalAlloc Lib "Kernel" _
      (ByVal wFlags As Integer, ByVal dwBytes As Long) As Integer
   Declare Function GlobalFree Lib "Kernel" _
      (ByVal hMem As Integer) As Integer
   Declare Function GlobalLock Lib "Kernel" _
      (ByVal hMem As Integer) As Long
   Declare Function GlobalUnlock Lib "Kernel" _
      (ByVal hMem As Integer) As Integer

   Global Const GMEM_MOVEABLE = &H2
   Global Const GMEM_ZEROINIT = &H40
   Global Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)

   Declare Sub hmemcpy Lib "Kernel" _
      (lpDest As Any, lpSource As Any, ByVal dwBytes As Long)

   '********************************************************************
   ' FUNCTION: ChooseColor
   '
   ' PURPOSE:
   '   Uses the standard Windows Color dialog box in COMMDLG.DLL to get
   '   a 256-color RGB value for use in Microsoft Access. The returned
   '   value can be used in the BackColor, ForeColor, or BorderColor
   '   properties.
   '
   ' ARGUMENTS:
   '   DefaultColor - The default RGB color to be selected.
   '                  Black, 0, is usually the default.
   '
   ' RETURN VALUE:
   '   >=0  The user-selected RGB value
   '   -1   Couldn't allocate global memory
   '   -2   Couldn't lock global memory
   '   -3   COMMDLG error occurred. A message box will display the
   '        number prior to this function exiting.
   '
   ' ********************************************************************
   Function ChooseColor (ByVal DefaultColor As Long) As Long
      Dim C As ChooseColor
      Dim MemHandle As Long
      Dim Result As Integer, i As Integer

      ' Define CustomColor array, address, size variables
      ReDim CustomColors(15) As Long
      Dim CustomColorsAddress As Long
      Dim CustomColorsSize As Integer

      ' Fill custom colors array with all white
      For i = 0 To UBound(CustomColors)
         CustomColors(i) = &HFFFFFF
      Next

      ' Get size of global memory needed for custom colors
      CustomColorsSize = Len(CustomColors(0)) * 16

      ' Get a global memory block to hold a copy of the custom colors
      MemHandle = GlobalAlloc(GHND, CustomColorsSize)
      If MemHandle = 0 Then
         ChooseColor = -1
         Exit Function
      End If

      ' Lock the custom color's global memory block
      CustomColorsAddress = GlobalLock(MemHandle)
      If CustomColorsAddress = 0 Then
         ChooseColor = -2
         Exit Function
      End If

      ' Copy custom colors to the global memory block
      Call hmemcpy(ByVal CustomColorsAddress, _
         CustomColors(0), CustomColorsSize)

      ' Initialize Choose Color structure
      C.lStructSize = Len(C)
      C.hwndOwner = 0&
      C.lpCustColors = CustomColorsAddress
      C.RgbResult = DefaultColor
      C.Flags = CC_RGBINIT Or CC_FULLOPEN

      ' Call the Choose Color COMMDLG routine
      Result = ChooseColor_API(C)

      ' Did an error occur?
      If Result = 0 And CommDlgExtendedError() <> 0 Then
         ChooseColor = -3
         MsgBox Str$(CommDlgExtendedError()), 16, "Choose Color Error"
      End If

      ' Copy the new custom colors to the CustomColors address locally
      ' .. CustomColor array will now contain list of new custom colors
      Call hmemcpy(CustomColors(0), _
         ByVal CustomColorsAddress, CustomColorsSize)

      ' Unlock and free the global memory block
      Result = GlobalUnlock(MemHandle)
      Result = GlobalFree(MemHandle)

      ' Return the selected color
      ChooseColor = C.RgbResult

   End Function

How to Use the ChooseColor() Function

The following sample Access Basic function demonstrates how to use the ChooseColor() function:

   Function GetColor()
      MsgBox Str$(ChooseColor(0))
   End Function

The GetColor() function can be called from a command button by entering the following for the button's OnPush property:

   =GetColor()