[VBnet Screen] InflateRect: Highlighting External Windows


	Visual Basic Screen & System Metrics InflateRect: Highlighting External Windows

Posted:	Monday October 25, 2004
Updated:	Monday December 26, 2011

Applies to:	VB4-32, VB5, VB6
Developed with:	VB6, Windows XP
OS restrictions:	None
Author:	VBnet - Randy Birch

Related:	BitBlt: Mimicking the PrintScreen Function BitBlt: Mimicking PrintScreen to Create a 'PrintForm' CreateEnhMetaFile: Saving a PrintScreen as a Windows Enhanced Metafile InflateRect: Highlighting External Windows keybd_event: Calling Windows' PrintScreen Function OleCreatePictureIndirect: Mimicking PrintScreen Using OLE

Prerequisites

None.

This demo shows how to highlight windows --- when the mouse button is depressed and the cursor is positioned overtop the windows or controls in both your and other applications, or over any child windows, their controls, toolbars, the desktop or the taskbars, a bounding rectangle highlights the window under the mouse. On release of the mouse button, a screen capture is made of the current screen image defined by the bounding rectangle and reflected in a picture box for saving or display.

The core of the routine uses the DrawFocusRect and InflateRect APIs to create a highlight border around the window under the cursor, similar to VB's Spyxx utility.

I had to create some method to signal the beginning of the rectangle drawing routines, so for simplicity I elected to utilize a picture box within a picture box, with the inner box containing an image.

On the mouse down event when over the bulls eye icon in the picture box (clicking the "target" icon), SetCapture is called to ensure subsequent mouse events are driven to the "target" picture box. I then hide the inner picture box containing the icon to indicate the code is active. (The actual image in the picture box is not relevant to this demo - the inner picture box can be blank for that matter. A more elaborate demo would show how to create a screen cursor out of the "target" image so as to more clearly reflect the activation state of the routines while the mouse was outside the form.)

With the code activated, moving the mouse around the screen will cause the rectangle for each each parent or child window to attain a thick border - what I call the window highlight.

When the left mouse button is released overtop a window outside the form, the currently highlighted window's focus rectangle is removed, and that window is captured to the picture box. A SavePicture call would be all that was required to dump the captured image to disk.

As shown below, to create the illustrations above my desktop had a browser overtop Outlook 2003. The pictures cycle three illustrations:

The first picture in the animated illustration above is the result of highlighting the browser's page content window resulting in a snapshot of the entire page. The page is clipped in the demo view.

For the second illustration I brought Outlook to the front and used the demo to highlight the Outlook 2003 'navigation pane'. Again, the full rectangle is captured, but just not shown here.

The third image has the browser back on top, but I intentionally highlighted the Outlook navigation pane rectangle - this bounding rectangle can be seen in the photo below. As this code will highlight a rectangle as long as it can obtain the hwnd of the window beneath the cursor, the result of releasing the button, since this is a screen capture and not a "window capture", is the screen image inside the bounding rectangle for the navigation pane.

BAS Module Code

None.

Form Code

To the form, add a picture box (Picture1) to hold the captured image. Add a second picture box (Picture2 - the white picture box in the illustration) and inside it draw a third picture box (Picture3). Assign an image to Picture3 if desired such as the bulls eye target in the illustrations above).

Add the following code to the form:

Option Explicit

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'hwnd of the window under the cursor at
'any given time
Private hwndActiveWindow As Long

'hwnd of the window which has
'been drawn with the edge border.
'Used to erase the rect when focus moves
Private hwndBorderRect As Long

Private Type POINTAPI
   x As Long
   y As Long
End Type

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

Private Type GUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(7) As Byte
End Type

Private Type PicBmp
   Size As Long
   Type As Long
   hBmp As Long
   hPal As Long
   Reserved As Long
End Type

Private Declare Function WindowFromPoint Lib "user32" _
  (ByVal xPoint As Long, _
   ByVal yPoint As Long) As Long

Private Declare Function GetCursorPos Lib "user32" _
  (lpPoint As POINTAPI) As Long

Private Declare Function GetClientRect Lib "user32" _
  (ByVal hwnd As Long, _
   lpRect As RECT) As Long
   
Private Declare Function GetWindowRect Lib "user32" _
  (ByVal hwnd As Long, _
   lpRect As RECT) As Long
   
Private Declare Function DrawFocusRect Lib "user32" _
  (ByVal hdc As Long, _
   lpRect As RECT) As Long

Private Declare Function InflateRect Lib "user32" _
  (lpRect As RECT, _
   ByVal x As Long, _
   ByVal y As Long) As Long

Private Declare Function PtInRect Lib "user32" _
  (lpRect As RECT, _
   ByVal ptx As Long, _
   ByVal pty As Long) As Long

Private Declare Function GetDC 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 SetCapture Lib "user32" _
  (ByVal hwnd As Long) As Long

Private Declare Function ReleaseCapture Lib "user32" () As Long
 
Private Declare Function CreateCompatibleDC Lib "gdi32" _
   (ByVal hdc As Long) As Long

Private Declare Function CreateCompatibleBitmap Lib "gdi32" _
   (ByVal hdc As Long, ByVal nWidth As Long, _
    ByVal nHeight As Long) As Long

Private Declare Function SelectObject Lib "gdi32" _
   (ByVal hdc As Long, ByVal hObject As Long) As Long

