Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Colour Picker with RGB

Status
Not open for further replies.
Aug 17, 2008
28
I need a simple color picker that will allow me to put the RGB values into seperate textboxes (Red in one box, Green in another, and Blue in another).

I got some code through our mutual friend Google, but I don't understand it. It shows a color picker, but I can't get the RGB values, let alone seperate them.

Code:
Private Type ChooseColorStruct
    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 Declare Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" _
    (lpChoosecolor As ChooseColorStruct) As Long
Private Declare Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor _
    As Long, ByVal lHPalette As Long, lColorRef As Long) As Long
    
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 Const CLR_INVALID = &HFFFF


' Show the common dialog for choosing a color.
' Return the chosen color, or -1 if the dialog is canceled
'
' hParent is the handle of the parent form
' bFullOpen specifies whether the dialog will be open with the Full style
' (allows to choose many more colors)
' InitColor is the color initially selected when the dialog is open

' Example:
'    Dim oleNewColor As OLE_COLOR
'    oleNewColor = ShowColorsDialog(Me.hwnd, True, vbRed)
'    If oleNewColor <> -1 Then Me.BackColor = oleNewColor

Function ShowColorDialog(Optional ByVal hParent As Long, _
    Optional ByVal bFullOpen As Boolean, Optional ByVal InitColor As OLE_COLOR) _
    As Long
    Dim CC As ChooseColorStruct
    Dim aColorRef(15) As Long
    Dim lInitColor As Long
  
    ' translate the initial OLE color to a long value
    If InitColor <> 0 Then
        If OleTranslateColor(InitColor, 0, lInitColor) Then
            lInitColor = CLR_INVALID
        End If
    End If
    
    'fill the ChooseColorStruct struct
    With CC
        .lStructSize = Len(CC)
        .hwndOwner = hParent
        .lpCustColors = VarPtr(aColorRef(0))
        .rgbResult = lInitColor
        .flags = CC_SOLIDCOLOR Or CC_ANYCOLOR Or CC_RGBINIT Or IIf(bFullOpen, _
            CC_FULLOPEN, 0)
    End With
    
    ' Show the dialog
    If ChooseColor(CC) Then
        'if not canceled, return the color
        ShowColorDialog = CC.rgbResult
        txtColour.Text = CC.rgbResult
    Else
        'else return -1
        ShowColorDialog = -1
    End If
End Function

Any help would be great.

GeodesicDragon
curquhart.co.uk
 
Oops, forgot this.

Code:
Private Type ChooseColorStruct
    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 Declare Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" _
    (lpChoosecolor As ChooseColorStruct) As Long
Private Declare Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor _
    As Long, ByVal lHPalette As Long, lColorRef As Long) As Long
    
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 Const CLR_INVALID = &HFFFF
 
While this example uses the common dialog showcolor method with no error checking, the color calculations should still be valid.
[tt]
Private Sub Command1_Click()
Dim MyColor As Long, R As Long, G As Long, B As Long
CD.ShowColor
MyColor = CD.Color
'16711680/65536
'65280/255
'255
If MyColor > 65536 Then
B = MyColor / 65536
MyColor = MyColor - (B * 65536)
End If
If MyColor > 256 Then
G = MyColor / 256
MyColor = MyColor - (G * 256)
End If
R = MyColor
Debug.Print R, G, B
End Sub
[/tt]

