Binaryworld - How to display choose color dialogbox with custom color added at runti ... [ VB -> Dialogbox ]

VB Common dialog box control does not support adding custom color programatically at runtime. You have to use ChooseColor API to get this functionality. Here is the example

Step-By-Step Example

- Create a standard exe project
- Add one commandbutton
- Add the following code in form1

Click here to copy the following block

Private Declare Function ChooseColor Lib "comdlg32.dll" _
    Alias "ChooseColorA" _
    (lpChooseColor As udtCHOOSECOLOR) As Long

Private Type udtCHOOSECOLOR
  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

Public Function GetColor() As Long
  Dim rc As Long
  Dim pChooseColor As udtCHOOSECOLOR

  'In the original source code, this is dimensioned as a dynamic
  'array, but some experimenting yield this array as having a
  'maximum of 64 elements (4 bytes per custom box color)
  Dim CustomColors(63) As Byte

  '********************************************
  'This section defines the box colors using the Red, Green
  'Blue value assignments as indicated. There are 16 custom
  'color boxes so there will be 16 groups of 4 bytes as shown
  '********************************************
  'Define Colors For 1st Box, Top Row
  CustomColors(0) = 110  'Red Value
  CustomColors(1) = 34  'Green Value
  CustomColors(2) = 255  'Blue Value
  CustomColors(3) = 0  'Always zero

  'Define Colors For 2nd Box, Top Row
  CustomColors(4) = 230  'Red Value
  CustomColors(5) = 255  'Green Value
  CustomColors(6) = 10  'Blue Value
  CustomColors(7) = 0  'Always zero

  'Define Colors For 3rd Box, Top Row
  '  etc.
  '  etc.

  With pChooseColor
    .hwndOwner = 0
    .hInstance = App.hInstance
    .lpCustColors = StrConv(CustomColors, vbUnicode)
    .flags = 0
    .lStructSize = Len(pChooseColor)
  End With

  rc = ChooseColor(pChooseColor)

  If rc Then
    GetColor = pChooseColor.rgbResult
  End If

End Function

Private Sub Command1_Click()
  Me.BackColor = GetColor
End Sub

- Press F5 to run the project