clsprint.cls

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

                                    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

                        Align = .Align
                        If .WordWrap Then Align = Align Or DT_WORDBREAK

                        Set CnLabelA = New clsLabelAttributes
                        CnLabelA.Align = Align
                        CnLabelA.BorderColor = .BorderColor
                        CnLabelA.BorderWidth = Abs(Int(-(.BorderWidth / 10) * sngLineWidthCoefficient))
                        CnLabelA.Caption = .Caption
                        CnLabelA.CellSpacing = .CellSpacing
                        CnLabelA.FillColor = .FillColor
                        CnLabelA.FillStyle = .FillStyle
                        CnLabelA.FontBold = .FontBold
                        CnLabelA.FontItalic = .FontItalic
                        CnLabelA.FontName = .FontName
                        CnLabelA.FontSize = .FontSize
                        CnLabelA.FontStrikethru = .FontStrikethru
                        CnLabelA.FontUnderline = .FontUnderline
                        CnLabelA.ForeColor = .ForeColor
                        CnLabelA.Left = x1_
                        CnLabelA.Top = y1_
                        CnLabelA.Right = x2_
                        CnLabelA.Bottom = y2_
                    End With

                    colPage(intCurrentPage).Add CnLabelA
                    Set CnLabelA = Nothing

                    If y1_ > y2_ Then
                        sngCurrentPos = y1_
                    Else
                        sngCurrentPos = y2_
                    End If
                Case objTypeLabelEx
                    Set CLabelExA = LabelsEx(intObjIndex)
                    With CLabelExA
                        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

                        Align = .Align
                        If .WordWrap Then Align = Align Or DT_WORDBREAK

                        Set CnLabelExA = New clsLabelExAttributes
                        CnLabelExA.Align = Align
                        CnLabelExA.Angle = .Angle
                        CnLabelExA.BorderColor = .BorderColor
                        CnLabelExA.BorderWidth = Abs(Int(-(.BorderWidth) / 10 * sngLineWidthCoefficient))
                        CnLabelExA.Caption = .Caption
                        CnLabelExA.CellSpacing = .CellSpacing
                        CnLabelExA.CharHeight = .CharHeight * sngLabelExCoefficient
                        CnLabelExA.CharWeight = .CharWeight
                        CnLabelExA.CharWidth = .CharWidth * sngLabelExCoefficient
                        CnLabelExA.FillColor = .FillColor
                        CnLabelExA.FillStyle = .FillStyle
                        CnLabelExA.FontItalic = .FontItalic
                        CnLabelExA.FontName = .FontName
                        CnLabelExA.FontStrikeOut = .FontStrikeOut
                        CnLabelExA.FontUnderline = .FontUnderline
                        CnLabelExA.ForeColor = .ForeColor
                        CnLabelExA.Left = x1_
                        CnLabelExA.Top = y1_
                        CnLabelExA.Right = x2_
                        CnLabelExA.Bottom = y2_
                    End With

                    colPage(intCurrentPage).Add CnLabelExA
                    Set CnLabelExA = Nothing

                    If y1_ > y2_ Then
                        sngCurrentPos = y1_
                    Else
                        sngCurrentPos = y2_
                    End If
                Case objTypeImage
                    Set CImageA = Images(intObjIndex)
                    With CImageA
                        x1_ = .Left + pLeftMargin
                        y1_ = .Top
                        If IsMissing(.Height) Then
                            y2_ = .Image.Height / 100
                        Else
                            y2_ = CSng(.Height)
                        End If
                        If .PositionIsAbsolute Then
                            y1_ = y1_ + pTopMargin
                        Else
                            If sngPageRectBottom < y1_ + sngCurrentPos Then
                                y1_ = y1_ + sngCurrentPos - sngPageRectBottom
                                If sngCurrentPos = pTopMargin Then sngCurrentPos = sngCurrentPos + 1
                                NewPage
                            End If
                            If sngPageRectBottom < y1_ + y2_ + sngCurrentPos Then
                                y1_ = 0
                                If sngCurrentPos = pTopMargin Then sngCurrentPos = sngCurrentPos + 1
                                NewPage
                            End If

                            y1_ = y1_ + sngCurrentPos
                        End If

                        Set CnImageA = New clsImageAttributes
                        Set CnImageA.Image = .Image
                        CnImageA.Left = x1_
                        CnImageA.Top = y1_
                        CnImageA.Width = .Width
                        CnImageA.Height = .Height
                    End With

                    colPage(intCurrentPage).Add CnImageA
                    Set CnImageA = Nothing

                    sngCurrentPos = y1_ + y2_
                Case objTypeTable
                    Set CTableA = Tables(intObjIndex)
                    With CTableA
                        sngTitleHeight = .TitleHeight
                        sngBodyHeight = .BodyHeight
                        FirstRowIsTitle = .FirstRowIsTitle
                        lngTotalColumns = .TotalColumns
                        lngColumnsCount = .Columns.Count - 1
                        intBorderWidth = Abs(Int(-(.BorderWidth / 10) * sngLineWidthCoefficient))
                        If .PositionIsAbsolute Then
                            sngTableTop = pTopMargin + .Top
                        Else
                            sngTableTop = sngCurrentPos + .Top
                        End If

                        TextArray() = .TextArray
                        ReDim TextArrayN(0)

                        ly = LBound(TextArray, 2): uy = UBound(TextArray, 2)
                        lngCurrentRow = 0
                        lngTotalRows = uy - ly + 1
                        lngStartRow = 0: lngEndRow = ly - 1
                        If FirstRowIsTitle Then
                            lngTotalRows = lngTotalRows - 1
                            lngEndRow = lngEndRow + 1
                        End If

                        sngAvailHeight = pPrintableHeight - sngTableTop - pBottomMargin
                        If FirstRowIsTitle Then sngAvailHeight = sngAvailHeight - sngTitleHeight
                        y1_ = 0
                        Row_ = ly

                        Do Until Row_ >= uy
                            lngRowsOnPage = Int(sngAvailHeight / sngBodyHeight)
                            If lngRowsOnPage < 1 Then
                                If sngCurrentPos = pTopMargin Then sngCurrentPos = sngCurrentPos + 1
                                NewPage
                                sngAvailHeight = availHeight
                                If FirstRowIsTitle Then sngAvailHeight = sngAvailHeight - sngTitleHeight
                                sngTableTop = pTopMargin
                                lngRowsOnPage = Int(sngAvailHeight / sngBodyHeight)
                                If lngRowsOnPage = 0 Then lngRowsOnPage = 1
                            End If
                            If lngRowsOnPage * lngTotalColumns >= lngTotalRows - lngCurrentRow Then
                                lngRowsOnPage = Abs(Int(-(lngTotalRows - lngCurrentRow) / lngTotalColumns))
                                Do While lngRowsOnPage * (lngTotalColumns - 1) >= lngTotalRows - lngCurrentRow
                                    lngTotalColumns = lngTotalColumns - 1
                                Loop
                            End If

                            lngStartRow = lngEndRow + 1
                            If lngStartRow > uy Then Exit Do
                            lngEndRow = lngEndRow + lngRowsOnPage * lngTotalColumns
                            If lngEndRow > uy Then
                                lngEndRow = uy
                            End If
                            lngCurrentRow = lngCurrentRow + lngEndRow - lngStartRow + 1

                            ReDim TextArrayN(1 To lngColumnsCount + 1, 1 To lngEndRow - lngStartRow + 1 + IIf(FirstRowIsTitle, 1, 0))

                            j = 1
                            If FirstRowIsTitle Then
                                For Col_ = 1 To lngColumnsCount + 1
                                    TextArrayN(Col_, j) = TextArray(Col_, j)
                                Next Col_
                                j = j + 1
                            End If

                            For k = lngStartRow To lngEndRow
                                For Col_ = 1 To lngColumnsCount + 1
                                    TextArrayN(Col_, j) = TextArray(Col_, k)
                                Next Col_
                                j = j + 1
                            Next k

                            sngAvailHeight = 0
                            Row_ = lngEndRow
                            If UBound(TextArrayN()) > 0 Then
                                Set CnTableA = New clsTableAttributes
                                CnTableA.FirstRowIsTitle = FirstRowIsTitle
                                CnTableA.Left = .Left + pLeftMargin

                                CnTableA.TitleHeight = sngTitleHeight
                                CnTableA.TitleForeColor = .TitleForeColor
                                CnTableA.TitleFontName = .TitleFontName
                                CnTableA.TitleFontSize = .TitleFontSize
                                CnTableA.TitleFontBold = .TitleFontBold
                                CnTableA.TitleFontItalic = .TitleFontItalic
                                CnTableA.TitleFontUnderline = .TitleFontUnderline
                                CnTableA.TitleFontStrikethru = .TitleFontStrikethru
                                CnTableA.TitleWordWrap = .TitleWordWrap

                                CnTableA.BodyHeight = sngBodyHeight
                                CnTableA.BodyForeColor = .BodyForeColor
                                CnTableA.BodyFontName = .BodyFontName
                                CnTableA.BodyFontSize = .BodyFontSize
                                CnTableA.BodyFontBold = .BodyFontBold
                                CnTableA.BodyFontItalic = .BodyFontItalic
                                CnTableA.BodyFontUnderline = .BodyFontUnderline
                                CnTableA.BodyFontStrikethru = .BodyFontStrikethru
                                CnTableA.BodyWordWrap = .BodyWordWrap

                                CnTableA.TotalColumns = lngTotalColumns
                                CnTableA.ColumnSpacing = .ColumnSpacing
                                CnTableA.CellSpacing = .CellSpacing
                                CnTableA.BorderWidth = intBorderWidth
                                CnTableA.BorderColor = .BorderColor

                                For j = 1 To lngColumnsCount
                                    With .Columns(j)
                                        CnTableA.Columns.Add .ColumnWidth, .TitleAlign, .BodyAlign
                                    End With
                                Next j
                                CnTableA.Columns.Add

                                CnTableA.Top = sngTableTop
                                CnTableA.TextArray = TextArrayN

                                colPage(intCurrentPage).Add CnTableA
                                Set CnTableA = Nothing
                            End If
                        Loop
                    End With

                    sngCurrentPos = sngTableTop + lngRowsOnPage * sngBodyHeight
                    If FirstRowIsTitle Then sngCurrentPos = sngCurrentPos + sngTitleHeight
                Case objTypePageBreak
                    NewPage
            End Select
        Next i

        If blnViewPaginateStatus Then Unload frmPaginateStatus
    Else
        Err.Raise 18, , "There is no job for print, before you must create a job."
    End If
End Sub

Private Sub NewPage()
    If sngCurrentPos > pTopMargin Then
        sngCurrentPos = pTopMargin

        intCurrentPage = intCurrentPage + 1
        If blnViewPaginateStatus Then
            frmPaginateStatus.lblStatus.Caption = "Page: " & CStr(intCurrentPage)
            frmPaginateStatus.lblStatus.Refresh
        End If

        ReDim Preserve colPage(1 To intCurrentPage)
        Set colPage(intCurrentPage) = New Collection
    End If
End Sub

Private Sub InitLineWidthCoefficient(hDC As Long)
    sngLabelExCoefficient = GetDeviceCaps(hDC, LOGPIXELSY) / 72
    sngLineWidthCoefficient = GetDeviceCaps(hDC, LOGPIXELSX) / 25.4
End Sub