VB and VBA Users Source Code: finding the content of RGB in an color
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
finding the content of RGB in an color
By:
manish
Email (spam proof):
Email the originator of this post
Date:
Friday, October 04, 2002
Hits:
1055
Category:
Windows Forms/GUI/Controls/Graphics
Article:
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
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
