GetScreenSnapshot – Capture a window or the entire screen

Private Type RECT    Left As Long    Top As Long    Right As Long    Bottom As LongEnd TypePrivate Type PICTDESC    cbSize As Long    pictType As Long    hIcon As Long    hPal As LongEnd Type        Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" _    (lpPictDesc As PICTDESC, riid As Any, ByVal fOwn As Long, _    ipic As IPicture) As LongPrivate Declare Function GetDesktopWindow Lib "user32" () As LongPrivate Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As _    LongPrivate Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, _    ByVal nWidth As Long, ByVal nHeight As Long) As LongPrivate Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, _    ByVal hObject As Long) As LongPrivate 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 lScreenDC As Long, ByVal XSrc As Long, _    ByVal YSrc As Long, ByVal dwRop As Long) As LongPrivate Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As LongPrivate Declare Function GetWindowDC Lib "user32" (ByVal hWnd As Long) As LongPrivate Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, _    ByVal hDC As Long) As LongPrivate Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, _    lpRect As RECT) As Long' Capture the contents of a window or the entire screenFunction GetScreenSnapshot(Optional ByVal hWnd As Long) As IPictureDisp    Dim targetDC As Long    Dim hDC As Long    Dim tempPict As Long    Dim oldPict As Long    Dim wndWidth As Long    Dim wndHeight As Long    Dim Pic As PICTDESC    Dim rcWindow As RECT    Dim guid(3) As Long       ' provide the right handle for the desktop window    If hWnd = 0 Then hWnd = GetDesktopWindow        ' get window's size    GetWindowRect hWnd, rcWindow    wndWidth = rcWindow.Right - rcWindow.Left    wndHeight = rcWindow.Bottom - rcWindow.Top    ' get window's device context    targetDC = GetWindowDC(hWnd)        ' create a compatible DC    hDC = CreateCompatibleDC(targetDC)       ' create a memory bitmap in the DC just created    ' the has the size of the window we're capturing    tempPict = CreateCompatibleBitmap(targetDC, wndWidth, wndHeight)    oldPict = SelectObject(hDC, tempPict)        ' copy the screen image into the DC    BitBlt hDC, 0, 0, wndWidth, wndHeight, targetDC, 0, 0, vbSrcCopy      ' set the old DC image and release the DC    tempPict = SelectObject(hDC, oldPict)    DeleteDC hDC    ReleaseDC GetDesktopWindow, targetDC       ' fill the ScreenPic structure    With Pic        .cbSize = Len(Pic)        .pictType = 1           ' means picture        .hIcon = tempPict        .hPal = 0           ' (you can omit this of course)    End With      ' convert the image to a IpictureDisp object    ' this is the IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB}    ' we use an array of Long to initialize it faster    guid(0) = &H7BF80980    guid(1) = &H101ABF32    guid(2) = &HAA00BB8B    guid(3) = &HAB0C3000    ' create the picture,    ' return an object reference right into the function result    OleCreatePictureIndirect Pic, guid(0), True, GetScreenSnapshotEnd Function

Share the Post:
Share on facebook
Share on twitter
Share on linkedin

Overview

Recent Articles: