Question 91

Comment afficher la boîte de dialogue "ChooseColor" en utilisant les API ?

La fonction suivante permet d'afficher la boîte de dialogue "ChooseColor". Les 16 couleurs personnalisées sont stockées dans le tableau dwCustClrs, déclaré en global.

Option Explicit

' Déclaration de l'API
Private Declare Function ChooseColorDlg Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long

' Constantes utilisées par ChooseColor
Private Const CC_RGBINIT = &H1&
Private Const CC_FULLOPEN = &H2&
Private Const CC_PREVENTFULLOPEN = &H4&
Private Const CC_SHOWHELP = &H8&
Private Const CC_ENABLEHOOK = &H10&
Private Const CC_ENABLETEMPLATE = &H20&
Private Const CC_ENABLETEMPLATEHANDLE = &H40&
Private Const CC_SOLIDCOLOR = &H80&
Private Const CC_ANYCOLOR = &H100&

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 dwCustClrs(0 To 15) As Long ' Tableau statique contenant les couleurs personnalisées

'---------------------------------------------------------------------------------------
' Function :    ChooseColorDialog
' DateTime :    29/08/2002 21:44
' Auteur :      Pierre Alexis
' Type-retour : Long (représentant une couleur)
' But :         Cette fonction affiche la boîte de dialogue "ChooseColor" et retourne
'               une couleur.
'---------------------------------------------------------------------------------------
Private Function ChooseColorDialog(DefaultColor As Long) As Long

    Dim lpChoosecolor As CHOOSECOLOR

    With lpChoosecolor
        .lStructSize = Len(lpChoosecolor)
        .hwndOwner = hWnd
        .rgbResult = DefaultColor
        .lpCustColors = VarPtr(dwCustClrs(0))
        .flags = CC_ANYCOLOR Or CC_RGBINIT Or CC_FULLOPEN
    End With

    If ChooseColorDlg(lpChoosecolor) Then
        ChooseColorDialog = lpChoosecolor.rgbResult
    Else
        ChooseColorDialog = -1
    End If

End Function

Private Sub Form_Click()

    Dim NewColor As Long

    NewColor = ChooseColorDialog(Me.BackColor)
    If NewColor <> -1 Then
        Me.BackColor = NewColor
    End If

End Sub

Private Sub Form_Load()

    Dim cnt As Long

    ' Intialise le tableau les couleurs personnalisées avec du blanc
    For cnt = 0 To 15
        dwCustClrs(cnt) = RGB(255, 255, 255)
    Next

    Me.BackColor = RGB(95, 191, 240)
    Me.Caption = "Cliquez-moi !"

End Sub

La documentation complète sur l'API ChooseColor se trouve sur la MSDN.