cmultipgpreview_withchart.cls

打印预览程序

        Else
            ObjPrint.Print tString
        End If
    End If
    
    
End Sub

Public Function GetRemoveCRLF(ByVal TextString As String) As String
  Dim i As Integer, FoundString As Boolean
  Dim FoundFirst As Boolean
  
    Do
        FoundString = False
        
        i = InStr(TextString, vbCr)
        If i Then
            Mid(TextString, i, 1) = " "
            FoundString = True
            FoundFirst = True
        End If
        
        i = InStr(TextString, vbLf)
        If i = 1 Then
            TextString = Mid(TextString, i + 1)
        ElseIf i > 1 Then
            If FoundFirst Then
                TextString = Mid(TextString, 1, i - 1) & Mid(TextString, i + 1)
            Else
                Mid(TextString, i, 1) = " "
            End If
            FoundString = True
        End If
        FoundFirst = False
        
    Loop Until FoundString = False
    GetRemoveCRLF = TextString
    
End Function

Public Sub pPrintPicture(NewPic As StdPicture, _
                        Optional LeftMargin As Single = -1, _
                        Optional TopMargin As Single = -1, _
                        Optional pWidth As Single = 0, _
                        Optional pHeight As Single = 0, _
                        Optional ScaleToFit As Boolean = False, _
                        Optional MaintainRatio As Boolean = True)
 
  Dim xmin As Single
  Dim ymin As Single
  Dim wid As Single
  Dim hgt As Single
  Dim aspect As Single
  Dim picBox As PictureBox
 
    If pWidth = 0 Then pWidth = pHeight
    If pHeight = 0 Then pHeight = pWidth
    If pWidth = 0 And pHeight = 0 Then ScaleToFit = True
    
    If PrintFlag Then
        Load frmMultiPgPreview
        Set picBox = frmMultiPgPreview.picPrintPic
        picBox.Picture = NewPic
        
        aspect = picBox.ScaleHeight / picBox.ScaleWidth
        If ScaleToFit Then
            wid = Printer.ScaleWidth
            hgt = Printer.ScaleHeight
        Else
            wid = pWidth
            hgt = pHeight
        End If
        
        If MaintainRatio Then
            If hgt / wid > aspect Then
                hgt = aspect * wid
                If LeftMargin = -1 Then
                    xmin = Printer.ScaleLeft
                Else
                    xmin = LeftMargin
                End If
                If TopMargin = -1 Then
                    ymin = (Printer.ScaleHeight - hgt) / 2
                Else
                    ymin = TopMargin
                End If
            Else
                wid = hgt / aspect
                If LeftMargin = -1 Then
                    xmin = (Printer.ScaleWidth - wid) / 2
                Else
                    xmin = LeftMargin
                End If
                If TopMargin = -1 Then
                    ymin = Printer.ScaleTop
                Else
                    ymin = TopMargin
                End If
            End If
        Else
            If LeftMargin = -1 Then
                xmin = Printer.ScaleLeft
            Else
                xmin = LeftMargin
            End If
            If TopMargin = -1 Then
                ymin = (Printer.ScaleHeight - hgt) / 2
            Else
                ymin = TopMargin
            End If
        End If
        
        Printer.PaintPicture picBox.Picture, xmin, ymin, wid, hgt
        Unload frmMultiPgPreview
        
    Else
        
        Set picBox = frmMultiPgPreview.picPrintPic
        picBox.Picture = NewPic
        
        aspect = picBox.ScaleHeight / picBox.ScaleWidth
        If ScaleToFit Then
            wid = ObjPrint.ScaleWidth
            hgt = ObjPrint.ScaleHeight
        Else
            wid = pWidth
            hgt = pHeight
        End If
        
        If MaintainRatio Then
            If hgt / wid > aspect Then
                hgt = aspect * wid
                If LeftMargin = -1 Then
                    xmin = ObjPrint.ScaleLeft
                Else
                    xmin = LeftMargin
                End If
                If TopMargin = -1 Then
                    ymin = (ObjPrint.ScaleHeight - hgt) / 2
                Else
                    ymin = TopMargin
                End If
            Else
                wid = hgt / aspect
                If LeftMargin = -1 Then
                    xmin = (ObjPrint.ScaleWidth - wid) / 2
                Else
                    xmin = LeftMargin
                End If
                If TopMargin = -1 Then
                    ymin = ObjPrint.ScaleTop
                Else
                    ymin = TopMargin
                End If
            End If
        Else
            If LeftMargin = -1 Then
                xmin = ObjPrint.ScaleLeft
            Else
                xmin = LeftMargin
            End If
            If TopMargin = -1 Then
                ymin = (ObjPrint.ScaleHeight - hgt) / 2
            Else
                ymin = TopMargin
            End If
        End If
        
        ObjPrint.PaintPicture picBox.Picture, xmin, ymin, wid, hgt
        picBox.Picture = Nothing
        
    End If
    
    Set picBox = Nothing
    
