Imports System.Drawing Imports System.Runtime.InteropServices Imports System.Text Imports System.Windows.Forms Imports DigitalData.Modules.Logging Public Class Window Private _Logger As Logger Public Enum Anchor TopLeft BottomLeft TopRight BottomRight End Enum Public Class RectangleInfo Public Top As Integer = 0 Public Left As Integer = 0 Public Right As Integer = 0 Public Bottom As Integer = 0 Public Overrides Function ToString() As String Return String.Format("Top:{0},Left:{1},Bottom:{2},Right:{3}", Top, Left, Bottom, Right) End Function End Class Public Class WindowInfo Public WindowTitle As String = "" Public ProcessName As String = "" Public ClassName As String = "" Public ProcessId As Integer = 0 Public ControlName As String = "" Public hWnd As IntPtr End Class Public Sub New(LogConfig As LogConfig) _Logger = LogConfig.GetLogger() End Sub ''' ''' Returns Information about the currently focused window ''' Public Function GetWindowInfo() As WindowInfo Dim hWnd As IntPtr = NativeMethods.GetForegroundWindow() If hWnd = IntPtr.Zero Then Return Nothing End If Return GetWindowInfo(hWnd) End Function ''' ''' Returns Information about the Window with `hWnd` ''' Public Function GetWindowInfo(ByVal hWnd As IntPtr) As WindowInfo Dim oPID As Integer = 0 Dim oTitleLength As Int32 = NativeMethods.GetWindowTextLength(hWnd) Dim oWindowTitle As String = StrDup(oTitleLength + 1, "*") Dim oClassBuilder As New StringBuilder(64) NativeMethods.GetWindowText(hWnd, oWindowTitle, oTitleLength + 1) NativeMethods.GetWindowThreadProcessId(hWnd, oPID) If oPID = 0 Then Return Nothing End If Dim oProcess As Process = Process.GetProcessById(oPID) If oProcess Is Nothing Then Return Nothing End If NativeMethods.GetClassName(hWnd, oClassBuilder, 64) Return New WindowInfo With { .hWnd = hWnd, .ClassName = oClassBuilder.ToString, .ProcessId = oProcess.Id, .ProcessName = oProcess.ProcessName, .WindowTitle = oWindowTitle.Replace(vbNullChar, String.Empty) } End Function ''' ''' Returns the currently focused control ''' ''' Current window handle; can be obtained from Me.Handle Public Function GetFocusedControl(WindowHandle As IntPtr) As WindowInfo Try Dim oWindow = GetWindowInfo() If oWindow Is Nothing Then Return Nothing End If Dim oThreadId As IntPtr = NativeMethods.GetWindowThreadProcessId(oWindow.hWnd, 0) Dim oMyThreadId As IntPtr = NativeMethods.GetWindowThreadProcessId(WindowHandle, 0) If NativeMethods.AttachThreadInput(oThreadId, oMyThreadId, True) Then Try Dim oControlhWnd = NativeMethods.GetFocus() Dim oControl As WindowInfo = GetWindowInfo(oControlhWnd) If oControl Is Nothing Then Return Nothing End If Dim oName = Utils.GetWinFormsId(oControlhWnd) oControl.ControlName = oName Return oControl Catch ex As Exception _Logger.Error(ex) Finally NativeMethods.AttachThreadInput(oThreadId, oMyThreadId, False) End Try End If Return Nothing Catch ex As Exception _Logger.Error(ex) Return Nothing End Try End Function ''' ''' Returns Bounds of `ControlHandle`. Relative to `WindowHandle` and `Anchor` value. ''' Public Function GetControlLocation(ControlHandle As IntPtr, WindowHandle As IntPtr, Optional Anchor As Anchor = Anchor.TopLeft) As RectangleInfo Dim oWindowRect As New NativeMethods.RectangleAPI Dim oControlRect As New NativeMethods.RectangleAPI Dim oResult As New RectangleInfo Try If NativeMethods.GetWindowRect(New HandleRef(Me, WindowHandle), oWindowRect) = False Then Return Nothing End If If NativeMethods.GetWindowRect(New HandleRef(Me, ControlHandle), oControlRect) = False Then Return Nothing End If Dim oRect As New NativeMethods.RectangleAPI ' Calculate Coordinates relative to parent window oRect = GetRelativeRectangle(oControlRect, oWindowRect, Anchor) oResult.Left = oRect.Left oResult.Right = oRect.Right oResult.Top = oRect.Top oResult.Bottom = oRect.Bottom Return oResult Catch ex As Exception _Logger.Error(ex) Return Nothing End Try End Function ''' ''' Returns Bounds of the focused control. Relative to current form and `Anchor` value. ''' Public Function GetFocusedControlLocation(WindowHandle As IntPtr, Anchor As Anchor) As RectangleInfo Dim oWindowRect As New NativeMethods.RectangleAPI Dim oControlRect As New NativeMethods.RectangleAPI Dim oForegroundWindow As WindowInfo Dim oFocusedControl As WindowInfo Dim oResult As New RectangleInfo Try oForegroundWindow = GetWindowInfo() oFocusedControl = GetFocusedControl(WindowHandle) Return GetControlLocation(oFocusedControl.hWnd, oForegroundWindow.hWnd, Anchor) Catch ex As Exception _Logger.Error(ex) Return Nothing End Try End Function Public Function GetFocusedControlLocation(WindowHandle As IntPtr) As Dictionary(Of String, RectangleInfo) Dim oWindowRect As New NativeMethods.RectangleAPI Dim oControlRect As New NativeMethods.RectangleAPI Dim oForegroundWindow As WindowInfo Dim oFocusedControl As WindowInfo Dim oResult As New RectangleInfo Try oForegroundWindow = GetWindowInfo() oFocusedControl = GetFocusedControl(WindowHandle) Dim oDict As New Dictionary(Of String, RectangleInfo) For Each oAnchor As Anchor In [Enum].GetValues(GetType(Anchor)) oDict.Add(oAnchor.ToString.ToUpper, GetControlLocation(oFocusedControl.hWnd, oForegroundWindow.hWnd, oAnchor)) Next Return oDict Catch ex As Exception _Logger.Error(ex) Return Nothing End Try End Function ''' ''' Returns Bounds of the control under the cursor. Relative to current form and `Anchor` value. ''' Public Function GetHoveredControlLocation(Optional Anchor As Anchor = Anchor.TopLeft) As RectangleInfo Dim oPoint As New NativeMethods.PointAPI Dim oWindowRect As New NativeMethods.RectangleAPI Dim oControlRect As New NativeMethods.RectangleAPI Dim oForegroundWindow As IntPtr Dim oControlUnderCursor As IntPtr Dim oResult As New RectangleInfo Try If NativeMethods.GetCursorPos(oPoint) = False Then Return Nothing End If oForegroundWindow = NativeMethods.GetForegroundWindow() oControlUnderCursor = NativeMethods.WindowFromPoint(oPoint) Return GetControlLocation(oControlUnderCursor, oForegroundWindow, Anchor) Catch ex As Exception _Logger.Error(ex) Return Nothing End Try End Function Public Function GetWindowRect(Handle As IntPtr) Dim oWindowRect As New NativeMethods.RectangleAPI If NativeMethods.GetWindowRect(New HandleRef(Me, Handle), oWindowRect) = False Then Return Nothing End If Return oWindowRect End Function Private Function GetRelativeRectangle(ControlRect As NativeMethods.RectangleAPI, WindowRect As NativeMethods.RectangleAPI, Anchor As Anchor) As NativeMethods.RectangleAPI Dim oScreenRect As Rectangle = Screen.PrimaryScreen.Bounds Dim oLeft, oBottom, oTop, oRight As Integer Select Case Anchor Case Anchor.TopLeft oLeft = ControlRect.Left - WindowRect.Left oTop = ControlRect.Top - WindowRect.Top Case Anchor.BottomLeft oLeft = ControlRect.Left - WindowRect.Left oBottom = ControlRect.Bottom - WindowRect.Bottom Case Anchor.TopRight oRight = ControlRect.Right - WindowRect.Right oTop = ControlRect.Top - WindowRect.Top Case Anchor.BottomRight oRight = ControlRect.Right - WindowRect.Right oBottom = ControlRect.Bottom - WindowRect.Bottom End Select Return New NativeMethods.RectangleAPI() With { .Top = oTop, .Bottom = oBottom, .Left = oLeft, .Right = oRight } End Function Private Function GetRect(Rect As NativeMethods.RectangleAPI, ParentRect As NativeMethods.RectangleAPI) As Rectangle Dim oX, oY, oWidth, oHeight As Integer oWidth = Rect.Right - Rect.Left oHeight = Rect.Bottom - Rect.Top oX = Rect.Left - ParentRect.Left oY = Rect.Top - ParentRect.Top Return New Rectangle(oX, oY, oWidth, oHeight) End Function Private Function GetRect(Rect As NativeMethods.RectangleAPI, ParentRect As Rectangle) As Rectangle Dim oX, oY, oWidth, oHeight As Integer oWidth = Rect.Right - Rect.Left oHeight = Rect.Bottom - Rect.Top oX = Rect.Left - ParentRect.X oY = Rect.Top - ParentRect.Y Return New Rectangle(oX, oY, oWidth, oHeight) End Function End Class