
Public Class WinApi
#Region "API Declarations"
'Public Declare Function GetWindowRect Lib "user32.dll" (ByVal hWnd As IntPtr, ByRef lpRect As Rect) As Boolean
Public Declare Function GetClientRect Lib "user32.dll" (ByVal hWnd As IntPtr, ByRef lpRect As Rect) As Boolean
Public Declare Function GetDesktopWindow Lib "user32" () As IntPtr
Public Declare Function GetPixel Lib "gdi32" (ByVal hDC As IntPtr, ByVal x As Integer, ByVal y As Integer) As Integer
Public Declare Function GetWindowDC Lib "user32" (ByVal hWnd As IntPtr) As IntPtr
Public Declare Function ReleaseDC Lib "user32" (ByVal hWnd As IntPtr, ByVal hDC As IntPtr) As Integer
Public Declare Function ClientToScreen Lib "user32.dll" (ByVal hWnd As IntPtr, ByRef lpPoint As Point) As Boolean
'Public Declare Function GetForegroundWindow Lib "user32.dll" () As IntPtr
#End Region
#Region "Structs"
Public Structure Rect
''NOT compatible with System.Drawing.Rectangle. Items are declared differently | different order.
Dim Left As Int32
Dim Top As Int32
Dim Right As Int32
Dim Bottom As Int32
Public ReadOnly Property Width As Int32
Get
Return Right - Left
End Get
End Property
Public ReadOnly Property Height As Int32
Get
Return Bottom - Top
End Get
End Property
End Structure
#End Region
End Class
Public Class ScreenManager
''' <summary>
''' Gets the color of a single pixel and returns as a Color.
''' </summary>
Public Shared Function GetPixel(ByVal x As Int32, ByVal y As Int32) As Color
Dim hWnd As IntPtr = WinApi.GetDesktopWindow()
Dim hDC As IntPtr = WinApi.GetWindowDC(hWnd)
Dim lColor As Int32 = WinApi.GetPixel(hDC, x, y)
WinApi.ReleaseDC(hWnd, hDC)
Return ColorTranslator.FromWin32(lColor) '<--nice converter function : Color struct is BIG :/ 20 something bytes.
End Function
''' <summary>
''' Takes a screenshot of the screen and returns as a Bitmap.
''' </summary>
''' <param name="tl">Top-Left point of the region to copy</param>
''' <param name="width">Width of the region to copy</param>
''' <param name="height">Height of the region to copy</param>
Public Shared Function GetScreenArea(ByVal tl As Point, ByVal width As Int32, ByVal height As Int32) As Bitmap
Dim _rtnBmp As New Bitmap(width, height, System.Drawing.Imaging.PixelFormat.Format24bppRgb)
Dim _gr As Graphics = Graphics.FromImage(_rtnBmp)
_gr.CopyFromScreen(tl, New Point(0, 0), New System.Drawing.Size(width, height), CopyPixelOperation.SourceCopy)
_gr.Dispose()
Return _rtnBmp
End Function
''' <summary>
''' Returns a WinApi.Rect (left,top,right,bottom) for the given window's client area. Does Not include Form Borders.
''' </summary>
''' <param name="hWnd">Handle to the window</param>
Public Shared Function GetWindowClientRect(ByVal hWnd As IntPtr) As WinApi.Rect
Dim _rtnRect As New WinApi.Rect
Dim _tl As New Point(0, 0)
WinApi.GetClientRect(hWnd, _rtnRect) '' only fills Right and Bottom --> is Width and Height.
WinApi.ClientToScreen(hWnd, _tl)
_rtnRect.Top = _tl.Y
_rtnRect.Left = _tl.X
_rtnRect.Right += _rtnRect.Left
_rtnRect.Bottom += _rtnRect.Top
Return _rtnRect
End Function
''' <summary>
''' Scans through a bitmap for 1 specific color
''' </summary>
''' <param name="aBitmap">The bitmap to be searched.</param>
''' <param name="searchColor">The color to search for.</param>
Public Shared Function FindColorLocations(ByRef aBitmap As Bitmap, ByVal searchColor As Color) As Point()
Dim _rtnPts As New List(Of Point)
Dim _tmpColor As New Color
For xx As Int32 = 0 To aBitmap.Width - 1
For yy As Int32 = 0 To aBitmap.Height - 1
_tmpColor = aBitmap.GetPixel(xx, yy)
If _tmpColor.R = searchColor.R And _tmpColor.G = searchColor.G And _tmpColor.B = searchColor.B Then
_rtnPts.Add(New Point(xx, yy)) ''image's pixel-color matched searchColor. Add x,y to the list.
End If
Next
Next
If _rtnPts.Count = 0 Then
_rtnPts.Add(New Point(-1, -1)) '' FAILURE. No points found.
End If
Return _rtnPts.ToArray()
End Function
End Class
Public Class Form1
Private _ss As Bitmap '' Screenshot image
Private _searchColor As Color = Color.FromArgb(255, 0, 0) '' Search Color. Defaulted to pure red.
Private Sub cmdTakeSS_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdTakeSS.Click
_ss = ScreenManager.GetScreenArea(New Point(0, 0), Screen.PrimaryScreen.WorkingArea.Width, Screen.PrimaryScreen.WorkingArea.Height)
pbxSS.Image = _ss
pbxSS.Refresh()
End Sub
Private Sub cmdSetSearchColor_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdSetSearchColor.Click
_searchColor = ScreenManager.GetPixel(Cursor.Position.X, Cursor.Position.Y)
Panel1.BackColor = _searchColor
Panel1.Refresh()
End Sub
Private Sub cmdFindColor_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdFindColor.Click
Dim _foundPoints() As Point = ScreenManager.FindColorLocations(_ss, _searchColor)
If _foundPoints(0).X = -1 Then
''fail. todo: add proper documentation. FindColorLocations() returns a single point of (-1,-1) on failure.
MessageBox.Show("No points found of that color.")
Else
Dim _outStr As New System.Text.StringBuilder
For Each pp As Point In _foundPoints
_outStr.Append(pp.ToString & " ") '' displays as {X,Y}
Next
MessageBox.Show(_foundPoints.Length & " points found. " & Environment.NewLine _
& _outStr.ToString)
End If
End Sub
End Class






Private Sub cmdFindColor_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdFindColor.Click
Dim _foundPoints() As Point = ScreenManager.FindColorLocations(_ss, _searchColor)
If _foundPoints(0).X = -1 Then
''fail. todo: add proper documentation. FindColorLocations() returns a single point of (-1,-1) on failure.
MessageBox.Show("No points found of that color.")
Else
Dim _outStr As New System.Text.StringBuilder
For Each pp As Point In _foundPoints
_outStr.Append(pp.ToString & " ") '' displays as {X,Y}
Next
MessageBox.Show(_foundPoints.Length & " points found. " & Environment.NewLine _
& _outStr.ToString)
End If
End Sub
Private Sub cmdFindColor_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdFindColor.Click
Dim _foundPoints() As Point = ScreenManager.FindColorLocations(_ss, _searchColor)
If _foundPoints(0).X = -1 Then
''fail. todo: add proper documentation. FindColorLocations() returns a single point of (-1,-1) on failure.
MessageBox.Show("No points found of that color.")
Else
For Each pp As Point In _foundPoints
Cursor.Position = pp
Threading.Thread.Sleep(1500) '' so you can actually see it for a moment.
Next
End If
End Sub