End Sub

Public Property Let FontStrikethru(YesNo As Boolean)
    If PrintFlag Then
        Printer.FontStrikethru = YesNo
    Else
        ObjPrint.FontStrikethru = YesNo
    End If
End Property

Public Property Get FontStrikethru() As Boolean
    If PrintFlag Then
        FontStrikethru = Printer.FontStrikethru
    Else
        FontStrikethru = ObjPrint.FontStrikethru
    End If
End Property

Public Function GetFormalCase(ByVal TextString As String) As String
  Dim x As Integer
 
    '/* Cap the first letter if each word
    On Local Error Resume Next
    
    TextString = UCase$(Left$(TextString, 1)) & LCase$(Mid$(TextString, 2))
    
    '/* Look for space
    x = InStr(TextString, " ")
    If x Then
        Do
            Mid$(TextString, x + 1, 1) = UCase$(Mid$(TextString, x + 1, 1))
            x = x + 1
            x = InStr(x, TextString, " ")
            If x = 0 Or x + 1 > Len(TextString) Then Exit Do
        Loop
    End If
    
    '/* Look for .
    x = InStr(TextString, ".")
    If x Then
        Do
            Mid$(TextString, x + 1, 1) = UCase$(Mid$(TextString, x + 1, 1))
            x = x + 1
            x = InStr(x, TextString, ".")
            If x = 0 Or x + 1 > Len(TextString) Then Exit Do
        Loop
    End If
    
    '/* Look for Mc
    x = InStr(TextString, "Mc")
    If x Then
        Do
            Mid$(TextString, x + 2, 1) = UCase$(Mid$(TextString, x + 2, 1))
            x = x + 2
            x = InStr(x, TextString, "Mc")
            If x = 0 Or x + 2 > Len(TextString) Then Exit Do
        Loop
    End If
    
    '/* Look for O'
    x = InStr(TextString, "O'")
    If x Then
        Do
            Mid$(TextString, x + 2, 1) = UCase$(Mid$(TextString, x + 2, 1))
            x = x + 2
            x = InStr(x, TextString, "O'")
            If x = 0 Or x + 2 > Len(TextString) Then Exit Do
        Loop
    End If
    
    '/* Look for -
    x = InStr(TextString, "-")
    If x Then
       Do
           Mid$(TextString, x + 1, 1) = UCase$(Mid$(TextString, x + 1, 1))
           x = x + 1
           x = InStr(x, TextString, "-")
           If x = 0 Or x + 1 > Len(TextString) Then Exit Do
       Loop
    End If
    
    GetFormalCase = LTrim$(TextString)
 
End Function

Public Sub pRightTab(ByVal PrintVar As Variant, _
                            Optional ByVal xFromRight As Single = 0.1, _
                            Optional SameLine As Boolean = False)
 
    CurrentX = PgWidth - (GetTextWidth(PrintVar) + xFromRight)
    
    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 pCenter(ByVal PrintVar As String, _
                   Optional SameLine As Boolean = False, _
                   Optional ColWidth As Single = -1, _
                   Optional LeftMargin As Single = 0)
        
    If ColWidth = -1 Then ColWidth = PgWidth - LeftMargin
    
    If GetTextWidth(PrintVar) > PgWidth Then
        pCenterMultiline PrintVar, LeftMargin, LeftMargin + ColWidth, , SameLine
    Else
        CurrentX = LeftMargin + ((ColWidth - GetTextWidth(PrintVar)) / 2)
        pPrint PrintVar, , SameLine
    End If
    
