第二步、添加两个类，实现该接口，并分别提供Printer对象和Picturebox控件相应的功能。
下面仅以在Picturebox控件上实现该接口的类的部分代码作为示例：还需要添加一个实现预览的窗体（frmPreView），在上面添加一个Picturebox控件（pic）
类名：MyPic
Implements IMyPrinter
Dim frm As frmPreview
Private pic As PictureBox
Private Sub Class_Initialize()
Set frm = New frmPreview
Load frm
Set pic = frm.pic
End Sub
Private Sub Class_Terminate()
Set pic = Nothing
Unload frm
Set frm = Nothing
End Sub
Private Property Let IMyPrinter_CurrentX(ByVal RHS As Single)
pic.CurrentX = RHS
End Property
Private Property Get IMyPrinter_CurrentX() As Single
IMyPrinter_CurrentX = pic.CurrentX
End Property
Private Sub IMyPrinter_EndDoc()
frm.Show vbModal
End Sub
Private Property Get IMyPrinter_Font() As StdFont
Dim F As StdFont
Set F = New StdFont
With pic.Font
F.Size = .Size
F.Name = .Name
F.Size = .Size
F.Bold = .Bold
F.Italic = .Italic
F.Strikethrough = .Strikethrough
F.Underline = .Underline
F.Weight = .Weight
End With
Set IMyPrinter_Font = F
End Property
Private Property Set IMyPrinter_Font(ByVal RHS As StdFont)
With pic.Font
.Size = RHS.Size
.Name = RHS.Name
.Size = RHS.Size
.Bold = RHS.Bold
.Italic = RHS.Italic
.Strikethrough = RHS.Strikethrough
.Underline = RHS.Underline
.Weight = RHS.Weight
End With
End Property
Private Sub IMyPrinter_PLine(ByVal X1 As Single, ByVal Y1 As Single, ByVal X2
As Single, ByVal Y2 As Single, Optional ByVal HasB As Boolean = False, Optional
ByVal HasF As Boolean = False)
If HasF Then "本例中没有提供颜色选项
pic.Line (X1, Y1)-(X2, Y2), , BF
ElseIf HasB Then
pic.Line (X1, Y1)-(X2, Y2), , B
Else
pic.Line (X1, Y1)-(X2, Y2)
End If
End Sub
Private Sub IMyPrinter_PPrint(Optional ByVal F0D1H2 As Integer = 0, Optional PrnInfo
As Variant)
Select Case F0D1H2 ’该参数为0:跟分号;1:跟逗号;2:无符号
Case 0
If Not IsMissing(PrnInfo) Then
pic.Print PrnInfo;
End If
Case 1
If Not IsMissing(PrnInfo) Then
pic.Print PrnInfo,
End If
Case 2
If Not IsMissing(PrnInfo) Then
pic.Print PrnInfo
Else
pic.Print
End If
End Select
End Sub
Private Function IMyPrinter_ScaleX(ByVal Width As Single, Optional ByVal FromScale
As Variant, Optional ByVal ToScale As Variant) As Single
IMyPrinter_ScaleX = pic.ScaleX(Width, FromScale, ToScale)
End Function
Private Function IMyPrinter_TextWidth(ByVal Str As String) As Single
IMyPrinter_TextWidth = pic.TextWidth(Str)
End Function
Private Property Get IMyPrinter_Width() As Long
IMyPrinter_Width = pic.Width
End Property
Private Property Let IMyPrinter_Width(ByVal RHS As Long)
pic.Width = RHS
End Property
