Monorepo/Windows/Window.vb

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

    ''' <summary>
    ''' Returns Information about the currently focused window
    ''' </summary>
    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

    ''' <summary>
    ''' Returns Information about the Window with `hWnd`
    ''' </summary>
    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

    ''' <summary>
    ''' Returns the currently focused control
    ''' </summary>
    ''' <param name="WindowHandle">Current window handle; can be obtained from Me.Handle</param>
    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

    ''' <summary>
    ''' Returns Bounds of `ControlHandle`. Relative to `WindowHandle` and `Anchor` value.
    ''' </summary>
    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

    ''' <summary>
    ''' Returns Bounds of the focused control. Relative to current form and `Anchor` value.
    ''' </summary>
    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

    ''' <summary>
    ''' Returns Bounds of the control under the cursor. Relative to current form and `Anchor` value.
    ''' </summary>
    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