Binaryworld - WindowPicker - Pick any window using mouse and highlight window region ... [ VB -> Windows ]

In this sample code you will learn several techniques using APIs. Here is the summary

Capture mouse input to the current application window using SetCapture and ReleaseCapture
Obtain window handle from a point using WindowFromPoint
Get window region from the window handle using GetWindowRgn
Drawing frame with a specified border width around window region using FrameRgn
Create , Select and delete GDI objects (i.e. Pen, Brush, Regions...)

Step-By-Step Example

- Create a standard exe project
- Add one picturebox on the form1
- Add the following code in form1

Click here to copy the following block

Option Explicit

' Win32 API Declarations
Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function WindowFromPointXY Lib "user32" Alias "WindowFromPoint" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long

' Form-level member variables
Private m_hWnd As Long
Private m_Picking As Boolean

Private Sub Command1_Click()
  ' Attempt to paste something into
  ' selected window.
  If m_hWnd Then
    Clipboard.Clear
    Clipboard.SetText "Hello from VB5!", vbCFText
    Call SetForegroundWindow(m_hWnd)
    SendKeys "^v", True
  End If
End Sub

Private Sub Form_Load()
  ' Assign dragging pointer
  Picture1.Picture = Me.Icon
  Me.MouseIcon = Me.Icon
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  ' Clear picture and turn on dragging mousepointer.
  Me.MousePointer = vbCustom
  Set Picture1.Picture = Nothing

  ' Remember that we're currently picking a window.
  m_Picking = True

  ' Capture all mousemovements from this point until
  ' the user releases the mouse button.
  Call SetCapture(Picture1.hWnd)
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  Static pt As POINTAPI
  Static hWnd As Long

  ' If user is picking a window, check window is
  ' under the cursor whenever it moves. If it's
  ' a different window than previously, update the
  ' display to that effect.
  If m_Picking Then
    Call GetCursorPos(pt)
    hWnd = WindowFromPointXY(pt.x, pt.y)
    If hWnd <> m_hWnd Then
      ' Erase previous highlight.
      Call FrameWindow(m_hWnd)
      ' Cache new handle, update caption, and highlight.
      m_hWnd = hWnd
      Me.Caption = Hex(m_hWnd)
      Call FrameWindow(m_hWnd)
    End If
  End If
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  ' We're done picking now
  m_Picking = False

  ' Erase highlight.
  Call FrameWindow(m_hWnd)

  ' Restore dragging icon to picture box,
  ' and return mousepointer to normal.
  Picture1.Picture = Me.Icon
  Me.MousePointer = vbDefault

  ' Don't need to be notified anymore.
  Call ReleaseCapture

  ' The chosen window is already stored in m_hWnd!
  MsgBox "You picked hWnd: " & Hex(m_hWnd)
End Sub

Module1.bas

Click here to copy the following block

Option Explicit

' Win32 APIs...
Public Type POINTAPI
  x As Long
  y As Long
End Type

Private Type LOGPEN
  lopnStyle As Long
  lopnWidth As POINTAPI
  lopnColor As Long
End Type

Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

Private Declare Function IsWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CreatePenIndirect Lib "gdi32.dll" (ByRef lpLogPen As LOGPEN) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Private Declare Function SetROP2 Lib "gdi32" (ByVal hDC As Long, ByVal nDrawMode As Long) As Long
Private Declare Function CreateHatchBrush Lib "gdi32" (ByVal nIndex As Long, ByVal crColor As Long) As Long
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function GetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long) As Long
Private Declare Function FrameRgn Lib "gdi32" (ByVal hDC As Long, ByVal hRgn As Long, ByVal hBrush As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function IsZoomed Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long

'//Pen style
Private Const PS_DOT = 2
Private Const PS_SOLID = 0

Private Const PS_INSIDEFRAME As Long = 6

Private Const SM_CXSCREEN As Long = 0
Private Const SM_CYSCREEN As Long = 1
Private Const SM_CXBORDER As Long = 5
Private Const SM_CYBORDER As Long = 6
Private Const SM_CXFRAME As Long = 32
Private Const SM_CYFRAME As Long = 33

Private Const NULL_BRUSH As Long = 5
Private Const NULL_PEN As Long = 8

Private Const R2_NOT As Long = 6

Private Const HS_DIAGCROSS As Long = 5

Private Const CTLCOLOR_STATIC As Long = 6

' Region Flags
Private Const ERRORAPI As Long = 0
Private Const NULLREGION As Long = 1
Private Const SIMPLEREGION As Long = 2
Private Const COMPLEXREGION As Long = 3

' The following procedure was inspired by the work of Alex Feinman, and
' I'd like to thank him for offering suggestions on how to do this!
Public Sub FrameWindow(ByVal hWnd As Long, Optional PenWidth As Long = 3)
  Dim hDC As Long
  Dim hRgn As Long
  Dim hPen As Long
  Dim hOldPen As Long
  Dim hBrush As Long
  Dim hOldBrush As Long
  Dim OldMixMode As Long
  Dim cxFrame As Long
  Dim cyFrame As Long
  Dim r As RECT
  Dim LP As LOGPEN

  If IsWindow(hWnd) Then
    hDC = GetWindowDC(hWnd)
    hRgn = CreateRectRgn(0, 0, 0, 0)

    LP.lopnStyle = PS_INSIDEFRAME  'PS_SOLID
    LP.lopnWidth.x = GetSystemMetrics(SM_CXBORDER) * PenWidth
    LP.lopnWidth.y = GetSystemMetrics(SM_CXBORDER) * PenWidth

    'Create a new pen
    hPen = CreatePenIndirect(LP)

    hPen = CreatePenIndirect(LP)
    hOldPen = SelectObject(hDC, hPen)
    hOldBrush = SelectObject(hDC, GetStockObject(NULL_BRUSH))
    OldMixMode = SetROP2(hDC, R2_NOT)

    If GetWindowRgn(hWnd, hRgn) <> ERRORAPI Then
      hBrush = CreateHatchBrush(HS_DIAGCROSS, GetSysColor(CTLCOLOR_STATIC))
      Call FrameRgn(hDC, hRgn, hBrush, _
          GetSystemMetrics(SM_CXBORDER) * PenWidth, _
          GetSystemMetrics(SM_CYBORDER) * PenWidth)
    Else
      cxFrame = GetSystemMetrics(SM_CXFRAME)
      cyFrame = GetSystemMetrics(SM_CYFRAME)
      Call GetWindowRect(hWnd, r)

      If IsZoomed(hWnd) Then
        Call Rectangle(hDC, cxFrame, cyFrame, _
            GetSystemMetrics(SM_CXSCREEN) + cxFrame, _
            GetSystemMetrics(SM_CYSCREEN) + cyFrame)
      Else
        Call Rectangle(hDC, 0, 0, r.Right - r.Left, r.Bottom - r.Top)
      End If
    End If

    ' // cleanup....
    Call SelectObject(hDC, hOldPen)
    Call SelectObject(hDC, hOldBrush)
    Call SetROP2(hDC, OldMixMode)
    Call DeleteObject(hPen)
    Call DeleteObject(hBrush)
    Call DeleteObject(hRgn)
    Call ReleaseDC(hWnd, hDC)
  End If
End Sub