Public Class frmKleurendetector
Public Structure POINT
Dim x As Int32
Dim y As Int32
End Structure
Public Declare Function M_GetCursorPos Lib "user32" Alias "GetCursorPos" (ByRef lpPoint As Point) As Int32
Public Declare Function GetPixel Lib "gdi32" (ByVal hdc As Int32, ByVal x As Int32, ByVal y As Int32) As Int32
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Int32) As Int32
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Int32, ByVal hWndInsertAfter As Int32, ByVal x As Int32, ByVal y As Int32, ByVal cx As Int32, ByVal cy As Int32, ByVal wFlags As Int32) As Int32
Public Sub GetCursorPos(ByRef mouse_x As Int32, ByRef mouse_Y As Int32)
Dim pt As POINT
Call M_GetCursorPos(pt)
mouse_x = pt.x
mouse_Y = pt.y
End Sub
Private Sub Form1_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles Me.KeyPress
If e.KeyChar = vbTab Then
Application.Exit()
End If
End Sub
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Timer1.Interval = 100
Timer1.Enabled = True
End Sub
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
Dim x1, y1 As Int32
GetCursorPos(x1, y1)
Dim icolor As Int32 = 0
icolor = GetPixel(GetDC(0), x1, y1)
Dim r, g, b As Byte
r = icolor And 255
g = (icolor \ 256) And 255
b = (icolor \ 65536) And 255
PictureBox1.BackColor = Color.FromArgb(r, g, b)
Dim hexcolor As String = "#" & Hex(PictureBox1.BackColor.ToArgb).ToString.Substring(2)
lblHex.Text = hexcolor
lblHex.BackColor = Color.FromArgb(r, g, b)
SetWindowPos(Handle.ToInt32, -1, x1 + 15, y1 - 5, 35, 35, &H1S)
Dim ri As Integer = r
Dim gi As Integer = g
Dim bi As Integer = b
If r = 255 And g = 255 And b = 255 Then
lblKleur.Text = "Wit"
ElseIf r = 0 And g = 0 And b = 0 Then
lblKleur.Text = "Zwart"
ElseIf r > g And r > b Then
lblKleur.Text = "Rood"
ElseIf g > r And g > b Then
lblKleur.Text = "Groen"
ElseIf b > r And b > g Then
lblKleur.Text = "Blauw"
ElseIf (ri + bi) > gi Then
lblKleur.Text = "Paars"
ElseIf (ri + gi) > bi Then
lblKleur.Text = "Geel"
Else
lblKleur.Text = "Onbekend"
End If
End Sub
Private Sub lblHex_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lblHex.Click
End Sub
End Class
?