Welcome to HBH! If you had an account on hellboundhacker.org you will need to reset your password using the Lost Password system before you will be able to login.

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