Happy Codings - Programming Code Examples
Html Css Web Design Sample Codes CPlusPlus Programming Sample Codes JavaScript Programming Sample Codes C Programming Sample Codes CSharp Programming Sample Codes Java Programming Sample Codes Php Programming Sample Codes Visual Basic Programming Sample Codes


Visual Basic Programming Code Examples

Visual Basic > Graphics Games Programming Code Examples

Finding the content of RGB in an color

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223
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