Private Declare Function BitBlt Lib "gdi32" _
   (ByVal hDCDest As Long, ByVal XDest As Long, _
    ByVal YDest As Long, ByVal nWidth As Long, _
    ByVal nHeight As Long, ByVal hDCSrc As Long, _
    ByVal XSrc As Long, ByVal YSrc As Long, _
    ByVal dwRop As Long) As Long

Private Declare Function DeleteDC Lib "gdi32" _
   (ByVal hdc As Long) As Long

Private Declare Function GetWindowDC Lib "user32" _
   (ByVal hwnd As Long) As Long

Private Declare Function OleCreatePictureIndirect Lib "olepro32" _
   (PicDesc As PicBmp, RefIID As GUID, _
    ByVal fPictureOwnsHandle As Long, _
    IPic As IPicture) As Long



Private Sub Picture3_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)

   If Button = vbLeftButton Then
   
     'ensure mouse events return to
     'Picture3, and hide it.
      SetCapture Picture3.hwnd
      Picture3.Visible = False
      
   End If
    
End Sub


Private Sub Picture3_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

   Dim pt As POINTAPI
   Dim myrect As RECT
   
   If Button = vbLeftButton Then
   
     'Determine the position of the mouse.
     'If it's over our own app, just erase any
     'highlight drawn, otherwise highlight the
     'new window if required.
      Call GetCursorPos(pt)
      hwndActiveWindow = WindowFromPoint(pt.x, pt.y)
      GetWindowRect Me.hwnd, myrect
      
      If (PtInRect(myrect, pt.x, pt.y) = 1) Then
        EraseWindowHighlight
      Else
            
         If hwndBorderRect <> hwndActiveWindow Then
            DrawWindowHighlight hwndBorderRect
            DrawWindowHighlight hwndActiveWindow
            hwndBorderRect = hwndActiveWindow
         End If 'hwndBorderRect
      
      End If  'PtInRect
      
   End If  'Button
   
End Sub


Private Sub Picture3_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

   Dim pt As POINTAPI
   Dim myrect As RECT
   
  'free the capture and clear any highlighting
  ' prior to capturing the screen
   ReleaseCapture
   EraseWindowHighlight
   
   If Button = vbLeftButton Then
   
      Picture3.Visible = True
      Screen.MousePointer = vbDefault
   
      Call GetCursorPos(pt)
      hwndActiveWindow = WindowFromPoint(pt.x, pt.y)
      GetWindowRect Me.hwnd, myrect
      
     'if the mouse is outside the app's form,
     'capture the previously highlighted window
      If PtInRect(myrect, pt.x, pt.y) = 0 Then
         Picture1.Picture = GetOLEScreenSnapshot(hwndActiveWindow)
      End If
   
   End If
   
End Sub


Private Sub DrawWindowHighlight(hwnd As Long)
    
    Dim rc As RECT
    Dim hDcScr As Long
    
    GetWindowRect hwnd, rc
    
    hDcScr = GetDC(0)
    Call DrawFocusRect(hDcScr, rc)
    Call InflateRect(rc, -1, -1)
    Call DrawFocusRect(hDcScr, rc)
    Call InflateRect(rc, -1, -1)
    Call DrawFocusRect(hDcScr, rc)
    Call ReleaseDC(0, hDcScr)
    
End Sub


Private Sub EraseWindowHighlight()

   If hwndBorderRect <> 0 Then
      DrawWindowHighlight hwndBorderRect
      hwndBorderRect = 0
   End If
    
End Sub


Private Function GetOLEScreenSnapshot(hWndSrc As Long) As Picture

   Dim hDCSrc As Long
   Dim hDCMemory As Long
   Dim hBmp As Long
   Dim hBmpPrev As Long
   Dim WidthSrc As Long
   Dim HeightSrc As Long
   Dim Pic As PicBmp
   Dim IPic As IPicture
   Dim IID_IDispatch As GUID
   Dim rc As RECT

   GetWindowRect hWndSrc, rc
   WidthSrc = rc.Right - rc.Left
   HeightSrc = rc.Bottom - rc.Top
   
  'get a handle to the desktop window and 
  'get the proper device context
   hDCSrc = GetWindowDC(hWndSrc)
   
  'create a memory device context for the copy process
   hDCMemory = CreateCompatibleDC(hDCSrc)
   
  'create a bitmap and place it in the memory DC
   hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc)
   hBmpPrev = SelectObject(hDCMemory, hBmp)
    
  'copy the on-screen image into the memory DC
   Call BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, _
               hDCSrc, 0, 0, vbSrcCopy)
   
  'remove the new copy of the the on-screen image
   hBmp = SelectObject(hDCMemory, hBmpPrev)
   
  'release the device context resources back to the system
   Call DeleteDC(hDCMemory)
   Call ReleaseDC(hWndSrc, hDCSrc)
   
  'fill in OLE IDispatch Interface ID
   With IID_IDispatch
      .Data1 = &H20400
      .Data4(0) = &HC0
      .Data4(7) = &H46
    End With
   
  'fill Pic with necessary parts
   With Pic
      .Size = Len(Pic)         'Length of structure
      .Type = vbPicTypeBitmap  'Type of Picture (bitmap)
      .hBmp = hBmp             'Handle to bitmap
      .hPal = 0&               'Handle to palette (may be null)
    End With
   
  'create OLE Picture object
   Call OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic)
   
  'return the new Picture object
   Set GetOLEScreenSnapshot = IPic

End Function

Comments

Naturally, if any part of the highlighted window is obscured by another window, the captured area will contain the screen image bound by the highlight rectangle. You can not take a full shot of an obscured window.

PayPal Link