Visual Basic Imaging Routines
CreateEnhMetaFile: Saving a PrintScreen as a Windows Enhanced Metafile
     
Posted:   Wednesday February 05, 2003
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB6, Windows XP
OS restrictions:   None
Author:   Mike Sutton, 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.

Based on a newsgroup post by Mike D. Sutton, and reproduced here with permission, this code shows how to save a PrintScreen of the desktop client area (or the client area of any hwnd passed) to disk in Windows Enhanced Metafile format. For demo purposes the image is also displayed in a picture box on the form.

 BAS Module Code
None.

 Form Code
To the form containing a picture box (Picture1) and a command button (Command1), add the following code:

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.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const HORZSIZE As Long = 4 'Horizontal size in millimetres
Private Const VERTSIZE As Long = 6 'Vertical size in millimetres
Private Const HORZRES As Long = 8  'Horizontal width in pixels
Private Const VERTRES As Long = 10 'Vertical width in pixels

Private Const STRETCH_ANDSCANS As Long = 1
Private Const STRETCH_ORSCANS As Long = 2
Private Const STRETCH_DELETESCANS As Long = 3
Private Const STRETCH_HALFTONE As Long = 4

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

Private Declare Function CreateEnhMetaFile Lib "gdi32" _
   Alias "CreateEnhMetaFileA" _
  (ByVal hdcRef As Long, _
   ByVal lpFileName As String, _
   ByRef lpRect As Rect, _
   ByVal lpDescription As String) As Long

Private Declare Function CloseEnhMetaFile Lib "gdi32" _
  (ByVal hDC As Long) As Long

Private Declare Function DeleteEnhMetaFile Lib "gdi32" _
  (ByVal hEMF As Long) As Long

Private Declare Function PlayEnhMetaFile Lib "gdi32" _
   (ByVal hDC As Long, _
    ByVal hEMF As Long, _
    ByRef lpRect As Any) 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 GetDeviceCaps Lib "gdi32" _
   (ByVal hDC As Long, _
    ByVal nIndex As Long) As Long

Private Declare Function GetClientRect Lib "user32" _
   (ByVal hwnd As Long, _
    ByRef lpRect As Rect) As Long

Private Declare Function GetWindowRect Lib "user32" _
  (ByVal hwnd As Long, _
   lpRect As Rect) 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 SetStretchBltMode Lib "gdi32" _
   (ByVal hDC As Long, _
    ByVal nStretchMode As Long) As Long
    
Private Declare Function GetDesktopWindow Lib "user32" () As Long    


Private Sub Form_Load()

   Picture1.AutoRedraw = True
   Command1.Caption = "Create Metafile"
   
End Sub


Private Sub Picture1_Click()
    
   Picture1.Cls 'Reset
   
End Sub


Private Sub Command1_Click()

   Dim hEMF As Long
   Dim rc As Rect

  'Obtain a handle to a Windows
  'enhanced metafile of the desktop
  '(or to the client area of another
  'form or window specified by hwnd),
  'and optionally display the result
  'in a picturebox using metafile APIs,
  'then clean up
   hEMF = WindowClientToEMF(GetDesktopWindow(), "C:\TempEMF.emf")

   Call Picture1.Cls
   
   Call GetClientRect(Picture1.hwnd, rc)
   Call PlayEnhMetaFile(Picture1.hDC, hEMF, rc)
   Call Picture1.Refresh
   Call DeleteEnhMetaFile(hEMF)
   
End Sub


Private Function WindowClientToEMF(ByVal hwndIn As Long, _
                                   sOutputFile As String) As Long
    
   Dim rc As Rect
   Dim hTmpDc As Long

  'obtain the display context (DC) 
  'to the window passed
   hTmpDc = GetDC(hwndIn)
   
   If hTmpDc <> 0 Then
   
     'get the size of the client
     'area of the passed handle
      If GetClientRect(hwndIn, rc) <> 0 Then
       
        'pass the DC, rectangle and filename
        'to create the file, returning the
        'handle to the memory metafile
         WindowClientToEMF = DcToEmf2(hTmpDc, rc, sOutputFile)
         
        'release the temporary DC
         Call ReleaseDC(hwndIn, hTmpDc)
      
      End If
   End If
    
End Function


Private Function DcToEmf2(ByVal hDcIn As Long, _
                          inArea As Rect, _
                          sOutputFile As String) As Long
    
   Dim rc As Rect
   Dim MetaDC As Long
   Dim OldMode As Long   
   Dim hsize As Long
   Dim vsize As Long
   Dim hres As Long
   Dim vres As Long

  'Convert the area from pixels to .01mm's
  'Rectangle coordinates must be normalised
   hsize = GetDeviceCaps(hDcIn, HORZSIZE) * 100
   vsize = GetDeviceCaps(hDcIn, VERTSIZE) * 100
   hres = GetDeviceCaps(hDcIn, HORZRES)
   vres = GetDeviceCaps(hDcIn, VERTRES)
   
   With rc
      .Left = (inArea.Left * hsize) / hres
      .Top = (inArea.Top * vsize) / vres
      .Right = (inArea.Right * hsize) / hres
      .Bottom = (inArea.Bottom * vsize) / vres
   End With
    
  'Create a new MetaDC and output file
   MetaDC = CreateEnhMetaFile(hDcIn, sOutputFile, rc, vbNullString)
        
   If (MetaDC) Then
        
     'Draw the image to the MetaDC
     'Set STRETCH_HALFTONE stretch mode here for higher quality
      OldMode = SetStretchBltMode(MetaDC, STRETCH_HALFTONE)
        
      Call BitBlt(MetaDC, _
                  0, 0, _
                 (inArea.Right - inArea.Left), _
                 (inArea.Bottom - inArea.Top), _
                  hDcIn, _
                  inArea.Left, _
                  inArea.Top, _
                  vbSrcCopy)
            
     'restore the saved dc mode
      Call SetStretchBltMode(MetaDC, OldMode)

     'delete the MetaDC and return the
     'EMF object's handle
      DcToEmf2 = CloseEnhMetaFile(MetaDC)
        
   End If
   
End Function
 Comments

 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

 

Hit Counter