Good Luck

 
Or, if we like alternatives (and assumin that you go with vb5prgrmr's common dialog method (which shows the same dialog as all your API code)...
Code:
[blue]Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Type rgbCOLOUR
    R As Byte
    G As Byte
    B As Byte
End Type

Private Command1_Click()
    Dim myColour As rgbCOLOUR

    CD.ShowColor
    CopyMemory myColour, CD.Color, 3
    Debug.Print myColour.R, myColour.G, myColour.B
End Sub[/blue]
 
I do not have time to fully edit this ... but you should get idea


Maroon = 4194432
Orange = 33023
DarkBlue = 8388672
FlatGreen = 8421376

white=RGB(255,255,255)
snow=RGB(255,250,250)
ivory=RGB(255,255,240)
ghost =RGB(white,248,248,255)
white_smoke=RGB(245,245,245)
mintcream=RGB(245,255,250)
alice_blue=RGB(240,248,255)
azure=RGB(240,255,255)
honeydew=RGB(240,255,240)
light_cyan=RGB(224,255,255)
lavender=RGB(230,230,250)
oldlace=RGB(253,245,230)
linen=RGB(250,240,230)
cornsilk=RGB(255,248,220)
floral_white=RGB(255,250,240)
lavender_blush=RGB(255,240,245)
seashell=RGB(255,245,238)
antique_white=RGB(250,235,215)
light_yellow=RGB(255,255,224)
light_goldenrod=RGB(250,250,210)
lemon_chiffon=RGB(255,250,205)
beige=RGB(245,245,220)
papayawhip=RGB(255,239,213)
blanched_almond=RGB(255,235,205)
bisque=RGB(255,228,196)
navajo_white=RGB(255,222,173)
peachpuff=RGB(255,218,185)
moccasin=RGB(255,228,181)
wheat=RGB(245,222,179)
pale_goldenrod=RGB(238,232,170)
burlywood=RGB(222,184,135)
tan=RGB(210,180,140)
rosy_brown=RGB(188,143,143)
dark_salmon=RGB(233,150,122)
light_coral=RGB(240,128,128)
sandy_brown=RGB(244,164,96)
goldenrod=RGB(218,165,32)
peru=RGB(205,133,63)
dark_goldenrod=RGB(184,134,11)
chocolate=RGB(210,105,30)
indian_red=RGB(205,92,92)
firebrick,178,34,34
brown,165,42,42
sienna,160,82,45
saddle brown,139,69,19
maroon,128,0,0
dark red,139,0,0
crimson,220,20,60
red,255,0,0
orange red,255,69,0
tomato,255,99,71
salmon,250,128,114
coral,255,127,80
dark orange,255,140,0
orange,255,165,0
light salmon,255,160,122
misty rose,255,228,225
pink,255,192,203
light pink,255,182,193
thistle,216,191,216
plum,221,160,221
violet,238,130,238
orchid,218,112,214
magenta,255,0,255
fuchsia,255,0,255
hot pink,255,105,180
deep pink,255,20,147
pale violet red,219,112,147
medium violet red,199,21,133
medium orchid,186,85,211
dark orchid,153,50,204
dark violet,148,0,211
blue violet,138,43,226
medium purple,147,112,219
dark magenta,139,0,139
purple,128,0,128
pale turquoise,175,238,238
powder blue,176,224,230
light blue,173,216,230
light sky blue,135,206,250
light steel blue,176,196,222
cyan,0,255,255
aquamarine,127,255,212
turquoise,64,224,208
dark turquoise,0,206,209
deep sky blue,0,191,255
sky blue,135,206,235
medium turquoise,72,209,204
light sea green,32,178,170
cadet blue,95,158,160
dark cyan,0,139,139
teal,0,128,128
steel blue,70,130,180
cornflower blue,100,149,237
dodger blue,30,144,255
royal blue,65,105,225
blue,0,0,255
medium blue,0,0,205
medium slate blue,123,104,238
slate blue,106,90,205
dark slate blue,72,61,139
indigo,75,0,130
dark blue,0,0,139
navy,0,0,128
midnight blue,25,25,112
lime,0,255,0
lawn green,124,252,0
chartreuse,127,255,0
green yellow,173,255,47
pale green,152,251,152
light green,144,238,144
spring green,0,255,127
medium spring green,0,250,154
medium aquamarine,102,205,170
medium sea green,60,179,113
dark sea green,143,188,143
yellow green,154,205,50
lime green,50,205,50
sea green,46,139,87
forest green,34,139,34
green,0,128,0
dark green,0,100,0
dark khaki,189,183,107
olive drab,107,142,35
olive,128,128,0
dark olive green,85,107,47
khaki,240,230,140
gold,255,215,0
yellow,255,255,0
gainsboro,220,220,220
light grey,211,211,211
silver,192,192,192
lightish grey,169,169,169
light slate grey,119,136,153
slate grey,112,128,144
grey,128,128,128
grey,105,105,105
dark slate grey,47,79,79
dark grey,69,69,69
black,0,0,0
 
'Requires 1 Command Button, 1 Picture Box and 4 Text Boxes
'Add any picture to picture box
Public Sub GetRGBColors(Color As OLE_COLOR, R As Byte, G As Byte, B As Byte)
B = (Color \ 65536) And &HFF
G = (Color \ 256) And &HFF
R = Color And &HFF
End Sub

Private Sub Command1_Click()
Dim MyColor As OLE_COLOR
Dim MyRed As Byte
Dim MyBlue As Byte
Dim MyGreen As Byte

MyColor = Text1.Text
GetRGBColors MyColor, MyRed, MyBlue, MyGreen
Text2.Text = "Red: " & MyRed
Text3.Text = "Blue: " & MyBlue
Text4.Text = "Green: " & MyGreen

End Sub

Private Sub Form_Load()
Command1.Caption = "Get RGB"
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim MyRGB As Long
MyRGB = Picture1.Point(x, y)
Text1.Text = MyRGB
'Picture2.BackColor = MyRGB
End Sub
 
OOPS I had blue and green flipped here is proper use:

Code:
'Requires 1 Command Button, 1 Picture Box and 4 Text Boxes
'Add any picture to picture box
Public Sub GetRGBColors(Color As OLE_COLOR, R As Byte, G As Byte, B As Byte)
    B = (Color \ 65536) And &HFF
    G = (Color \ 256) And &HFF
    R = Color And &HFF
End Sub

Private Sub Command1_Click()
    Dim MyColor As OLE_COLOR
    Dim MyRed As Byte
    Dim MyGreen As Byte
    Dim MyBlue As Byte
    
    
    MyColor = Text1.Text
    GetRGBColors MyColor, MyRed, MyGreen, MyBlue
    Text2.Text = "Red: " & MyRed
    Text3.Text = "Green: " & MyGreen
    Text4.Text = "Blue: " & MyBlue

End Sub

Private Sub Form_Load()
    Command1.Caption = "Get RGB"
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim MyRGB As Long
    MyRGB = Picture1.Point(x, y)
    Text1.Text = MyRGB
    Picture2.BackColor = MyRGB
End Sub
 
>which shows the same dialog as all your API code)...

I thought something looked familiar about that code but didn't pay any attention to is as me old addled brain was in shutdown mode for the evening and not long after that me screen went into power save mode. :)

 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top