clsprint.cls

This application provides much functionality for creating data-driven reports, including preview, gr

Dim hw As Long, f As RECT, t As RECT
Dim ErrNum As Long
Dim intPages As Integer, intStart As Integer, intEnd As Integer, intStep As Integer

    pOwner_hWnd = Owner_hWnd
    blnViewPaginateStatus = False
    Call EnableWindow(pOwner_hWnd, 0)

    On Error GoTo ErrH
    If ShowPrinterWindow Then
        With frmPrint
            .chkCollate.Value = Abs(CInt(Collate))
            .udCopies.Value = pCopies
            .cboRange.ComboItems(pRange + 1).Selected = True
            If pFromPage = 0 Or pToPage = 0 Then
                .optAll.Value = True
                .udFrom.Value = 1
                .udTo.Value = 1
            Else
                .optPages.Value = True
                .udFrom.Value = pFromPage
                .udTo.Value = pToPage
            End If
            hw = .hWnd
            Call GetWindowRect(hw, t)
            Call OffsetRect(t, (Screen.Width / Screen.TwipsPerPixelX - (t.Right - t.Left)) \ 2, _
                                            (Screen.Height / Screen.TwipsPerPixelY - (t.Bottom - t.Top)) \ 2)
            Call DrawAnimatedRects(hw, 3, f, t)
            .Show vbModal
            fPrint = .isPrint
        End With
        Unload frmPrint
    Else
        fPrint = True
    End If

    If fPrint Then
        With Printer
            .ScaleMode = vbMillimeters
            PageChanged pPageSize, pOrientation
            .Copies = IIf(Collate, 1, pCopies)
            .FontTransparent = False
            InitLineWidthCoefficient (.hDC)
        End With
        Paginate
        intPages = UBound(colPage)

        If pFromPage = 0 And pToPage = 0 Then
            intStart = 1
            intEnd = intPages
        Else
            intStart = pFromPage
            intEnd = pToPage
            If intEnd > intPages Then intEnd = intPages
            If intStart > intEnd Then
                CInteraction.ShowMsgBox , "Invalid print range.", , , , , imgExclamationEx, , 1
                GoTo Finally:
            End If
        End If

        For j = 1 To IIf(Collate, pCopies, 1)
            blnKillDoc = False
            frmPrinterStatus.lblPrinter.Caption = Printer.DeviceName
            frmPrinterStatus.Show

            Select Case pRange
                Case OddPages
                    i = intStart
                    If i Mod 2 = 0 Then
                        i = i + 1
                    End If
                    intStep = 2
                Case EvenPages
                    i = intStart
                    If i Mod 2 > 0 Then
                        i = i + 1
                    End If
                    intStep = 2
                Case Else
                    i = intStart
                    intStep = 1
            End Select

            Do Until blnKillDoc Or i > intEnd
                frmPrinterStatus.lblStatus(1).Caption = CStr(i & conSeparator & intPages)
                DoEvents
                SendPage Printer, i
                i = i + intStep
                If i < intEnd Then
                    Printer.NewPage
                End If
            Loop

            If blnKillDoc Then
                Printer.KillDoc
            Else
                Printer.EndDoc
            End If
        Next j
    End If
    GoTo Finally:

ErrH:
    ErrNum = Err.Number
    If ErrNum = 482 Or ErrNum = 484 Then
        CInteraction.ShowMsgBox , "Printer error.", , , , , imgCriticalEx, , 1
    Else
        MsgBox ErrNum & "  " & Err.Description, vbCritical + vbOKOnly, "Printer error"
    End If
    Printer.KillDoc

Finally:
    Unload frmPrinterStatus
    Call EnableWindow(pOwner_hWnd, 1)
    Call SetForegroundWindow(pOwner_hWnd)
End Sub

Private Sub Paginate()
Dim CPointA As clsPointAttributes
Dim CLineA As clsLineAttributes
Dim CLabelA As clsLabelAttributes
Dim CRectangleA As clsRectangleAttributes
Dim CLabelExA As clsLabelExAttributes
Dim CImageA As clsImageAttributes
Dim CTableA As clsTableAttributes

Dim CnPointA As clsPointAttributes
Dim CnLineA As clsLineAttributes
Dim CnLabelA As clsLabelAttributes
Dim CnRectangleA As clsRectangleAttributes
Dim CnLabelExA As clsLabelExAttributes
Dim CnImageA As clsImageAttributes
Dim CnTableA As clsTableAttributes

