How to Extract the Metafile from an OLE Control

Last reviewed: June 21, 1995
Article ID: Q119395
The information in this article applies to:
  • Standard and Professional Editions of Microsoft Visual Basic for Windows, version 3.0

SUMMARY

The Visual Basic OLE Control uses a metafile to display its object data. You can extract this metafile and play it to a printer, picture control, and so forth. By activating the OLE control and setting its format property to CF_METAFILEPICT, its metafile picture can be obtained from the data property.

MORE INFORMATION

The code below demonstrates how to extract a metafile from the OLE control and play it to either a picture box, or the printer.

  1. Start Visual Basic, or if Visual Basic is already running, choose New Project from the File menu (Alt+F, N) to create a new project.

  2. On Form1, add the OLE Control, and select the object you want to insert.

  3. On Form1, add a Picture Box and two Command Buttons. Set the Picture Box AutoRedraw property to True.

  4. Create a new module by choosing File New Module (Alt+F, M). This will create "module1.bas". Enter the following code for "module1.bas" (making sure that the declare statements below each fit on one line):

    Option Explicit

    Type METAFILEPICT

           mm As Integer
           xext As Integer
           yext As Integer
           hmf As Integer
    
    End Type

    Type POINTAPI

           x As Integer
           y As Integer
    
    End Type

       Declare Function GLobalLock Lib "kernel" (ByVal hMem As Integer) As Long
       Declare Function GlobalUnlock Lib "kernel" (ByVal hMem As Integer)
                                                  As Integer
       Declare Sub hmemcpy Lib "kernel" (hpvDest As Any,
                                         ByVal hpvSource As Any,
                                         ByVal cbCopy As Long)
       Declare Sub hmemcpy2 Lib "kernel" Alias "hmemcpy" (hpvDest As Any,
                                                          hpvSource As Any,
                                                          ByVal cbCopy As Long)
       Declare Function PlayMetafile% Lib "GDI" (ByVal hDC%, ByVal hmf%)
       Declare Function SetMapMode Lib "GDI" (ByVal hDC As Integer,
                                              ByVal nMapMode As Integer)
                                             As Integer
       Declare Function SetViewPortExt Lib "GDI" (ByVal hDC As Integer,
                                                  ByVal x As Integer,
                                                  ByVal y As Integer)
                                                 As Long
    
       ' A Special declare of SetViewPortExt that allows us
       ' to pass the x,y coordinates in one long variable.
       Declare Function SetViewPortExtd Lib "GDI" Alias "SetViewPortExt"
                                                 (ByVal hDC As Integer,
                                                  ByVal viewport As Long)
                                                 As Long
       Declare Function LPtoDP Lib "GDI" (ByVal hDC As Integer,
                                          lpPoints As POINTAPI,
                                          ByVal nCount As Integer) As Integer
    
       Global Const MM_HIMETRIC = 3
       Global Const MM_ANISOTROPIC = 8
    
    
       Function DrawMetaFile (MFPict As METAFILEPICT, zoomfactor As Integer,
                              hDC As Integer) As Integer
          Dim mappoint As POINTAPI  ' Stores a point (x,y) to help
                                    ' convert from HIMETRIC to pixels.
          Dim oldmapmode As Integer ' Stores the old map mode.
          Dim picwidth As Integer   ' Holds picture width in pixels.
          Dim picheight As Integer  ' Holds picture height in pixels.
          Dim oldviewport As Long   ' Stores the old viewport.
          Dim retvalue As Long      ' Holds API return values.
    
          DrawMetaFile = True
    
          ' The metafile coordinates are in HIMETRIC units.
          ' Set the mapmode of the hdc to HIMETRIC
          ' so you can calculate the size in pixels.
          oldmapmode = SetMapMode(hDC, MM_HIMETRIC)
    
          mappoint.x = MFPict.xext ' HIMETRIC width
          mappoint.y = MFPict.yext ' HIMETRIC height
    
          ' LPtoDP will convert the width and height to pixels.
          If (False = LPtoDP(hDC, mappoint, 1)) Then
             ' ReEstablish oldmapmode and exit with error.
             retvalue = SetMapMode(hDC, oldmapmode)
             GoTo DMFError
          End If
    
          ' Now set the mapmode to ANISOTROPIC to match the
          ' mapmode of the metafile.
          retvalue = SetMapMode(hDC, MM_ANISOTROPIC)
    
          ' Retrieve the converted width and height.
          ' Some values will be negative, so use Abs.
          picwidth = Abs(mappoint.x)
          picheight = Abs(mappoint.y)
    
          ' Scale to Zoom factor.
          picheight = picheight * zoomfactor
          picwidth = picwidth * zoomfactor
    
          ' Set the viewport to match our zoom.
          oldviewport = SetViewPortExt(hDC, picwidth, picheight)
    
          ' Play the metafile to the hdc.
          If (False = PlayMetafile(hDC, MFPict.hmf)) Then GoTo DMFError
    
          ' ReEstablish old viewport and map mode for the hdc.
          retvalue = SetViewPortExtd(hDC, oldviewport)
          retvalue = SetMapMode(hDC, oldmapmode)
    
          Exit Function
    
       DMFError:
          DrawMetaFile = False
       End Function
    
       Sub GetMetaFile (MFPict As METAFILEPICT, olectrl As OLE)
          Dim hGlbMem As Integer  ' Handle to Global Memory Object.
          Dim lpMem As Long       ' Long Pointer to Memory.
          Dim APISuccess As Integer ' Return value for errors (if any)
          Dim tempdata As Long      ' temporary for storing data property.
    
          ' OLE Control must be activated to get MetaFile.
          olectrl.Action = 7
    
          ' Tell the OLE Control what format we want.
          olectrl.Format = "CF_METAFILEPICT"
    
          ' Retrieve the Global Memory Handle from Data Property.
          ' Copy low 2 bytes to hGlbMem.
          ' hmemcpy2 lets us copy the unsigned integer part of tempdata.
          tempdata = olectrl.Data
          Call hmemcpy2(hGlbMem, tempdata, 2)
    
          ' Retrieve pointer to Global Memory.
          lpMem = GLobalLock(hGlbMem)
    
          ' Copy Metafile to MFPict.
          Call hmemcpy(MFPict, lpMem, Len(MFPict))
    
          ' Release pointer to Global Memory.
          APISuccess = GlobalUnlock(hGlbMem)
       End Sub
    
    

  5. For the Form1 Command1 Click event, enter the following code:

       Sub Command1_Click ()
          ' Draw Metafile to Printer.
          Dim MFPict As METAFILEPICT
          GetMetaFile MFPict, ole1
    
          ' Initialize the printer.
          printer.Print " "
    
          ' Draw to printer and double the size.
          If Not DrawMetaFile(MFPict, 2, (printer.hDC)) Then
             MsgBox "DrawMetaFile failed"
          End If
          printer.EndDoc
       End Sub
    
    

  6. For the Form1 Command2 Click event, enter the following code:

       Sub Command2_Click ()
          ' Draw Metafile to picture1.
          Dim MFPict As METAFILEPICT
          GetMetaFile MFPict, ole1
    
          If Not DrawMetaFile(MFPict, 1, (picture1.hDC)) Then
             MsgBox "DrawMetaFile failed"
          End If
          picture1.Refresh
       End Sub
    
    

  7. Save the project and run it. Choose Command1 to draw the metafile

        displayed by the OLE control to the printer. Choose Command2 to
        draw it to the picture box.
    

