Visual Basic > Graphics Games Programming
Finding the content of RGB in an color
Finding the content of RGB in an color 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
Visual Basic Codes
ActiveX
Miscellaneous
Applications
Code Snippets
Common Dialogs
Special Effects
Database Stuff
Date Time
Files Drives
Forms
Graphics Games
Internet Stuff
Multimedia
Other
Strings
Windows