Imports System.ComponentModel 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 Private Const WINDOW_SNAP_OFFSET = 35 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 = IntPtr.Zero 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 Try Dim hWnd As IntPtr = NativeMethods.GetForegroundWindow() Return GetWindowInfo(hWnd) Catch ex As Exception _Logger.Debug("Error in GetWindowInfo/0") _Logger.Error(ex) Throw ex End Try End Function ''' ''' Returns Information about the Window with `hWnd` ''' Public Function GetWindowInfo(ByVal hWnd As IntPtr) As WindowInfo Try 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) } Catch ex As Exception _Logger.Debug("Error in GetWindowInfo/1") _Logger.Error(ex) Throw ex End Try 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 _Logger.Debug("Could not get Window Info!") 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 _Logger.Debug("Could not get Control Info!") 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.Debug("Error in GetFocusedControl/1") _Logger.Error(ex) Throw ex 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 _Logger.Debug("Getting Control Location") Try _Logger.Debug("Trying to get Window Rectangle") If NativeMethods.GetWindowRect(New HandleRef(Me, WindowHandle), oWindowRect) = False Then Return Nothing End If _Logger.Debug("Trying to get Control Rectangle") 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) _Logger.Debug("Control Location for Anchor {0}: {1}", Anchor, oRect) oResult.Left = oRect.Left oResult.Right = oRect.Right oResult.Top = oRect.Top oResult.Bottom = oRect.Bottom Return oResult Catch ex As Exception _Logger.Debug("Error in GetControlLocation/3") _Logger.Error(ex) Throw ex End Try End Function Public Function GetControlLocations(ControlHandle As IntPtr, WindowHandle As IntPtr) As Dictionary(Of String, RectangleInfo) Dim oWindowRect As New NativeMethods.RectangleAPI Dim oControlRect As New NativeMethods.RectangleAPI Dim oResults As New Dictionary(Of String, RectangleInfo) _Logger.Debug("Getting Control Locations") Try _Logger.Debug("Trying to get Window Rectangle") If NativeMethods.GetWindowRect(New HandleRef(Me, WindowHandle), oWindowRect) = False Then Return Nothing End If _Logger.Debug("Trying to get Control Rectangle") If NativeMethods.GetWindowRect(New HandleRef(Me, ControlHandle), oControlRect) = False Then Return Nothing End If For Each oAnchor As Anchor In [Enum].GetValues(GetType(Anchor)) Dim oRect As NativeMethods.RectangleAPI = GetRelativeRectangle(oControlRect, oWindowRect, oAnchor) _Logger.Debug("Control Location for Anchor {0}: {1}", oAnchor, oRect) oResults.Add(oAnchor.ToString, New RectangleInfo() With { .Left = oRect.Left, .Right = oRect.Right, .Top = oRect.Top, .Bottom = oRect.Bottom }) Next Return oResults Catch ex As Exception _Logger.Debug("Error in GetControlLocations/2") _Logger.Error(ex) Throw ex 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 oForegroundWindow As WindowInfo Dim oFocusedControl As WindowInfo Try oForegroundWindow = GetWindowInfo() oFocusedControl = GetFocusedControl(WindowHandle) If IsNothing(oForegroundWindow) Then _Logger.Debug("Foreground Window is nothing!") End If If IsNothing(oFocusedControl) Then _Logger.Debug("Focused Contol is nothing!") End If _Logger.Debug("Control Handle: {0}", oFocusedControl.hWnd) _Logger.Debug("Window Handle: {0}", oForegroundWindow.hWnd) Return GetControlLocation(oFocusedControl.hWnd, oForegroundWindow.hWnd, Anchor) Catch ex As Exception _Logger.Debug("Error in GetFocusedControlLocation/2") _Logger.Error(ex) Throw ex End Try End Function Public Function GetFocusedControlLocation(WindowHandle As IntPtr) As Dictionary(Of String, RectangleInfo) Dim oForegroundWindow As WindowInfo Dim oFocusedControl As WindowInfo Try oForegroundWindow = GetWindowInfo() oFocusedControl = GetFocusedControl(WindowHandle) If oForegroundWindow Is Nothing Then _Logger.Warn("Foreground Window is Nothing!") End If If oFocusedControl Is Nothing Then _Logger.Warn("Focused Control is Nothing!") End If Dim oDict As Dictionary(Of String, RectangleInfo) = GetControlLocations(oFocusedControl.hWnd, oForegroundWindow.hWnd) Return oDict Catch ex As Exception _Logger.Debug("Error in GetFocusedControlLocation/1") _Logger.Error(ex) Throw ex 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.Debug("Error in GetHoveredControlLocation/1") _Logger.Error(ex) Throw ex End Try End Function Public Function GetWindowRect(Handle As IntPtr) Try Dim oWindowRect As New NativeMethods.RectangleAPI If NativeMethods.GetWindowRect(New HandleRef(Me, Handle), oWindowRect) = False Then Return Nothing End If Return oWindowRect Catch ex As Exception _Logger.Debug("Error in GetWindowRect/1") _Logger.Error(ex) Throw ex End Try End Function Private Function GetRelativeRectangle(ControlRect As NativeMethods.RectangleAPI, WindowRect As NativeMethods.RectangleAPI, Anchor As Anchor) As NativeMethods.RectangleAPI Try Dim oScreenRect As Rectangle = System.Windows.Forms.Screen.PrimaryScreen.Bounds Dim oLeft, oBottom, oTop, oRight As Integer _Logger.Debug("Calculating Rectangle for Anchor {0}", Anchor.ToString) 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 _Logger.Debug("Done Calculating Rectangle for Anchor {0}", Anchor.ToString) Return New NativeMethods.RectangleAPI() With { .Top = oTop, .Bottom = oBottom, .Left = oLeft, .Right = oRight } Catch ex As Exception _Logger.Debug("Error in GetRelativeRectangle/3") _Logger.Error(ex) Throw ex End Try End Function Private Function GetRect(Rect As NativeMethods.RectangleAPI, ParentRect As NativeMethods.RectangleAPI) As Rectangle Try 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) Catch ex As Exception _Logger.Debug("Error in GetRect/2") _Logger.Error(ex) Throw ex End Try End Function Private Function GetRect(Rect As NativeMethods.RectangleAPI, ParentRect As Rectangle) As Rectangle Try 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) Catch ex As Exception _Logger.Debug("Error in GetRect/2") _Logger.Error(ex) Throw ex End Try End Function Public Structure WINDOWPOS Public hwnd As IntPtr Public hwndInsertAfter As IntPtr Public x As Integer Public y As Integer Public cx As Integer Public cy As Integer Public flags As Integer End Structure Public Shared Sub SnapToDesktopBorder(pForm As Form, pLParam As IntPtr, Optional pWidthAdjustment As Integer = 0) If pForm Is Nothing Then ' Satisfies rule: Validate parameters Throw New ArgumentNullException("pForm") End If ' Snap client to the top, left, bottom or right desktop border ' as the form is moved near that border Try ' Marshal the LPARAM value which is a WINDOWPOS struct Dim oNewPosition As New WINDOWPOS oNewPosition = CType(Marshal.PtrToStructure(pLParam, GetType(WINDOWPOS)), WINDOWPOS) If oNewPosition.y = 0 OrElse oNewPosition.x = 0 Then Return ' Nothing to do! End If ' Adjust the client size for borders and caption bar Dim oClientRect As Rectangle = pForm.RectangleToScreen(pForm.ClientRectangle) oClientRect.Width += SystemInformation.FrameBorderSize.Width - pWidthAdjustment oClientRect.Height += (SystemInformation.FrameBorderSize.Height + SystemInformation.CaptionHeight) ' Now get the screen working area (without taskbar) Dim oWorkingRect As Rectangle = System.Windows.Forms.Screen.GetWorkingArea(pForm.ClientRectangle) ' Left border If oNewPosition.x >= oWorkingRect.X - WINDOW_SNAP_OFFSET AndAlso oNewPosition.x <= oWorkingRect.X + WINDOW_SNAP_OFFSET Then oNewPosition.x = oWorkingRect.X End If ' Get screen bounds and taskbar height ' (when taskbar is horizontal) Dim oScreenRect As Rectangle = System.Windows.Forms.Screen.GetBounds(System.Windows.Forms.Screen.PrimaryScreen.Bounds) Dim oTaskbarHeight As Integer = oScreenRect.Height - oWorkingRect.Height ' Top border (check if taskbar is on top ' or bottom via WorkingRect.Y) If oNewPosition.y >= -WINDOW_SNAP_OFFSET AndAlso (oWorkingRect.Y > 0 AndAlso oNewPosition.y <= (oTaskbarHeight + WINDOW_SNAP_OFFSET)) OrElse (oWorkingRect.Y <= 0 AndAlso oNewPosition.y <= (WINDOW_SNAP_OFFSET)) Then If oTaskbarHeight > 0 Then oNewPosition.y = oWorkingRect.Y ' Horizontal Taskbar Else oNewPosition.y = 0 ' Vertical Taskbar End If End If ' Right border If oNewPosition.x + oClientRect.Width <= oWorkingRect.Right + WINDOW_SNAP_OFFSET AndAlso oNewPosition.x + oClientRect.Width >= oWorkingRect.Right - WINDOW_SNAP_OFFSET Then oNewPosition.x = oWorkingRect.Right - (oClientRect.Width + SystemInformation.FrameBorderSize.Width) End If ' Bottom border If oNewPosition.y + oClientRect.Height <= oWorkingRect.Bottom + WINDOW_SNAP_OFFSET AndAlso oNewPosition.y + oClientRect.Height >= oWorkingRect.Bottom - WINDOW_SNAP_OFFSET Then oNewPosition.y = oWorkingRect.Bottom - (oClientRect.Height + SystemInformation.FrameBorderSize.Height) End If ' Marshal it back Marshal.StructureToPtr(oNewPosition, pLParam, True) Catch ex As ArgumentException End Try End Sub Public Class Utils Private Shared GetControlNameMessage As Integer = 0 Public Shared Function GetWinFormsId(ByVal hWnd As IntPtr) As String GetControlNameMessage = NativeMethods.RegisterWindowMessage("WM_GETCONTROLNAME") Return XProcGetControlName(hWnd, GetControlNameMessage) End Function Protected Shared Function XProcGetControlName(ByVal hwnd As IntPtr, ByVal msg As Integer) As String Dim bytearray As Byte() = New Byte(65535) {} Dim bufferMem As IntPtr = IntPtr.Zero Dim written As IntPtr = IntPtr.Zero Dim retHandle As IntPtr = IntPtr.Zero Dim retVal As Boolean Dim processHandle As IntPtr = IntPtr.Zero Dim fileHandle As IntPtr = IntPtr.Zero If Not (Environment.OSVersion.Platform = PlatformID.Win32Windows) Then Try Dim size As UInteger size = 65536 processHandle = NativeMethods.OpenProcess(NativeMethods.PROCESS_VM_OPERATION Or NativeMethods.PROCESS_VM_READ Or NativeMethods.PROCESS_VM_WRITE, False, GetProcessIdFromHWnd(hwnd)) If processHandle.ToInt64() = 0 Then Throw New Win32Exception() End If bufferMem = NativeMethods.VirtualAllocEx(processHandle, IntPtr.Zero, New UIntPtr(size), NativeMethods.MEM_RESERVE Or NativeMethods.MEM_COMMIT, NativeMethods.PageProtection.ReadWrite) If bufferMem.ToInt64() = 0 Then Throw New Win32Exception() End If retHandle = NativeMethods.SendMessage(hwnd, msg, New IntPtr(size), bufferMem) retVal = NativeMethods.ReadProcessMemory(processHandle, bufferMem, bytearray, New UIntPtr(size), written) If Not retVal Then Throw New Win32Exception() End If Finally retVal = NativeMethods.VirtualFreeEx(processHandle, bufferMem, New UIntPtr(0), NativeMethods.MEM_RELEASE) If Not retVal Then Throw New Win32Exception() End If NativeMethods.CloseHandle(processHandle) End Try Else Try Dim size2 As Integer size2 = 65536 fileHandle = NativeMethods.CreateFileMapping(New IntPtr(NativeMethods.INVALID_HANDLE_VALUE), IntPtr.Zero, NativeMethods.PageProtection.ReadWrite, 0, size2, Nothing) If fileHandle.ToInt64() = 0 Then Throw New Win32Exception() End If bufferMem = NativeMethods.MapViewOfFile(fileHandle, NativeMethods.FILE_MAP_ALL_ACCESS, 0, 0, New UIntPtr(0)) If bufferMem.ToInt64() = 0 Then Throw New Win32Exception() End If NativeMethods.MoveMemoryFromByte(bufferMem, bytearray(0), size2) retHandle = NativeMethods.SendMessage(hwnd, msg, New IntPtr(size2), bufferMem) NativeMethods.MoveMemoryToByte(bytearray(0), bufferMem, 1024) Finally NativeMethods.UnmapViewOfFile(bufferMem) NativeMethods.CloseHandle(fileHandle) End Try End If Return ByteArrayToString(bytearray) End Function Private Shared Function GetProcessIdFromHWnd(ByVal hwnd As IntPtr) As UInteger Dim pid As UInteger NativeMethods.GetWindowThreadProcessId(hwnd, pid) Return pid End Function Private Shared Function ByteArrayToString(ByVal bytes As Byte()) As String If Environment.OSVersion.Platform = PlatformID.Win32Windows Then Return Encoding.[Default].GetString(bytes).TrimEnd(vbNullChar) Else Return Encoding.Unicode.GetString(bytes).TrimEnd(vbNullChar) End If End Function End Class End Class