Library code snippets
Colour Picker
By xtremecode, published on 22 Feb 2002
p>This sample code creates a very simple colour picker window, and converts the selected colour to its HEX code for use in a HTML web page
First, add 2 picture boxes, called pctColors and pctPic, and a TextBox called txtRGB. Set pctColors' picture property to the one included in the related ZIP file. Next, add the following code to the form
Private MFColor As RGBColor
'+-----------------------------------
' My Type
'+-----------------------------------
Private Type RGBColor
R As String
G As String
B As String
End Type
Function GetRGB(RGBval As Double, Num As Integer) As Integer
If Num > 0 And Num < 4 And RGBval > -1 And RGBval < 16777216 Then
GetRGB = RGBval \ 256 ^ (Num - 1) And 255
Else
GetRGB = True
End If
End Function
Private Sub Form_Activate()
'Call MsgBox("This a <b>VERY</b> simple program who gets colors in hex format.", vbInformation + vbOKOnly, "XtremeCode: VERY simple VB aplication")
End Sub
Private Sub Form_Load()
SavePicture pctColors.Picture, "c:\temp\colourpicker.bmp"
'pctColors.Picture = LoadResPicture(102, 0)
End Sub
Private Sub pctColors_Click()
tbRGB.Text = "#" & PharseChar(CStr(Hex(MFColor.R))) & PharseChar(CStr(Hex(MFColor.G))) & PharseChar(CStr(Hex(MFColor.B)))
tbRGB.BackColor = RGB(MFColor.R, MFColor.G, MFColor.B)
tbRGB.ForeColor = RGB(255 - MFColor.R, 255 - MFColor.G, 255 - MFColor.B)
End Sub
Private Sub pctColors_DblClick()
tbRGB.Text = "#" & PharseChar(CStr(Hex(MFColor.R))) & PharseChar(CStr(Hex(MFColor.G))) & PharseChar(CStr(Hex(MFColor.B)))
End Sub
Private Sub pctColors_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim XYColor As Double
XYColor = pctColors.Point(x, y)
If XYColor = -1 Then Exit Sub
MFColor.R = GetRGB(CDbl(XYColor), 1)
MFColor.G = GetRGB(CDbl(XYColor), 2)
MFColor.B = GetRGB(CDbl(XYColor), 3)
pctPic.BackColor = RGB(MFColor.R, MFColor.G, MFColor.B)
tbLogo.ForeColor = RGB(255 - MFColor.R, 255 - MFColor.G, 255 - MFColor.B)
End Sub
Private Sub tbRGB_GotFocus()
tbRGB.SelStart = 0
tbRGB.SelLength = Len(tbRGB.Text)
End Sub
Private Function PharseChar(ByVal strRGB As String) As String
'+
' If R/G/B value is one number adds an 0
'-
PharseChar = strRGB
If Len(strRGB) = 1 Then PharseChar = "0" & CStr(strRGB)
End Function
Related articles
Related discussion
-
VB6, SQL 2005 & DMO
by elajaunie3 (1 replies)
-
sending sms from pc
by sriraj20074 (0 replies)
-
Automating Excel from VB6.0
by epurdy (0 replies)
-
VB6 system conversion using VBA to Word 2007
by b.macgregor@vodamail.co.za (0 replies)
-
video not working with visual basic
by Jupiter 2 (9 replies)
Related podcasts
-
Christian Beauclair
14 mai 2008 (�mission #0074) ::.Christian Beauclair: Stratégies de migration VB6 vers .NET Nous discutons avec Christian Beauclair des stratégies de migration VB6 vers .NET. Entre autres, nous discutons comment utiliser le "VB 6 Code Advisor" et le "Interop Forms Toolkit" pour ajouter la puiss...
This thread is for discussions of Colour Picker.