Color picker de windows

Commenter

Contenu du snippet

Code qui permet de choisir une color en montrant la fenêtre de windows Color Picker

Source / Exemple : 


'Mettre ce code dans un module

Type CHOOSECOLOR
    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

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

Public Function gfnLongToRGBString(lColor As Long) As String
   Dim iRed, iGreen, iBlue As Byte
   iRed = lColor Mod 256
   iGreen = ((lColor And &HFF00) / 256&) Mod 256&
   iBlue = (lColor And &HFF0000) / 65536
   gfnLongToRGBString = Str$(iRed) & Str$(iGreen) & Str$(iBlue)
End Function

Public Sub cChooseColor(ByRef frm As Form)
    Dim cc As CHOOSECOLOR
    Dim Custcolor(16) As Long
    Dim lReturn As Long
    Dim rgbVal As String
    ReDim CustomColors(0 To 16 * 4 - 1) As Byte
    Dim i As Integer
    Dim red, green, blue As String
    
    For i = LBound(CustomColors) To UBound(CustomColors)
        CustomColors(i) = 0
    Next i
    cc.lStructSize = Len(cc)
    cc.hWndOwner = frm.hWnd
    cc.hInstance = App.hInstance
    cc.lpCustColors = StrConv(CustomColors, vbUnicode)
    cc.flags = 0

    lReturn = CHOOSECOLOR(cc)
    If lReturn <> 0 Then
        'Change la couleur de fond de la form
        frm.BackColor = Str$(cc.rgbResult)
        CustomColors = StrConv(cc.lpCustColors, vbFromUnicode)
        
        rgbVal = LTrim(RTrim(gfnLongToRGBString(cc.rgbResult)))
    
        red = Mid(rgbVal, 1, InStr(rgbVal, " ") - 1)
        green = Mid(rgbVal, Len(red) + 2, InStr(Len(red) + 2, rgbVal, " ") - Len(red) - 2)
        blue = Right(rgbVal, Len(rgbVal) - Len(red) - Len(green) - 2)
        
        Do While Len(red) <> 3
            red = "0" & red
        Loop
        Do While Len(green) <> 3
            green = "0" & green
        Loop
        Do While Len(blue) <> 3
            blue = "0" & blue
        Loop
    Else
        Exit Sub
    End If
End Sub

'Mettre ce code dans un formulaire

Private Sub form_Load()
    Call cChooseColor(Form1)
End Sub

Conclusion :


Ce programme peut être modifier pour changer la couleur de ce que vous voulez.

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_syrex)