?? cmultipgpreview.cls
字號:
FontSize = ObjPrint.FontSize
End If
End Property
Public Property Let ForeColor(NewColor As Long)
If PrintFlag Then
Printer.ForeColor = NewColor
Else
ObjPrint.ForeColor = NewColor
End If
End Property
Public Property Get ForeColor() As Long
If PrintFlag Then
ForeColor = Printer.ForeColor
Else
ForeColor = ObjPrint.ForeColor
End If
End Property
Public Sub pLine(Optional ByVal LeftMargin As Single = -1, _
Optional ByVal RightMargin As Single = -1, _
Optional ByVal LineWidth As Integer = 1, _
Optional IncludeSpace As Boolean = True)
Dim eDrawWidth As Integer, cY As Single, cX As Single
Select Case oScaleMode
Case vbCentimeters
cY = 0.07
Case Else 'vbinches
cY = 0.03
End Select
If LeftMargin = -1 Then LeftMargin = CurrentX
If IncludeSpace Then CurrentY = CurrentY + cY
If LineWidth > 0 Then
eDrawWidth = DrawWidth
DrawWidth = LineWidth
End If
If PrintFlag Then
cX = Printer.CurrentX
If RightMargin <= LeftMargin Then RightMargin = PgWidth
Printer.Line (LeftMargin, Printer.CurrentY)-(RightMargin, Printer.CurrentY)
Printer.CurrentX = cX
Else
cX = ObjPrint.CurrentX
If RightMargin <= LeftMargin Then RightMargin = PgWidth
ObjPrint.Line (LeftMargin, ObjPrint.CurrentY)-(RightMargin, ObjPrint.CurrentY)
ObjPrint.CurrentX = cX
End If
If LineWidth > 0 Then DrawWidth = eDrawWidth
If IncludeSpace Then CurrentY = CurrentY + cY
End Sub
Public Sub pNewPage()
On Local Error Resume Next
If PrintFlag Then
Printer.NewPage
Else
SavePicture ObjPrint.Image, TempDir & "PPview" & CStr(PageNumber) & ".bmp"
ObjPrint.Cls
PageNumber = PageNumber + 1
End If
End Sub
Public Sub pPrint(Optional ByVal PrintVar As String = vbNullString, _
Optional ByVal LeftMargin As Single = -1, _
Optional SameLine As Boolean = False)
If PrintVar = vbNullString Then
'/* Empty String */
Else
If LeftMargin = -1 Then LeftMargin = CurrentX
If (GetTextWidth(PrintVar) + LeftMargin > PgWidth) Or _
InStr(PrintVar, vbCr) Or InStr(PrintVar, vbLf) Then
pMultiline PrintVar, LeftMargin, PgWidth - 0.1, , SameLine
Exit Sub
End If
End If
If LeftMargin >= 0 Then CurrentX = LeftMargin
If SameLine Then
If PrintFlag Then
Printer.Print PrintVar;
Else
ObjPrint.Print PrintVar;
End If
Else
If PrintFlag Then
Printer.Print PrintVar
Else
ObjPrint.Print PrintVar
End If
End If
End Sub
Public Sub pPrintedDate(Optional PrintCentered As Boolean = False, _
Optional ByVal LeftMargin As Single = -1, _
Optional SameLine As Boolean = False)
Dim PrintVar As String
Dim FSize As Integer, FBold As Boolean, FItalic As Boolean
Dim FUnderline As Boolean, FStrikethru As Boolean
FSize = FontSize
FBold = FontBold
FItalic = FontItalic
FUnderline = FontUnderline
FStrikethru = FontStrikethru
FontSize = 9
FontBold = False
FontUnderline = False
FontItalic = False
FontStrikethru = False
PrintVar = "Printed: " & Format(Now, "ddd. mmm. d, yyyy \@ h:mm ampm")
If PrintCentered Then
pCenter PrintVar, SameLine
Else
pPrint PrintVar, LeftMargin, SameLine
End If
FontSize = FSize
FontBold = FBold
FontItalic = FItalic
FontUnderline = FUnderline
FontStrikethru = FStrikethru
End Sub
Public Sub pStartDoc()
PageNumber = 0
TempDir = Environ("TEMP") & "\"
On Local Error Resume Next
'/* Set the Printer's scale mode
pSM = Printer.ScaleMode
Printer.ScaleMode = oScaleMode
'/* Get the physical printable area
PgWidth = Printer.ScaleWidth
PgHeight = Printer.ScaleHeight
If PrintFlag Then
'/* Initialize printer
Printer.Print "";
Else
'/* Initialize the preview object
Load frmMultiPgPreview
Set ObjPrint = frmMultiPgPreview!Picture1
'/* Scale Object to Printer's printable area
oSM = ObjPrint.ScaleMode
ObjPrint.ScaleMode = oScaleMode
'/* Full Page size (1440 twips = 1 inch or 567 twips = 1 centimeter)
Select Case oScaleMode
Case vbCentimeters
ObjPrint.Width = (PgWidth + 0.6) * 567
ObjPrint.Height = (PgHeight + 0.6) * 567
Case Else 'vbinches
ObjPrint.Width = (PgWidth + 0.25) * 1440
ObjPrint.Height = (PgHeight + 0.25) * 1440
End Select
'/* Set default properties of the scroll bars
frmMultiPgPreview!VScroll1.Max = Val(ObjPrint.Height * 0.5)
frmMultiPgPreview!VScroll1.Min = -500
frmMultiPgPreview!VScroll1.SmallChange = Val(frmMultiPgPreview!VScroll1.Max * 0.1)
frmMultiPgPreview!VScroll1.LargeChange = Val(frmMultiPgPreview!VScroll1.Max * 0.5)
frmMultiPgPreview!HScroll1.Max = Val(ObjPrint.Width * 0.25)
frmMultiPgPreview!HScroll1.Min = -500
frmMultiPgPreview!HScroll1.SmallChange = Val(frmMultiPgPreview!HScroll1.Max * 0.1)
frmMultiPgPreview!HScroll1.LargeChange = Val(frmMultiPgPreview!HScroll1.Max * 0.5)
'/* Set default properties of the object to match printer
ObjPrint.Scale (0, 0)-(PgWidth, PgHeight)
ObjPrint.FontName = Printer.FontName
ObjPrint.FontSize = Printer.FontSize
ObjPrint.ForeColor = Printer.ForeColor
ObjPrint.Picture = Nothing
End If
End Sub
Public Property Let FontBold(YesNo As Boolean)
If PrintFlag Then
Printer.FontBold = YesNo
Else
ObjPrint.FontBold = YesNo
End If
End Property
Public Property Get FontBold() As Boolean
If PrintFlag Then
FontBold = Printer.FontBold
Else
FontBold = ObjPrint.FontBold
End If
End Property
Public Property Let FontItalic(YesNo As Boolean)
If PrintFlag Then
Printer.FontItalic = YesNo
Else
ObjPrint.FontItalic = YesNo
End If
End Property
Public Property Get FontItalic() As Boolean
If PrintFlag Then
FontItalic = Printer.FontItalic
Else
FontItalic = ObjPrint.FontItalic
End If
End Property
Public Function pEndOfPage(Optional ByVal Less As Single = 0, Optional SaveRoomForFooter As Boolean = True) As Boolean
Dim n As Single
Dim fTextHeight As Single
Dim eFontSize As Integer
If PrintFlag Then
'/* Make sure there is room for the footer
fTextHeight = Printer.TextHeight("TextString")
If SaveRoomForFooter Then
eFontSize = Printer.FontSize
Printer.FontSize = 10
fTextHeight = Printer.TextHeight("TextString") * 2
Printer.FontSize = eFontSize
End If
n = Printer.CurrentY + Printer.TextHeight("TextString") + fTextHeight + Less
Else
'/* Make sure there is room for the footer
fTextHeight = ObjPrint.TextHeight("TextString")
If SaveRoomForFooter Then
eFontSize = ObjPrint.FontSize
ObjPrint.FontSize = 10
fTextHeight = ObjPrint.TextHeight("TextString") * 2
ObjPrint.FontSize = eFontSize
End If
n = ObjPrint.CurrentY + ObjPrint.TextHeight("TextString") + fTextHeight + Less
End If
If n >= PgHeight Then
pEndOfPage = True
Else
pEndOfPage = False
End If
End Function
Public Property Let FontUnderline(YesNo As Boolean)
If PrintFlag Then
Printer.FontUnderline = YesNo
Else
ObjPrint.FontUnderline = YesNo
End If
End Property
Public Property Get FontUnderline() As Boolean
If PrintFlag Then
FontUnderline = Printer.FontUnderline
Else
FontUnderline = ObjPrint.FontUnderline
End If
End Property
Public Sub pHalfSpace()
Dim eFont As Integer
Dim hFont As Integer
eFont = FontSize
hFont = eFont \ 2
If hFont < 1 Then hFont = 1
FontSize = hFont
pPrint
FontSize = eFont
End Sub
Public Sub pDoubleLine(Optional ByVal LeftPos As Single = 0, _
Optional ByVal RightPos As Single = -1, _
Optional ByVal LineWidth As Integer = 1, _
Optional IncludeSpace As Boolean = True)
Dim eFont As Integer, eDrawWidth As Integer
Dim cY As Single, cX As Single
cX = CurrentX
Select Case oScaleMode
Case vbCentimeters
cY = 0.07
Case Else 'vbinches
cY = 0.03
End Select
eDrawWidth = DrawWidth
If LineWidth > 0 Then DrawWidth = LineWidth
'If IncludeSpace Then CurrentY = CurrentY + cY
If PrintFlag Then
cX = Printer.CurrentX
If RightPos <= LeftPos Then RightPos = PgWidth
Printer.CurrentY = Printer.CurrentY + cY
Printer.Line (LeftPos, Printer.CurrentY)-(RightPos, Printer.CurrentY)
Printer.CurrentY = Printer.CurrentY + cY
Printer.Line (LeftPos, Printer.CurrentY)-(RightPos, Printer.CurrentY)
Printer.CurrentY = Printer.CurrentY + cY
Printer.CurrentX = cX
Else
cX = ObjPrint.CurrentX
If RightPos <= LeftPos Then RightPos = PgWidth
ObjPrint.CurrentY = ObjPrint.CurrentY + cY
ObjPrint.Line (LeftPos, ObjPrint.CurrentY)-(RightPos, ObjPrint.CurrentY)
ObjPrint.CurrentY = ObjPrint.CurrentY + cY
ObjPrint.Line (LeftPos, ObjPrint.CurrentY)-(RightPos, ObjPrint.CurrentY)
ObjPrint.CurrentY = ObjPrint.CurrentY + cY
ObjPrint.CurrentX = cX
End If
If LineWidth > 0 Then DrawWidth = eDrawWidth
If IncludeSpace Then CurrentY = CurrentY + cY
End Sub
Public Sub pVerticalLine(Optional ByVal LeftPos As Single = -1, _
Optional ByVal TopPos As Single = -1, _
Optional ByVal BottomPos As Single = -1, _
Optional ByVal LineWidth As Integer = 0)
Dim eDrawWidth As Integer, cY As Single, cX As Single, tH As Single
Dim eFontSize As Integer
eDrawWidth = DrawWidth
cX = CurrentX
cY = CurrentY
If LineWidth > 0 Then DrawWidth = LineWidth
If BottomPos = -1 Then
eFontSize = FontSize
FontSize = 10
BottomPos = PgHeight - (GetTextHeight * 2)
FontSize = eFontSize
End If
If LeftPos = -1 Then LeftPos = CurrentX
If LeftPos > PgWidth Then LeftPos = PgWidth - 0.01
If TopPos = -1 Then TopPos = CurrentY
If PrintFlag Then
Printer.Line (LeftPos, TopPos)-(LeftPos, BottomPos)
Else
ObjPrint.Line (LeftPos, TopPos)-(LeftPos, BottomPos)
End If
CurrentX = cX
CurrentY = cY
If LineWidth > 0 Then DrawWidth = eDrawWidth
End Sub
Public Sub pSpaces(Optional ByVal RightMargin As Single = -1, _
Optional ByVal LeftMargin As Single = -1, _
Optional UseSymbol As Boolean = False)
Dim xFontname As String
Dim xForeColor As Long
Dim tString As String
xFontname = FontName
xForeColor = ForeColor
If LeftMargin <> -1 Then CurrentX = LeftMargin
If RightMargin = -1 Then RightMargin = PgWidth
If UseSymbol Then
FontName = "Symbol"
tString = "\"
ForeColor = vbGreen
Else
tString = " "
End If
If CurrentX >= RightMargin Then GoTo ExitSpaceSub
Do
pPrint tString, , True
Loop Until CurrentX >= RightMargin
ExitSpaceSub:
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -