Dotted Line in WMF using CreateMetaFile API 1

[DrJavaJoe]

Here's the scenario I'm creating a metafile using the CreateMetaFile API. When I try to create a dotted line everything seems to be fine, I can insert the image into Word and the dotted line prints fine, but not when I insert it into Crystal Report 9, the line prints as solid. My first thought was that there is a bug with Crystal Report, but I'm able to create a metafile in Visio that has dotted lines and it prints fine in Crystal.

I've put together a little function to duplicate what I'm doing. Any suggestion would be greatly appreciated.



Option Explicit
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Declare Function CreateMetaFile Lib "gdi32" _
Alias "CreateMetaFileA" (ByVal lpString As String) As Long
Private Declare Function CloseMetaFile Lib "gdi32" _
(ByVal hMF As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" _
(ByVal hdc As Long, ByVal X As Long, _
ByVal Y As Long, lpPoint As POINTAPI) As Long
Private Declare Function LineTo Lib "gdi32" _
(ByVal hdc As Long, ByVal X As Long, _
ByVal Y As Long) As Long
Private Declare Function Ellipse Lib "gdi32" _
(ByVal hdc As Long, ByVal X1 As Long, _
ByVal Y1 As Long, ByVal X2 As Long, _
ByVal Y2 As Long) As Long
Private Declare Function DeleteMetaFile Lib "gdi32" _
(ByVal hMF As Long) As Long
Private MhDC As Long
Private Declare Function CreatePen Lib "gdi32" _
(ByVal nPenStyle As Long, ByVal nWidth As Long, _
ByVal crColor As Long) As Long
Private Declare Function SelectObject Lib "gdi32" _
(ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long
Private Enum PenStyle
PS_SOLID = 0
PS_DASH = 1
PS_DOT = 2
PS_DASHDOT = 3
PS_DASHDOTDOT = 4
End Enum

Private Sub DrawDottedLine(lngStartX, lngStartY, lngEndX, lngEndY)
Dim pt As POINTAPI
Dim hpen As Long
Dim hpenOLD As Long
MhDC = CreateMetaFile("C:\MyFolder\MyFile.wmf&quot
If MhDC = 0 Then
MsgBox "Error creating metafile."
Exit Sub
End If
Dim hMF As Long
hpen = CreatePen(PS_DOT, 1, vbBlack)
hpenOLD = SelectObject(MhDC, hpen)
MoveToEx MhDC, lngStartX, lngStartY, pt
LineTo MhDC, lngEndX, lngEndY
hMF = CloseMetaFile(MhDC)
DeleteMetaFile hMF
End Sub
Private Sub Command1_Click()
DrawDottedLine 0, 0, 100, 100
End Sub

 

[strongm]

I'd suggest that you use enhanced metafiles instead (i.e CreateEnhMetaFile), as the old 16-bit version (i.e the type you create through CreateMetaFile) is technically obsolete and doesn't support a (pretty large) number of the 32-bit GDI functions.

 

[DrJavaJoe]

I'll give it a shot.

 

[DrJavaJoe]

No luck, it does the same thing.

 

[strongm]

Well, I'm stumped then. My initial thought would be that Crystal is not playing back the metafile properly - but the fact that you can drop in a Visio-created one OK rather blows that theory out of the water

 

[DrJavaJoe]

I'll try to open a service ticket with Seagate but they're going to say that there is something wrong with the emf file. I'm wondering what the differnce is between my emf file and the one created in Visio. Maybe I can add some additional formatting or something. Anyway thanks if you think of anything let me know.

 

[strongm]

Well, I guess you could try playing back the metafile in your VB application to confirm it works there using the simple PlayEnhMetaFile before calling Segate. Then at least you can point out to them that it works OK there. My guess would be that either:

a) Visio is doing it's dotted lines differently from a simple CreatePen call, or
b) Crystal has it's own playback routine, retrieving, interpreting and playing back each metafile record individually via PlayEnhMetaFileRecord rather than the whole metafile in one go

 

[DrJavaJoe]

strongm, using the function below to send the emh file to printer also prints a solid line. If the emh is loaded into word or even into windows picture and fax viewer and then printed it is dotted. I must be missing something.

Option Explicit
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type rect
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function GetEnhMetaFile Lib "gdi32" _
Alias "GetEnhMetaFileA" (ByVal lpszMetaFile As String) As Long
Private Declare Function PlayEnhMetaFile Lib "gdi32" _
(ByVal hdc As Long, ByVal hemf As Long, lpRect As rect) As Long
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 MoveToEx Lib "gdi32" _
(ByVal hdc As Long, ByVal X As Long, _
ByVal Y As Long, lpPoint As POINTAPI) As Long
Private Declare Function LineTo Lib "gdi32" _
(ByVal hdc As Long, ByVal X As Long, _
ByVal Y As Long) As Long
Private Declare Function Ellipse Lib "gdi32" _
(ByVal hdc As Long, ByVal X1 As Long, _
ByVal Y1 As Long, ByVal X2 As Long, _
ByVal Y2 As Long) As Long
Private MhDC As Long
Private Declare Function CreatePen Lib "gdi32" _
(ByVal nPenStyle As Long, ByVal nWidth As Long, _
ByVal crColor As Long) As Long
Private Declare Function SelectObject Lib "gdi32" _
(ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long
Private Enum PenStyle
PS_SOLID = 0
PS_DASH = 1
PS_DOT = 2
PS_DASHDOT = 3
PS_DASHDOTDOT = 4
End Enum
Private Sub DrawDottedLine(lngStartX, lngStartY, lngEndX, lngEndY)
Dim pt As POINTAPI
Dim rect As rect
Dim hpen As Long
Dim hpenOLD As Long
With rect
.Bottom = 4000
.Left = 0
.Right = 3000
.Top = 0
End With
MhDC = CreateEnhMetaFile(0, "C:\MyFolder\MyFile.emf", rect, _
"Draw Glass" & vbNullChar & _
"and save as EMH file" & vbNullChar & vbNullChar)
If MhDC = 0 Then
MsgBox "Error creating metafile."
Exit Sub
End If
Dim hMF As Long
hpen = CreatePen(PS_DOT, 1, vbBlack)
hpenOLD = SelectObject(MhDC, hpen)
MoveToEx MhDC, lngStartX, lngStartY, pt
LineTo MhDC, lngEndX, lngEndY
hMF = CloseEnhMetaFile(MhDC)
DeleteEnhMetaFile hMF
End Sub
Private Sub PlayEMF()
Dim hemf
Dim re As rect
hemf = GetEnhMetaFile("C:\MyFolder\MyFile.emf&quot
Printer.ScaleMode = vbPixels
re.Left = Printer.ScaleLeft + Printer.ScaleWidth / 4
re.Top = Printer.ScaleTop + Printer.ScaleHeight / 4
re.Right = Printer.ScaleLeft + 3 * Printer.ScaleWidth / 4
re.Bottom = Printer.ScaleTop + 3 * Printer.ScaleHeight / 4
Printer.Print ""
PlayEnhMetaFile Printer.hdc, hemf, re
Printer.EndDoc
DeleteEnhMetaFile hemf
End Sub

 

[strongm]

Ah - I think I may have figured this one out. I think it is a limitation of the PS_DOT style. MSDN has this to say:

[tt]This style is valid only when the pen width is one or less in device units[/tt]

I suspect that scaling between different devices is causing the problem. So try changing
[tt]
hPen = CreatePen(PS_DOT, 1, vbBlack)
[/tt]
to
[tt]
hPen = CreatePen(PS_DOT, 0, vbBlack)

 

[DrJavaJoe]

It works.

Once the PlayEnhMetaFile duplicated the problem my focus was back on the CreatePen, I even noticed the limitation must be one or less but did not even think to set it to 0. Thank you very much.

 

[DrJavaJoe]

strongm, with the Width Property set to 0 the dotted line is only single pixel wide. Any ideas how to make it a little wider?

 

[strongm]

Yep, that's a the documented limitation with what you are using: a cosmetic pen. If you want to work around this you need to use a geometric pen (warning: they are not generally supported in W95/98/Me). To use a geometric pen use the ExtCreatePen API call rather than CreatePen (and since yu've shifted to enhanced metafiles all should be well). Note that geometric pens are a little slower to render than cosmetic pens

 

[DrJavaJoe]

The ExtCreatePen API is just what the doctor ordered. I'll just check the operating system prior to calling it and if W95/98/Me do something else. Thanks again.