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
Comments