REFERENCES

Please see the following Microsoft Knowledge Base article for more information:

   ARTICLE-ID: Q113682
   TITLE     : How to Print a Metafile and Text to Form or Printer

Please also see MSDN 8 article "Metafiles," by Ron Gery.


Additional reference words: 3.00
KBCategory: kbgraphic kbprg kbcode
KBSubCategory: APrgGrap


THE INFORMATION PROVIDED IN THE MICROSOFT KNOWLEDGE BASE IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND. MICROSOFT DISCLAIMS ALL WARRANTIES, EITHER EXPRESS OR IMPLIED, INCLUDING THE WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. IN NO EVENT SHALL MICROSOFT CORPORATION OR ITS SUPPLIERS BE LIABLE FOR ANY DAMAGES WHATSOEVER INCLUDING DIRECT, INDIRECT, INCIDENTAL, CONSEQUENTIAL, LOSS OF BUSINESS PROFITS OR SPECIAL DAMAGES, EVEN IF MICROSOFT CORPORATION OR ITS SUPPLIERS HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. SOME STATES DO NOT ALLOW THE EXCLUSION OR LIMITATION OF LIABILITY FOR CONSEQUENTIAL OR INCIDENTAL DAMAGES SO THE FOREGOING LIMITATION MAY NOT APPLY.

Last reviewed: June 21, 1995
© 1998 Microsoft Corporation. All rights reserved. Terms of Use.