Binaryworld - GetScreenSnapshot - Capture a window or the entire screen ... [ VB -> Graphics ]

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

Private Type PICTDESC
  cbSize As Long
  pictType As Long
  hIcon As Long
  hPal As Long
End Type

Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" _
  (lpPictDesc As PICTDESC, riid As Any, ByVal fOwn As Long, _
  ipic As IPicture) As Long
Private Declare Function GetDesktopWindow 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 lScreenDC 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 ReleaseDC Lib "user32" (ByVal hWnd As Long, _
  ByVal hDC As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, _
  lpRect As RECT) As Long

' Capture the contents of a window or the entire screen

Function 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, GetScreenSnapshot

End Function