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