|
| 1 | +#Region " Option Statements " |
| 2 | + |
| 3 | +Option Strict On |
| 4 | +Option Explicit On |
| 5 | +Option Infer Off |
| 6 | + |
| 7 | +#End Region |
| 8 | + |
| 9 | +#Region " Imports " |
| 10 | + |
| 11 | +Imports System.Collections.Generic |
| 12 | +Imports System.Diagnostics |
| 13 | +Imports System.Drawing.Imaging |
| 14 | +Imports System.Runtime.InteropServices |
| 15 | + |
| 16 | +Imports Win32 |
| 17 | + |
| 18 | +#End Region |
| 19 | + |
| 20 | +Public NotInheritable Class WindowHelper |
| 21 | + |
| 22 | +#Region " Public Methods " |
| 23 | + |
| 24 | + <DebuggerStepThrough> |
| 25 | + Friend Shared Function GetWindowFromPoint(ptScreen As Point) As IntPtr |
| 26 | + |
| 27 | + If Main.ignoreChildWindows Then |
| 28 | + Return WindowHelper.GetTopLevelFromPoint(ptScreen) |
| 29 | + Else |
| 30 | + ' Child mode: iterate through top-level windows in Z-order and search children recursively |
| 31 | + Dim topList As List(Of IntPtr) = WindowHelper.EnumTopLevelWindowsInZOrder() |
| 32 | + For Each top As IntPtr In topList |
| 33 | + Dim found As IntPtr = WindowHelper.GetWindowFromPointRecursive(top, ptScreen) |
| 34 | + If found <> IntPtr.Zero Then |
| 35 | + Return found |
| 36 | + End If |
| 37 | + Next |
| 38 | + Return IntPtr.Zero |
| 39 | + End If |
| 40 | + End Function |
| 41 | + |
| 42 | + <DebuggerStepThrough> |
| 43 | + Friend Shared Function GetPixelColorAtScreenPosition(screenX As Integer, screenY As Integer) As Color |
| 44 | + |
| 45 | + Dim hdc As IntPtr = NativeMethods.GetDC(IntPtr.Zero) |
| 46 | + |
| 47 | + Dim pixel As UInteger = NativeMethods.GetPixel(hdc, screenX, screenY) |
| 48 | + |
| 49 | + NativeMethods.ReleaseDC(IntPtr.Zero, hdc) |
| 50 | + |
| 51 | + Dim r As Integer = CInt(pixel And &HFF) |
| 52 | + Dim g As Integer = CInt((pixel >> 8) And &HFF) |
| 53 | + Dim b As Integer = CInt((pixel >> 16) And &HFF) |
| 54 | + |
| 55 | + Return Color.FromArgb(r, g, b) |
| 56 | + End Function |
| 57 | + |
| 58 | + <DebuggerStepThrough> |
| 59 | + Friend Shared Function GetWindowLongPtrSafe(hWnd As IntPtr, nIndex As Integer) As IntPtr |
| 60 | + |
| 61 | + Return If(IntPtr.Size = 8, |
| 62 | + NativeMethods.GetWindowLongPtr(hWnd, nIndex), |
| 63 | + New IntPtr(NativeMethods.GetWindowLong(hWnd, nIndex))) |
| 64 | + End Function |
| 65 | + |
| 66 | + <DebuggerStepThrough> |
| 67 | + Friend Shared Function SetWindowLongPtrSafe(hWnd As IntPtr, nIndex As Integer, dwNewLong As IntPtr) As IntPtr |
| 68 | + |
| 69 | + Return If(IntPtr.Size = 8, |
| 70 | + NativeMethods.SetWindowLongPtr(hWnd, nIndex, dwNewLong), |
| 71 | + New IntPtr(NativeMethods.SetWindowLong(hWnd, nIndex, dwNewLong.ToInt32()))) |
| 72 | + End Function |
| 73 | + |
| 74 | +#End Region |
| 75 | + |
| 76 | +#Region " Private Methods " |
| 77 | + |
| 78 | + Private Shared Function GetTopLevelFromPoint(ptScreen As Point) As IntPtr |
| 79 | + |
| 80 | + ' Iterate through top-level windows (EnumWindows returns in Z-order: top -> bottom) |
| 81 | + Dim tops As List(Of IntPtr) = WindowHelper.EnumTopLevelWindowsInZOrder() |
| 82 | + |
| 83 | + For Each hWnd As IntPtr In tops |
| 84 | + Try |
| 85 | + If Not NativeMethods.IsWindowVisible(hWnd) OrElse WindowHelper.IsWindowCloaked(hWnd) Then |
| 86 | + Continue For |
| 87 | + End If |
| 88 | + |
| 89 | + Dim rect As NativeRectangle |
| 90 | + If Not NativeMethods.GetWindowRect(hWnd, rect) Then |
| 91 | + Continue For |
| 92 | + End If |
| 93 | + If Not WindowHelper.PointInRect(rect, ptScreen) Then |
| 94 | + Continue For |
| 95 | + End If |
| 96 | + |
| 97 | + Dim exStylePtr As IntPtr = WindowHelper.GetWindowLongPtrSafe(hWnd, Constants.GWL_EXSTYLE) |
| 98 | + Dim exStyle As Long = exStylePtr.ToInt64() |
| 99 | + Dim isLayered As Boolean = (exStyle And Constants.WS_EX_LAYERED) <> 0 |
| 100 | + Dim isExTransparent As Boolean = (exStyle And Constants.WS_EX_TRANSPARENT) <> 0 |
| 101 | + |
| 102 | + ' If we ignore layered windows and the window is layered -> skip |
| 103 | + If Main.ignoreLayeredWindows AndAlso isLayered Then |
| 104 | + Continue For |
| 105 | + End If |
| 106 | + |
| 107 | + ' If we ignore "transparent" windows by style -> skip |
| 108 | + If Main.ignoreTransparentWindows AndAlso isExTransparent Then |
| 109 | + Continue For |
| 110 | + End If |
| 111 | + |
| 112 | + ' Pixel hit test: |
| 113 | + ' only perform when it makes sense (is layered, |
| 114 | + ' or we asked to ignore transparent, |
| 115 | + ' or when we want to apply the test for safety) |
| 116 | + Dim needPixelTest As Boolean = isLayered OrElse Main.ignoreTransparentWindows |
| 117 | + |
| 118 | + If needPixelTest Then |
| 119 | + Dim visibleAtPixel As Boolean |
| 120 | + Try |
| 121 | + visibleAtPixel = WindowHelper.PixelHitTest(hWnd, ptScreen) |
| 122 | + Catch |
| 123 | + ' if PixelHitTest fails, consider it visible to avoid blocking interaction. |
| 124 | + visibleAtPixel = True |
| 125 | + End Try |
| 126 | + |
| 127 | + If Not visibleAtPixel Then |
| 128 | + ' If we asked to ignore transparents -> skip; otherwise, original layered logic failing pixel -> skip |
| 129 | + Continue For |
| 130 | + End If |
| 131 | + End If |
| 132 | + |
| 133 | + ' If we reached here, this is the top-level window we want. |
| 134 | + Return hWnd |
| 135 | + |
| 136 | + Catch ex As Exception |
| 137 | + ' Protect against errors in system windows / unusual processes. |
| 138 | + Continue For |
| 139 | + End Try |
| 140 | + Next |
| 141 | + |
| 142 | + Return IntPtr.Zero |
| 143 | + End Function |
| 144 | + |
| 145 | + Private Shared Function GetWindowFromPointRecursive(hWnd As IntPtr, ptScreen As Point) As IntPtr |
| 146 | + |
| 147 | + ' Adaptation to respect ignoreLayeredWindows and ignoreTransparentWindows. |
| 148 | + If Not NativeMethods.IsWindowVisible(hWnd) OrElse WindowHelper.IsWindowCloaked(hWnd) Then |
| 149 | + Return IntPtr.Zero |
| 150 | + End If |
| 151 | + |
| 152 | + Dim rect As NativeRectangle |
| 153 | + If Not NativeMethods.GetWindowRect(hWnd, rect) OrElse Not PointInRect(rect, ptScreen) Then |
| 154 | + Return IntPtr.Zero |
| 155 | + End If |
| 156 | + |
| 157 | + Dim exStylePtr As IntPtr = WindowHelper.GetWindowLongPtrSafe(hWnd, Constants.GWL_EXSTYLE) |
| 158 | + Dim exStyle As Long = exStylePtr.ToInt64() |
| 159 | + Dim isLayered As Boolean = (exStyle And Constants.WS_EX_LAYERED) <> 0 |
| 160 | + Dim isExTransparent As Boolean = (exStyle And Constants.WS_EX_TRANSPARENT) <> 0 |
| 161 | + |
| 162 | + ' Respect ignoreLayeredWindows. |
| 163 | + If Main.ignoreLayeredWindows AndAlso isLayered Then |
| 164 | + Return IntPtr.Zero |
| 165 | + End If |
| 166 | + |
| 167 | + ' Respect ignoreTransparentWindows by style. |
| 168 | + If Main.ignoreTransparentWindows AndAlso isExTransparent Then |
| 169 | + Return IntPtr.Zero |
| 170 | + End If |
| 171 | + |
| 172 | + ' Pixel test if needed. |
| 173 | + Dim needPixelTest As Boolean = isLayered OrElse Main.ignoreTransparentWindows |
| 174 | + If needPixelTest Then |
| 175 | + Dim visibleAtPixel As Boolean |
| 176 | + Try |
| 177 | + visibleAtPixel = WindowHelper.PixelHitTest(hWnd, ptScreen) |
| 178 | + Catch |
| 179 | + visibleAtPixel = True |
| 180 | + End Try |
| 181 | + |
| 182 | + If Not visibleAtPixel Then |
| 183 | + Return IntPtr.Zero |
| 184 | + End If |
| 185 | + End If |
| 186 | + |
| 187 | + ' If we do not ignore children, dive deeper to find the deepest child. |
| 188 | + If Not Main.ignoreChildWindows Then |
| 189 | + Dim child As IntPtr = NativeMethods.GetWindow(hWnd, Constants.GW_CHILD) |
| 190 | + While child <> IntPtr.Zero |
| 191 | + Dim found As IntPtr = WindowHelper.GetWindowFromPointRecursive(child, ptScreen) |
| 192 | + If found <> IntPtr.Zero Then Return found |
| 193 | + child = NativeMethods.GetWindow(child, Constants.GW_HWNDNEXT) |
| 194 | + End While |
| 195 | + End If |
| 196 | + |
| 197 | + ' If no children are found, return this window (top-level or child depending on context). |
| 198 | + Return hWnd |
| 199 | + End Function |
| 200 | + |
| 201 | + Private Shared Function PixelHitTest(hWnd As IntPtr, ptScreen As Point) As Boolean |
| 202 | + |
| 203 | + Dim rect As NativeRectangle |
| 204 | + If Not NativeMethods.GetWindowRect(hWnd, rect) Then |
| 205 | + Return True |
| 206 | + End If |
| 207 | + |
| 208 | + Dim width As Integer = rect.Right - rect.Left |
| 209 | + Dim height As Integer = rect.Bottom - rect.Top |
| 210 | + If width <= 0 OrElse height <= 0 Then |
| 211 | + Return False |
| 212 | + End If |
| 213 | + |
| 214 | + Dim clientPt As New Point(ptScreen.X - rect.Left, ptScreen.Y - rect.Top) |
| 215 | + If clientPt.X < 0 OrElse clientPt.X >= width OrElse clientPt.Y < 0 OrElse clientPt.Y >= height Then |
| 216 | + Return False |
| 217 | + End If |
| 218 | + |
| 219 | + Dim exStylePtr As IntPtr = WindowHelper.GetWindowLongPtrSafe(hWnd, Constants.GWL_EXSTYLE) |
| 220 | + Dim exStyle As Long = exStylePtr.ToInt64() |
| 221 | + Dim isLayered As Boolean = (exStyle And Constants.WS_EX_LAYERED) <> 0 |
| 222 | + |
| 223 | + Dim hdcSrc As IntPtr = IntPtr.Zero |
| 224 | + Dim bmp As Bitmap = Nothing |
| 225 | + Try |
| 226 | + hdcSrc = NativeMethods.GetDC(hWnd) |
| 227 | + If hdcSrc = IntPtr.Zero Then |
| 228 | + ' Fallback: if we can't obtain the DC, return True to avoid blocking interaction |
| 229 | + Return True |
| 230 | + End If |
| 231 | + |
| 232 | + bmp = New Bitmap(1, 1, PixelFormat.Format32bppArgb) |
| 233 | + Using gDest As Graphics = Graphics.FromImage(bmp) |
| 234 | + Dim hdcDest As IntPtr = gDest.GetHdc() |
| 235 | + Try |
| 236 | + Dim ptClient As Point = clientPt |
| 237 | + Dim ok As Boolean = NativeMethods.BitBlt(hdcDest, 0, 0, 1, 1, hdcSrc, ptClient.X, ptClient.Y, Constants.SRCCOPY) |
| 238 | + If Not ok Then |
| 239 | + gDest.ReleaseHdc(hdcDest) |
| 240 | + Return WindowHelper.PixelHitTest_ScreenSample(ptScreen) |
| 241 | + End If |
| 242 | + Finally |
| 243 | + gDest.ReleaseHdc(hdcDest) |
| 244 | + End Try |
| 245 | + End Using |
| 246 | + |
| 247 | + Dim px As Color = bmp.GetPixel(0, 0) |
| 248 | + ' Threshold: we consider it visible if the alpha is high enough or the color is not pure black. |
| 249 | + Return px.A > 8 OrElse Not (px.R = 0 AndAlso px.G = 0 AndAlso px.B = 0) |
| 250 | + Catch |
| 251 | + Return True |
| 252 | + |
| 253 | + Finally |
| 254 | + bmp?.Dispose() |
| 255 | + If hdcSrc <> IntPtr.Zero Then |
| 256 | + NativeMethods.ReleaseDC(hWnd, hdcSrc) |
| 257 | + End If |
| 258 | + |
| 259 | + End Try |
| 260 | + End Function |
| 261 | + |
| 262 | + Private Shared Function PixelHitTest_ScreenSample(ptScreen As Point) As Boolean |
| 263 | + |
| 264 | + Try |
| 265 | + Using bmp As New Bitmap(1, 1, PixelFormat.Format32bppArgb) |
| 266 | + Using g As Graphics = Graphics.FromImage(bmp) |
| 267 | + g.CopyFromScreen(ptScreen, Point.Empty, New Size(1, 1)) |
| 268 | + End Using |
| 269 | + Dim c As Color = bmp.GetPixel(0, 0) |
| 270 | + Return Not (c.A = 0 Or (c.R = 0 And c.G = 0 And c.B = 0)) |
| 271 | + End Using |
| 272 | + Catch |
| 273 | + Return True |
| 274 | + End Try |
| 275 | + End Function |
| 276 | + |
| 277 | + Private Shared Function IsWindowCloaked(hWnd As IntPtr) As Boolean |
| 278 | + |
| 279 | + Dim val As Integer = 0 |
| 280 | + Dim hr As Integer = NativeMethods.DwmGetWindowAttribute(hWnd, Constants.DWMWA_CLOAKED, val, Marshal.SizeOf(GetType(Integer))) |
| 281 | + Return hr = 0 AndAlso val <> 0 |
| 282 | + End Function |
| 283 | + |
| 284 | + Private Shared Function EnumTopLevelWindowsInZOrder() As List(Of IntPtr) |
| 285 | + |
| 286 | + Dim list As New List(Of IntPtr)() |
| 287 | + Dim cb As EnumWindowsProc = |
| 288 | + Function(hWnd, lParam) |
| 289 | + list.Add(hWnd) |
| 290 | + Return True ' continue |
| 291 | + End Function |
| 292 | + |
| 293 | + NativeMethods.EnumWindows(cb, IntPtr.Zero) |
| 294 | + Return list |
| 295 | + End Function |
| 296 | + |
| 297 | + Private Shared Function PointInRect(r As NativeRectangle, p As Point) As Boolean |
| 298 | + Return (p.X >= r.Left AndAlso p.X < r.Right AndAlso p.Y >= r.Top AndAlso p.Y < r.Bottom) |
| 299 | + End Function |
| 300 | + |
| 301 | +#End Region |
| 302 | + |
| 303 | +End Class |
0 commit comments