Screen Shot

The code below captures a screen shot. See the comments in cmdGetShot_Click() for alternatives... For this to work, add a picture box called picScreen (with AutoRedraw set to True), and a command button called cmdGetShot.

Option Explicit

Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function GetTopWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) 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 Sub cmdGetShot_Click()
Dim pt As POINTAPI
Dim lhWnd As Long
    ' Desktop window...
    lhWnd = GetDesktopWindow
    ' Active window...
    'lhWnd = GetActiveWindow
   
    ' window under mouse
    ' for this to work, get the focus on cmdgetshot, point to another window,
    ' and press enter.
    ' Alternatively, activate this in a timer!
    ' (otherwise you will always get this form!)
    'GetCursorPos pt
    'ClientToScreen Me.hwnd, pt
    ' Find window under it
    'lhWnd = WindowFromPoint(pt.x, pt.y)
    'lhWnd = GetParent(lhWnd)
    'get the screen shot
    GetShot lhWnd
End Sub

Public Sub GetShot(lWindowhWnd As Long)
    Dim lWindowhDC As Long
    Dim lParenthWnd As Long
    Dim lChildhWnd As Long

    Dim nLeft As Long
    Dim nTop As Long
    Dim nWidth As Long
    Dim nHeight As Long
    Dim rRect As RECT

    picScreen.Cls
    Set picScreen.Picture = Nothing
    DoEvents
   
    GetWindowRect lWindowhWnd, rRect
    lWindowhDC = GetWindowDC(lWindowhWnd)
    '// Get coordinates
    nLeft = 0
    nTop = 0
    nWidth = rRect.Right - rRect.Left
    nHeight = rRect.Bottom - rRect.Top
    picScreen.Width = nWidth * Screen.TwipsPerPixelX
    picScreen.Height = nHeight * Screen.TwipsPerPixelY
    '// Blt to frm.picScreen
    BitBlt picScreen.hdc, 0, 0, nWidth, nHeight, lWindowhDC, nLeft, nTop, vbSrcCopy
    '// Del DC
    ReleaseDC lWindowhWnd, lWindowhDC
    '// set picture
    picScreen.Picture = picScreen.Image
   
End Sub