?? cmultipgpreview.cls
字號:
FontName = xFontname
ForeColor = xForeColor
End Sub
Public Sub p15Space()
Dim eFont As Integer
Dim hFont As Integer
pPrint
eFont = FontSize
hFont = eFont \ 2
FontSize = hFont
pPrint
FontSize = eFont
End Sub
Public Sub pFooter(Optional FooterText As String = vbNullString)
Dim eFontS As Integer
Dim eFontN As String
Dim eFontB As Boolean
Dim eFontI As Boolean
Dim eFontU As Boolean
Dim eFontK As Boolean
Dim tMargin As Single
Select Case oScaleMode
Case vbCentimeters
tMargin = 1.25
Case Else 'vbinches
tMargin = 0.5
End Select
'/* Save current setting
eFontN = FontName
eFontS = FontSize
eFontB = FontBold
eFontI = FontItalic
eFontU = FontUnderline
eFontK = FontStrikethru
'/* Change settings
pFontName
FontSize = 10
FontBold = False
FontItalic = False
FontUnderline = False
FontStrikethru = False
CurrentY = PgHeight - (GetTextHeight * 2)
pLine 0, , 6
If FooterText = vbNullString Then FooterText = "Printed: " & Format(Now, "ddd. mmmm d, yyyy \@ h:mm ampm")
pPrint FooterText, tMargin, True
pRightJust "Pg. " & GetPage, PgWidth - tMargin
'/* Restore setting
FontName = eFontN
FontSize = eFontS
FontBold = eFontB
FontItalic = eFontI
FontUnderline = eFontU
FontStrikethru = eFontK
End Sub
Public Sub pHeader(Optional ByVal MainTitle As String = vbNullString, Optional SubTitle As Variant, Optional ItalicMain As Variant)
Dim eFontS As Integer
Dim eFontN As String
Dim eFontB As Boolean
Dim eFontI As Boolean
Dim eFontU As Boolean
Dim eFontK As Boolean
If MainTitle = vbNullString And oTitleMain = vbNullString Then Exit Sub
'/* Save current setting
eFontN = FontName
eFontS = FontSize
eFontB = FontBold
eFontI = FontItalic
eFontU = FontUnderline
eFontK = FontStrikethru
CurrentY = 0
CurrentX = 0
If MainTitle > vbNullString Then oTitleMain = MainTitle
If Not IsMissing(SubTitle) Then oTitleSub = SubTitle
If Not IsMissing(ItalicMain) Then oTitleItalic = CBool(ItalicMain)
'/* Change settings
pFontName
FontSize = 16
FontBold = True
FontItalic = oTitleItalic
pCenter oTitleMain
FontSize = 11
FontBold = False
FontItalic = False
If oTitleSub > vbNullString Then pCenter oTitleSub
pDoubleLine
pHalfSpace
'/* Restore setting
FontName = eFontN
FontSize = eFontS
FontBold = eFontB
FontItalic = eFontI
FontUnderline = eFontU
FontStrikethru = eFontK
End Sub
Public Sub pBullet(Optional ByVal LeftMargin As Single = -1)
Dim eFontN As String
Dim eFontB As Boolean
Dim eFontI As Boolean
Dim eFontU As Boolean
Dim eFontK As Boolean
If LeftMargin = -1 Then LeftMargin = CurrentX
'/* Save current setting
eFontN = FontName
eFontB = FontBold
eFontI = FontItalic
eFontU = FontUnderline
eFontK = FontStrikethru
'/* Change settings
'FontName = "Wingdings"
FontName = "Symbol"
FontBold = False
FontItalic = False
FontUnderline = False
FontStrikethru = False
'pPrint Chr(164) & " ", LeftMargin, True
pPrint Chr(183) & " ", LeftMargin, True
'/* Restore setting
FontName = eFontN
FontBold = eFontB
FontItalic = eFontI
FontUnderline = eFontU
FontStrikethru = eFontK
End Sub
Public Sub pQuarterSpace()
Dim eFont As Integer
Dim hFont As Integer
eFont = FontSize
hFont = eFont \ 4
If hFont < 1 Then hFont = 1
FontSize = hFont
pPrint
FontSize = eFont
End Sub
Public Sub pDots(ByVal RightMargin As Single, Optional ByVal LeftMargin As Single = 0)
If LeftMargin > 0 Then CurrentX = LeftMargin
If CurrentX >= RightMargin Then Exit Sub
Do
pPrint ".", , True
Loop Until CurrentX >= RightMargin
End Sub
Public Function GetPage() As Variant
If PrintFlag Then
GetPage = Printer.Page
Else
GetPage = PageNumber + 1
End If
End Function
Public Property Get SendToPrinter() As Boolean
SendToPrinter = PrintFlag
End Property
Public Property Let SendToPrinter(ByVal vNewValue As Boolean)
PrintFlag = vNewValue
End Property
Public Function GetPaperHeight() As Single
GetPaperHeight = PgHeight
End Function
Public Function GetPaperWidth() As Single
GetPaperWidth = PgWidth
End Function
Public Property Get CurrentX() As Single
If PrintFlag Then
CurrentX = Printer.CurrentX
Else
CurrentX = ObjPrint.CurrentX
End If
End Property
Public Property Let CurrentX(ByVal NewXvalue As Single)
If PrintFlag Then
Printer.CurrentX = NewXvalue
Else
ObjPrint.CurrentX = NewXvalue
End If
End Property
Public Property Get CurrentY() As Single
If PrintFlag Then
CurrentY = Printer.CurrentY
Else
CurrentY = ObjPrint.CurrentY
End If
End Property
Public Property Let CurrentY(ByVal NewYvalue As Single)
If PrintFlag Then
Printer.CurrentY = NewYvalue
Else
ObjPrint.CurrentY = NewYvalue
End If
End Property
Public Function GetStripQuotes(ByVal TextString As String) As String
If Left(TextString, 1) = Chr(34) Then TextString = Mid(TextString, 2)
If Right(TextString, 1) = Chr(34) Then TextString = Left(TextString, Len(TextString) - 1)
GetStripQuotes = TextString
End Function
Public Property Get Orientation() As PageOrientation
Orientation = oOrientation
End Property
Public Property Let Orientation(ByVal vNewValue As PageOrientation)
On Error Resume Next
Printer.Orientation = vNewValue
oOrientation = vNewValue
End Property
Public Property Get DrawWidth() As Integer
If PrintFlag Then
DrawWidth = Printer.DrawWidth
Else
DrawWidth = ObjPrint.DrawWidth * 2
End If
End Property
Public Property Let DrawWidth(ByVal NewWidth As Integer)
If NewWidth < 1 Then NewWidth = 1
If PrintFlag Then
Printer.DrawWidth = NewWidth
Else
NewWidth = NewWidth / 2
If NewWidth < 1 Then NewWidth = 1
ObjPrint.DrawWidth = NewWidth
End If
End Property
Public Property Get BackColor() As Long
If PrintFlag Then
BackColor = GetBkColor(Printer.hdc)
Else
BackColor = ObjPrint.BackColor
End If
End Property
Public Property Let BackColor(ByVal NewColor As Long)
Dim r As Long
If PrintFlag Then
If NewColor = -1 Then
Call MakeTrans '/* I am not sure why this is necessary
r = SetBkColor(Printer.hdc, vbWhite)
Printer.FontTransparent = True
Else
Printer.FontTransparent = False
r = SetBkColor(Printer.hdc, NewColor)
End If
Else
If NewColor = -1 Then
ObjPrint.FontTransparent = True
r = SetBkColor(ObjPrint.hdc, vbWhite)
Else
ObjPrint.FontTransparent = False
r = SetBkColor(ObjPrint.hdc, NewColor)
End If
End If
End Property
Public Property Get FontName() As String
If PrintFlag Then
FontName = Printer.FontName
Else
FontName = ObjPrint.FontName
End If
End Property
Public Property Let FontName(ByVal NewFont As String)
If PrintFlag Then
Printer.FontName = NewFont
Printer.Print "";
Else
ObjPrint.FontName = NewFont
ObjPrint.Print "";
End If
End Property
Public Function GetTextWidth(TextString As Variant) As Single
If PrintFlag Then
GetTextWidth = Printer.TextWidth(TextString)
Else
GetTextWidth = ObjPrint.TextWidth(TextString)
End If
End Function
Public Function GetTextHeight(Optional TextString As String = "Sample Text") As Single
If PrintFlag Then
GetTextHeight = Printer.TextHeight(TextString)
Else
GetTextHeight = ObjPrint.TextHeight(TextString)
End If
End Function
Public Property Get FontTransparent() As Boolean
If PrintFlag Then
FontTransparent = Printer.FontTransparent
Else
FontTransparent = ObjPrint.FontTransparent
End If
End Property
Public Property Let FontTransparent(ByVal vNewValue As Boolean)
If PrintFlag Then
If vNewValue Then
'/* I am not sure why this is necessary but it doesn't work without it
Call MakeTrans
BackColor = -1
Else
Printer.FontTransparent = False
End If
Else
ObjPrint.FontTransparent = vNewValue
End If
End Property
Private Sub MakeTrans()
Dim X As Single, Y As Single
X = CurrentX
Y = CurrentY
'/* I am not sure why this is necessary
'/* but it doesn't work without it.
Sleep 1
BackColor = vbWhite
Sleep 1
pQuarterSpace
Sleep 1
CurrentX = X
CurrentY = Y
Sleep 1
End Sub
Public Property Get ColorMode() As PrinterColorModeTypes
ColorMode = oColorMode
End Property
Public Property Let ColorMode(ByVal vNewValue As PrinterColorModeTypes)
oColorMode = vNewValue
If PrintFlag Then Printer.ColorMode = vNewValue
End Property
Private Sub Class_Initialize()
ColorMode = cmColor
Orientation = PagePortrait
PrintCopies = 1
SendToPrinter = True
oTitleItalic = True
'/* Default Scale Mode
'vbInches or vbCentimeters
oScaleMode = vbInches
End Sub
Public Property Get ReportTitle() As String
ReportTitle = oTitleMain
End Property
Public Property Let ReportTitle(ByVal vNewValue As String)
oTitleMain = vNewValue
End Property
Public Property Get ReportSubTitle() As String
ReportSubTitle = oTitleSub
End Property
Public Property Let ReportSubTitle(ByVal vNewValue As String)
oTitleSub = vNewValue
End Property
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -