Welcome to HBH! If you have tried to register and didn't get a verification email, please using the following link to resend the verification email.
Finding the content of RGB in an color - Visual Basic Code Bank
Finding the content of RGB in an color
Finding the content of RGB in an color using Visual Basic.
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 6510
ClientLeft = 285
ClientTop = 1785
ClientWidth = 9480
FontTransparent = 0 'False
LinkTopic = "Form1"
LockControls = -1 'True
ScaleHeight = 6510
ScaleWidth = 9480
Begin VB.TextBox Text2
Height = 495
Left = 2400
TabIndex = 2
Text = "Text2"
Top = 0
Width = 1215
End
Begin VB.TextBox Text1
Height = 495
Left = 3600
TabIndex = 1
Text = "Text1"
Top = 240
Width = 1815
End
Begin MSComDlg.CommonDialog cd1
Left = 4560
Top = -360
_ExtentX = 847
_ExtentY = 847
_Version = 393216
CancelError = -1 'True
DialogTitle = "Load"
Filter = "Bitmaps (*.bmp)|*.bmp|GIF Images (*.gif)|*.gif|JPEG Images (*.jpg)|*.jpg|Icons (*.ico)|*.ico|All Files (*.*)|*.*"
End
Begin VB.PictureBox Picture1
AutoSize = -1 'True
FontTransparent = 0 'False
Height = 600
Left = 240
ScaleHeight = 36
ScaleMode = 3 'Pixel
ScaleWidth = 181
TabIndex = 0
Top = 840
Width = 2775
End
Begin VB.Shape Shape4
BackStyle = 1 'Opaque
FillColor = &H8000000D&
Height = 375
Left = 8040
Shape = 2 'Oval
Top = 360
Visible = 0 'False
Width = 975
End
Begin VB.Shape Shape3
BackStyle = 1 'Opaque
Height = 375
Left = 6840
Shape = 2 'Oval
Top = 360
Visible = 0 'False
Width = 975
End
Begin VB.Shape Shape2
BackStyle = 1 'Opaque
Height = 375
Left = 5640
Shape = 2 'Oval
Top = 360
Visible = 0 'False
Width = 975
End
Begin VB.Shape Shape1
BackStyle = 1 'Opaque
Height = 615
Left = 600
Shape = 4 'Rounded Rectangle
Top = 120
Visible = 0 'False
Width = 2655
End
Begin VB.Menu mnufile
Caption = "File"
Begin VB.Menu milpf
Caption = "Load Picture File"
End
Begin VB.Menu misep1
Caption = "-"
End
Begin VB.Menu miexit
Caption = "Exit"
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim loadfile As Boolean
Dim xycolor As Long
Dim l As Long
Dim b As String
Dim g As String
Dim r As String
Private Sub miexit_Click()
Unload Me
End Sub
Private Sub milpf_Click()
On Error GoTo errorhandler
cd1.ShowOpen
Picture1.Picture = LoadPicture(cd1.FileName)
loadfile = True
Shape1.Visible = True
Shape2.Visible = True
Shape3.Visible = True
Shape4.Visible = True
errorhandler:
Exit Sub
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If loadfile = True Then
xycolor = Picture1.Point(X, Y)
Text2.Text = X & "," & Y
Shape1.BackColor = xycolor
Text1.Text = xycolor & " " & Hex(xycolor)
If xycolor <> 0 Then
l = Len(Hex(xycolor))
If l >= 1 Then
Select Case l
Case 1:
r = Mid(Hex(xycolor), 1, 1)
Case 2:
r = Mid(Hex(xycolor), 1, 2)
Case 3:
r = Mid(Hex(xycolor), 2, 2)
Case 4:
r = Mid(Hex(xycolor), 3, 2)
Case 5:
r = Mid(Hex(xycolor), 4, 2)
Case 6:
r = Mid(Hex(xycolor), 5, 2)
Case 7:
r = Mid(Hex(xycolor), 6, 2)
End Select
Else
r = "00"
End If
If l > 2 Then
Select Case l
Case 3:
g = Mid(Hex(xycolor), 1, 1)
Case 4:
g = Mid(Hex(xycolor), 1, 2)
Case 5:
g = Mid(Hex(xycolor), 2, 2)
Case 6:
g = Mid(Hex(xycolor), 3, 2)
Case 7:
g = Mid(Hex(xycolor), 4, 2)
End Select
Else
g = "00"
End If
If l > 4 Then
Select Case l
Case 5:
b = Mid(Hex(xycolor), 1, 1)
Case 6:
b = Mid(Hex(xycolor), 1, 2)
Case 7:
b = Mid(Hex(xycolor), 1, 3)
End Select
Else
b = "00"
End If
'vs3.Value = CInt(b)
Shape4.BackColor = RGB(&H0, &H0, "&H" & b)
Shape3.BackColor = RGB(&H0, "&H" & g, &H0)
Shape2.BackColor = RGB("&H" & r, &H0, &H0)
Else
Shape4.BackColor = RGB(&H0, &H0, &H0)
Shape3.BackColor = RGB(&H0, &H0, &H0)
Shape2.BackColor = RGB(&H0, &H0, &H0)
End If
If (r = "FF") And (g = "00") And (b = "00") Then
Beep
Call MsgBox("Red color Found", vbInformation)
End If
If (r = "00") And (g = "FF") And (b = "00") Then
Beep
Call MsgBox("Green color Found", vbInformation)
End If
If (r = "00") And (g = "00") And (b = "FF") Then
Beep
Call MsgBox("Blue color Found", vbInformation)
End If
If (r = "FF") And (g = "FF") And (b = "00") Then
Beep
Call MsgBox("Yellow color Found", vbInformation)
End If
End If
End Sub
Comments
Sorry but there are no comments to display