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.
- 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.
- On Form1, add the OLE Control, and select the object you want to
insert.
- On Form1, add a Picture Box and two Command Buttons. Set the Picture
Box AutoRedraw property to True.
- 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
- 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
- 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
- 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.
|