End Sub

Public Sub pRightJust(ByVal PrintVar As Variant, _
                      Optional ByVal RightMargin As Single = -1, _
                      Optional SameLine As Boolean = False)
  
  Dim TxtWidth As Single
  
    TxtWidth = GetTextWidth(PrintVar)
    If RightMargin = -1 Then RightMargin = CurrentX + TxtWidth
    CurrentX = RightMargin - TxtWidth
    
    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 pBox(Optional ByVal bLeft As Single = -1, _
                Optional ByVal bTop As Single = -1, _
                Optional ByVal bWidth As Single = -1, _
                Optional ByVal bHeight As Single = -1, _
                Optional ByVal ColorLine As Long = -1, _
                Optional ByVal ColorFill As Long = -1, _
                Optional FilledBox As FillStyleConstants = vbFSTransparent)
   
  Dim x As Single, y As Single
  
    y = CurrentY
    x = CurrentX
    
    If ColorLine = -1 Then ColorLine = ForeColor
    If ColorFill = -1 Then ColorFill = ColorLine
    If bLeft = -1 Then bLeft = CurrentX
    If bTop = -1 Then bTop = CurrentY
    If bWidth = -1 Then bWidth = PgWidth
    If bHeight = -1 Then bHeight = GetTextHeight
    
    If FilledBox <> vbFSTransparent Then
        If PrintFlag Then
            Printer.FillColor = ColorFill
            Printer.FillStyle = FilledBox
            Printer.Line (bLeft, bTop)-(bLeft + bWidth, bTop + bHeight), ColorLine, B
            Printer.FillStyle = vbFSTransparent
        Else
            ObjPrint.FillColor = ColorFill
            ObjPrint.FillStyle = FilledBox
            ObjPrint.Line (bLeft, bTop)-(bLeft + bWidth, bTop + bHeight), ColorLine, B
            ObjPrint.FillStyle = vbFSTransparent
        End If
    Else
        If PrintFlag Then
            Printer.FillStyle = vbFSTransparent
            Printer.Line (bLeft, bTop)-(bLeft + bWidth, bTop + bHeight), ColorLine, B
        Else
            ObjPrint.FillStyle = vbFSTransparent
            ObjPrint.Line (bLeft, bTop)-(bLeft + bWidth, bTop + bHeight), ColorLine, B
        End If
    End If
    
    CurrentX = x
    CurrentY = y
    
End Sub

Public Sub pCircle(ByVal bLeft As Single, _
                   ByVal bTop As Single, _
                   ByVal bRadius As Single, _
                   Optional ByVal ColorLine As Long = -1, _
                   Optional ByVal ColorFill As Long = -1, _
                   Optional FilledCircle As FillStyleConstants = vbFSTransparent, _
                   Optional AspectRatio As Single = 1)
                   
    If ColorLine = -1 Then ColorLine = ForeColor
    If ColorFill = -1 Then ColorFill = ColorLine
    
    If PrintFlag Then
        If FilledCircle <> vbFSTransparent Then
            Printer.FillStyle = FilledCircle
            Printer.FillColor = ColorFill
        End If
        
        Printer.Circle (bLeft, bTop), bRadius, ColorLine, , , AspectRatio
        
        Printer.FillStyle = vbFSTransparent
    Else
        If FilledCircle <> vbFSTransparent Then
            ObjPrint.FillStyle = FilledCircle
            ObjPrint.FillColor = ColorFill
        End If
        
        ObjPrint.Circle (bLeft, bTop), bRadius, ColorLine, , , AspectRatio
        
        ObjPrint.FillStyle = vbFSTransparent
    End If
    
End Sub

Public Sub pEndDoc(Optional oModal As Byte = 1, Optional OwnerForm As Form)
  Dim i As Integer