Dim strTmp As String, sngPageRectBottom As Single
Dim strItem As String, intObj As Integer, intObjIndex As Integer

Dim x1_ As Single, y1_ As Single, x2_ As Single, y2_ As Single
Dim i As Long, j As Long, k As Long, Align As Long, intBorderWidth As Integer

Dim availHeight As Single, sngAvailHeight As Single
Dim TextArray() As String, TextArrayN() As String, sngTableTop As Single, FirstRowIsTitle As Boolean
Dim sngTitleHeight As Single, sngBodyHeight As Single
Dim lngTotalColumns As Long, lngColumnsCount As Long
Dim Row_ As Long, Col_ As Long
Dim lngRowsOnPage As Long, lngTotalRows As Long
Dim lngStartRow As Long, lngEndRow As Long, lngCurrentRow As Long
Dim ly As Long, uy As Long

Dim PointArray() As Single

    If CQueue.Count > 0 Then
        availHeight = pPrintableHeight - pTopMargin - pBottomMargin
        sngPageRectBottom = pTopMargin + availHeight

        sngCurrentPos = pTopMargin + 1
        intCurrentPage = 0
        If blnViewPaginateStatus Then frmPaginateStatus.Show
        NewPage

        For i = 1 To CQueue.Count
            strItem = CQueue(i)
            intObj = Val(Left(strItem, InStr(1, strItem, "/") - 1))
            intObjIndex = Val(Mid(strItem, InStr(1, strItem, "/") + 1))
            Select Case intObj
                Case objTypePoint
                    Set CPointA = Points(intObjIndex)
                    With CPointA
                        PointArray() = .PointArray

                        If .PositionIsAbsolute Then
                            y1_ = pTopMargin
                        Else
                            y1_ = PointArray(2, 1)
                            If sngPageRectBottom < y1_ + sngCurrentPos Then
                                y1_ = sngCurrentPos - sngPageRectBottom + pTopMargin
                                If sngCurrentPos = pTopMargin Then sngCurrentPos = sngCurrentPos + 1
                                NewPage
                            Else
                                y1_ = sngCurrentPos
                            End If
                        End If

                        For j = 1 To UBound(PointArray, 2)
                            PointArray(1, j) = PointArray(1, j) + pLeftMargin
                            PointArray(2, j) = PointArray(2, j) + y1_
                        Next j

                        Set CnPointA = New clsPointAttributes
                        CnPointA.Color = .Color
                        CnPointA.Size = Abs(Int(-(.Size / 10) * sngLineWidthCoefficient))
                        CnPointA.PointArray = PointArray

                        sngCurrentPos = .PointArray(2, 1) + y1_
                    End With

                    colPage(intCurrentPage).Add CnPointA
                    Set CnPointA = Nothing
                Case objTypeLine
                    Set CLineA = Lines(intObjIndex)
                    With CLineA
                        x1_ = .X1 + pLeftMargin
                        y1_ = .Y1
                        x2_ = .X2 + pLeftMargin
                        y2_ = .Y2
                        If .PositionIsAbsolute Then
                            y1_ = y1_ + pTopMargin
                            y2_ = y2_ + pTopMargin
                        Else
                            If y1_ < y2_ Then
                                If sngPageRectBottom < y1_ + sngCurrentPos Then
                                    y1_ = y1_ + sngCurrentPos - sngPageRectBottom
                                    y2_ = y1_ + (.Y2 - .Y1)
                                    If sngCurrentPos = pTopMargin Then sngCurrentPos = sngCurrentPos + 1
                                    NewPage
                                End If
                                If sngPageRectBottom < y2_ + sngCurrentPos Then
                                    y1_ = 0
                                    y2_ = .Y2 - .Y1
                                    If sngCurrentPos = pTopMargin Then sngCurrentPos = sngCurrentPos + 1
                                    NewPage
                                End If
                            Else
                                If sngPageRectBottom < y2_ + sngCurrentPos Then
                                    y2_ = y2_ + sngCurrentPos - sngPageRectBottom
                                    y1_ = y2_ + (.Y1 - .Y2)
                                    If sngCurrentPos = pTopMargin Then sngCurrentPos = sngCurrentPos + 1
                                    NewPage
                                End If
                                If sngPageRectBottom < y1_ + sngCurrentPos Then
                                    y2_ = 0
                                    y1_ = .Y1 - .Y2
                                    If sngCurrentPos = pTopMargin Then sngCurrentPos = sngCurrentPos + 1
                                    NewPage
                                End If
                            End If

                            y1_ = y1_ + sngCurrentPos
                            y2_ = y2_ + sngCurrentPos
                        End If

                        Set CnLineA = New clsLineAttributes
                        CnLineA.Color = .Color
                        CnLineA.Size = Abs(Int(-(.Size / 10) * sngLineWidthCoefficient))
                        CnLineA.X1 = x1_
                        CnLineA.Y1 = y1_
                        CnLineA.X2 = x2_
                        CnLineA.Y2 = y2_
                    End With

                    colPage(intCurrentPage).Add CnLineA
                    Set CnLineA = Nothing

                    If y1_ > y2_ Then
                        sngCurrentPos = y1_
                    Else
                        sngCurrentPos = y2_
                    End If
                Case objTypeRectangle
                    Set CRectangleA = Rectangles(intObjIndex)
                    With CRectangleA
                        x1_ = .Left + pLeftMargin
                        y1_ = .Top
                        x2_ = .Right + pLeftMargin
                        y2_ = .Bottom
                        If .PositionIsAbsolute Then
                            y1_ = y1_ + pTopMargin
                            y2_ = y2_ + pTopMargin
                        Else
                            If y1_ < y2_ Then
                                If sngPageRectBottom < y1_ + sngCurrentPos Then
                                    y1_ = y1_ + sngCurrentPos - sngPageRectBottom
                                    y2_ = y1_ + (.Bottom - .Top)
                                    If sngCurrentPos = pTopMargin Then sngCurrentPos = sngCurrentPos + 1
                                    NewPage
                                End If
                                If sngPageRectBottom < y2_ + sngCurrentPos Then
                                    y1_ = 0
                                    y2_ = .Bottom - .Top
                                    If sngCurrentPos = pTopMargin Then sngCurrentPos = sngCurrentPos + 1
                                    NewPage
                                End If
                            Else
                                If sngPageRectBottom < y2_ + sngCurrentPos Then
                                    y2_ = y2_ + sngCurrentPos - sngPageRectBottom
                                    y1_ = y2_ + (.Top - .Bottom)
                                    If sngCurrentPos = pTopMargin Then sngCurrentPos = sngCurrentPos + 1
                                    NewPage
                                End If
                                If sngPageRectBottom < y1_ + sngCurrentPos Then
                                    y2_ = 0
                                    y1_ = .Top - .Bottom
                                    If sngCurrentPos = pTopMargin Then sngCurrentPos = sngCurrentPos + 1
                                    NewPage
                                End If
                            End If

                            y1_ = y1_ + sngCurrentPos
                            y2_ = y2_ + sngCurrentPos
                        End If

                        Set CnRectangleA = New clsRectangleAttributes
                        CnRectangleA.BorderColor = .BorderColor
                        CnRectangleA.BorderWidth = Abs(Int(-(.BorderWidth / 10) * sngLineWidthCoefficient))
                        CnRectangleA.FillColor = .FillColor
                        CnRectangleA.FillStyle = .FillStyle
                        CnRectangleA.Left = x1_
                        CnRectangleA.Top = y1_
                        CnRectangleA.Right = x2_
                        CnRectangleA.Bottom = y2_
                    End With

                    colPage(intCurrentPage).Add CnRectangleA
                    Set CnRectangleA = Nothing

                    If y1_ > y2_ Then
                        sngCurrentPos = y1_
                    Else
                        sngCurrentPos = y2_
                    End If
                Case objTypeLabel
                    Set CLabelA = Labels(intObjIndex)
                    With CLabelA
                        x1_ = .Left + pLeftMargin
                        y1_ = .Top
                        x2_ = .Right + pLeftMargin
                        y2_ = .Bottom

                        If .PositionIsAbsolute Then
                            y1_ = y1_ + pTopMargin
                            y2_ = y2_ + pTopMargin
                        Else
                            If y1_ < y2_ Then
                                If sngPageRectBottom < y1_ + sngCurrentPos Then
                                    y1_ = y1_ + sngCurrentPos - sngPageRectBottom