'Globals
'****************************************************************
'Windows API/Global Declarations for :PrintScreen
'****************************************************************

Option Explicit
Option Base 0
 

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


Public Type PicBmp
       Size As Long

Type As Long
       hBmp As Long
       hPal As Long
       Reserved As Long
End Type


Public Declare Function GetDesktopWindow Lib "user32" () As Long
        

Public Declare Function CreateCompatibleDC Lib "gdi32" _
       (ByVal hdc As Long) As Long

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

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

Public 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

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

Public Declare Function GetWindowDC Lib "user32" _
       (ByVal hWnd As Long) As Long

Public Declare Function ReleaseDC Lib "user32" _
       (ByVal hWnd As Long, ByVal hdc As Long) As Long

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

'Code
'****************************************************************
' Name: PrintScreen
'     ' Description:Does a printscreen using OLE
' By: VB Net (Randy Birch)
'
' Inputs:None
' Returns:None
' Assumes:By Randy Birch. This code makes use of the OLE standard interface in Windows95 to copy the contents of the desktop (the screen) into a picturebox and save it to disk. To use this code, you must assure that the Standard OLE Types Reference to file \Windows\System\OLEPRO32.DLL is included in the project's references (Tools Menu/References).
'The PrintScreen command cannot be activated using SendKeys, nor by setting any combination of keycodes in Visual Basic without the use of APIs.
'The Bitmap page contains the API code to call the real PrintScreen routine.
' Side Effects:None
'
'Code provided by Planet Source Code(tm) 'as is', without
'     warranties as to performance, fitness, merchantability,
'     and any other warranty (whether expressed or implied).
'****************************************************************

'On a form, add a command button and a picturebox. Add the following code to the form:

Private Sub Command1_Click()

       Set Picture1.Picture = GetOLEScreenSnapshot()
       'Remove the comment on the next line to save the picture to 
       '     disk. 
       '     'Make sure the path provided is valid for your system.
       '     'SavePicture Picture1, "d:\test.bmp"
End Sub

Add the following code to the BAS module:

Public Function GetOLEScreenSnapshot() As Picture

       Dim hWndSrc As Long
       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 r As Long
       Dim Pic As PicBmp
       Dim IPic As IPicture
       Dim IID_IDispatch As GUID
       '     'CaptureWindow
       WidthSrc = Screen.Width \ Screen.TwipsPerPixelX
       HeightSrc = Screen.Height \ Screen.TwipsPerPixelY
       'Get a handle to the desktop window and get the proper devic
       '     e context
       hWndSrc = GetDesktopWindow()
       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
       r = 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
       r = DeleteDC(hDCMemory)
       r = 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
r = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic)
'     'Return the new Picture object
Set GetOLEScreenSnapshot = IPic
End Function