modprint.bas

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

                With CLabelA
                    x1_ = .Left * Zoom + IndentX
                    y1_ = .Top * Zoom + IndentY
                    x2_ = .Right * Zoom + IndentX
                    y2_ = .Bottom * Zoom + IndentY

                    sngCellSpacing = .CellSpacing * Zoom
                    If .BorderWidth > 0 Then
                        OutputObj.DrawStyle = vbSolid
                        OutputObj.DrawWidth = Abs(Int(-.BorderWidth * Zoom))
                        OutputObj.FillColor = .FillColor
                        OutputObj.FillStyle = .FillStyle
                        OutputObj.Line (x1_, y1_)-(x2_, y2_), .BorderColor, B
                    End If

                    OutputObj.FontBold = .FontBold
                    OutputObj.FontItalic = .FontItalic
                    OutputObj.FontName = .FontName
                    OutputObj.FontSize = .FontSize * Zoom
                    OutputObj.FontStrikethru = .FontStrikethru
                    OutputObj.FontUnderline = .FontUnderline
                    OutputObj.ForeColor = .ForeColor
                    Draw_Text lngDC, .Caption, _
                                        CLng(OutputObj.ScaleX(x1_ + sngCellSpacing, vbMillimeters, vbPixels)), _
                                        CLng(OutputObj.ScaleY(y1_ + sngCellSpacing, vbMillimeters, vbPixels)), _
                                        CLng(OutputObj.ScaleX(x2_ - sngCellSpacing, vbMillimeters, vbPixels)), _
                                        CLng(OutputObj.ScaleY(y2_ - sngCellSpacing, vbMillimeters, vbPixels)), _
                                        .Align
                End With
            Case "clsLabelExAttributes"
                Set CLabelExA = colPage(Page)(i)
                With CLabelExA
                    x1_ = .Left * Zoom + IndentX
                    y1_ = .Top * Zoom + IndentY
                    x2_ = .Right * Zoom + IndentX
                    y2_ = .Bottom * Zoom + IndentY

                    sngCellSpacing = .CellSpacing * Zoom
                    If .BorderWidth > 0 Then
                        OutputObj.DrawStyle = vbSolid
                        OutputObj.DrawWidth = Abs(Int(-.BorderWidth * Zoom))
                        OutputObj.FillColor = .FillColor
                        OutputObj.FillStyle = .FillStyle
                        OutputObj.Line (x1_, y1_)-(x2_, y2_), .BorderColor, B
                    End If

                    lf.lfHeight = .CharHeight * Zoom
                    lf.lfWidth = .CharWidth * Zoom
                    lf.lfEscapement = .Angle
                    lf.lfWeight = .CharWeight
                    lf.lfItalic = Abs(CLng(.FontItalic))
                    lf.lfUnderline = Abs(CLng(.FontUnderline))
                    lf.lfStrikeOut = Abs(CLng(.FontStrikeOut))
                    lf.lfOutPrecision = OUT_DEFAULT_PRECIS
                    lf.lfClipPrecision = OUT_DEFAULT_PRECIS
                    lf.lfQuality = DEFAULT_QUALITY
                    lf.lfPitchAndFamily = DEFAULT_PITCH Or FF_DONTCARE
                    lf.lfCharSet = DEFAULT_CHARSET
                    TempByteArray = StrConv(.FontName & vbNullChar, vbFromUnicode)
                    For j = 0 To UBound(TempByteArray)
                        lf.lfFaceName(j) = TempByteArray(j)
                    Next j
                    FontToUse = CreateFontIndirect(lf)

                    OutputObj.ForeColor = .ForeColor
                    oldFont = SelectObject(lngDC, FontToUse)
                    Draw_Text lngDC, .Caption, _
                                        CLng(OutputObj.ScaleX(x1_ + sngCellSpacing, vbMillimeters, vbPixels)), _
                                        CLng(OutputObj.ScaleY(y1_ + sngCellSpacing, vbMillimeters, vbPixels)), _
                                        CLng(OutputObj.ScaleX(x2_ - sngCellSpacing, vbMillimeters, vbPixels)), _
                                        CLng(OutputObj.ScaleY(y2_ - sngCellSpacing, vbMillimeters, vbPixels)), _
                                        .Align

                    If oldFont <> 0 Then
                        Call SelectObject(lngDC, oldFont)
                        Call DeleteObject(FontToUse)
                        oldFont = 0
                        FontToUse = 0
                    End If
                End With
            Case "clsImageAttributes"
                Set CImageA = colPage(Page)(i)
                With CImageA
                    If IsMissing(.Height) Then
                        y1_ = .Image.Height / 100
                    Else
                        y1_ = CSng(.Height)
                    End If

                    If IsMissing(.Width) Then
                        x1_ = .Image.Width / 100
                    Else
                        x1_ = CSng(.Width)
                    End If

                    OutputObj.PaintPicture .Image, .Left * Zoom + IndentX, .Top * Zoom + IndentY, x1_ * Zoom, y1_ * Zoom
                End With
            Case "clsTableAttributes"
                Set CTableA = colPage(Page)(i)
                With CTableA
                    TextArray() = .TextArray
                    ly = LBound(TextArray, 2): uy = UBound(TextArray, 2)
                    FirstRowIsTitle = .FirstRowIsTitle
                    lngTotalRows = uy - ly + 1
                    lngStartRow = 0: lngEndRow = ly - 1
                    If FirstRowIsTitle Then
                        lngTotalRows = lngTotalRows - 1
                        lngEndRow = lngEndRow + 1
                    End If
                    sngCellSpacing = .CellSpacing * Zoom
                    sngColumnSpacing = .ColumnSpacing * Zoom
                    sngTitleHeight = .TitleHeight * Zoom
                    sngBodyHeight = .BodyHeight * Zoom
                    lngTotalColumns = .TotalColumns
                    lngColumnsCount = .Columns.Count - 1
                    lngBorderColor = .BorderColor
                    intBorderWidth = Abs(Int(-.BorderWidth * Zoom))
                    sngTableTop = .Top * Zoom + IndentY

                    ReDim sngColsWidth(1 To lngColumnsCount)
                    sngTableWidth = 0
                    For j = 1 To lngColumnsCount
                        sngColsWidth(j) = .Columns(j).ColumnWidth * Zoom
                        sngTableWidth = sngTableWidth + sngColsWidth(j)
                    Next j

                    If intBorderWidth > 0 Then
                        OutputObj.DrawStyle = vbSolid
                        OutputObj.DrawWidth = intBorderWidth
                    Else
                        OutputObj.DrawStyle = vbInvisible
                    End If

                    y1_ = 0
                    x2_ = .Left * Zoom + IndentX - sngCellSpacing
'                    If lngTotalColumns = 1 Then x2_ = x2_ - sngCellSpacing
                    x1__ = x2_ + sngCellSpacing
                    y1__ = sngTableTop
                    y2_ = sngTableTop - sngCellSpacing
                    If FirstRowIsTitle Then
                        y1_ = sngTableTop + sngCellSpacing
                        y2_ = y2_ + sngTitleHeight
                        y1__ = y1_ - sngCellSpacing

                        For j = 1 To lngTotalColumns
                            OutputObj.Line (x2_ + sngCellSpacing, y1__)-(x2_ + sngCellSpacing + sngTableWidth, y1__), lngBorderColor

                            strTableLex = Split(TextArray(lngColumnsCount + 1, 1), ",")

                            For Col_ = 1 To lngColumnsCount
                                x1_ = x2_ + 2 * sngCellSpacing
                                x2_ = x2_ + sngColsWidth(Col_)
                                Align = .Columns(Col_).TitleAlign
                                If .TitleWordWrap Then Align = Align Or DT_WORDBREAK
                                OutputObj.FontBold = .TitleFontBold
                                OutputObj.FontItalic = .TitleFontItalic
                                OutputObj.FontName = .TitleFontName
                                OutputObj.FontSize = .TitleFontSize * Zoom
                                OutputObj.FontStrikethru = .TitleFontStrikethru
                                OutputObj.FontUnderline = .TitleFontUnderline
                                OutputObj.ForeColor = .TitleForeColor

                                lngAryIndex = 4 * Col_ - 4
                                If UBound(strTableLex) >= lngAryIndex Then
                                    If Val(strTableLex(lngAryIndex)) = Col_ Then
                                        OutputObj.FillStyle = Val(strTableLex(lngAryIndex + 1))
                                        OutputObj.FillColor = Val(strTableLex(lngAryIndex + 2))
                                        OutputObj.Line (x1_ - sngCellSpacing, y1_ - sngCellSpacing)-(x2_ + sngCellSpacing, y2_ + sngCellSpacing), Val(strTableLex(lngAryIndex + 3)), B
                                    End If
                                End If

                                Draw_Text lngDC, TextArray(Col_, 1), _
                                                    CLng(OutputObj.ScaleX(x1_, vbMillimeters, vbPixels)), _
                                                    CLng(OutputObj.ScaleY(y1_, vbMillimeters, vbPixels)), _
                                                    CLng(OutputObj.ScaleX(x2_, vbMillimeters, vbPixels)), _
                                                    CLng(OutputObj.ScaleY(y2_, vbMillimeters, vbPixels)), _
                                                    Align
                            Next Col_
                            x2_ = x2_ + sngColumnSpacing
                        Next j
                    End If

                    lngRowsOnPage = Abs(Int(-lngTotalRows / lngTotalColumns))

                    x2_ = .Left * Zoom + IndentX - sngCellSpacing
                    For j = 1 To lngTotalColumns
                        lngStartRow = lngEndRow + 1
                        If lngStartRow > uy Then Exit For
                        lngEndRow = lngEndRow + lngRowsOnPage
                        If lngEndRow > uy Then
                            lngEndRow = uy
                        End If

                        For Col_ = 1 To lngColumnsCount
                            x1_ = x2_ + 2 * sngCellSpacing
                            x2_ = x2_ + sngColsWidth(Col_)

                            Align = .Columns(Col_).BodyAlign
                            If .BodyWordWrap Then Align = Align Or DT_WORDBREAK
                            OutputObj.FontBold = .BodyFontBold
                            OutputObj.FontItalic = .BodyFontItalic
                            OutputObj.FontName = .BodyFontName
                            OutputObj.FontSize = .BodyFontSize * Zoom
                            OutputObj.FontStrikethru = .BodyFontStrikethru
                            OutputObj.FontUnderline = .BodyFontUnderline
                            OutputObj.ForeColor = .BodyForeColor

                            For k = lngStartRow To lngEndRow
                                y1_ = y2_ + 2 * sngCellSpacing
                                y2_ = y2_ + sngBodyHeight

                                strTableLex = Split(TextArray(lngColumnsCount + 1, k), ",")
                                lngAryIndex = 4 * Col_ - 4
                                If UBound(strTableLex) >= lngAryIndex Then
                                    If Val(strTableLex(lngAryIndex)) = Col_ Then
                                        OutputObj.FillStyle = Val(strTableLex(lngAryIndex + 1))
                                        OutputObj.FillColor = Val(strTableLex(lngAryIndex + 2))
                                        OutputObj.Line (x1_ - sngCellSpacing, y1_ - sngCellSpacing)-(x2_ + sngCellSpacing, y2_ + sngCellSpacing), Val(strTableLex(lngAryIndex + 3)), B
                                    End If
                                End If

                                Draw_Text lngDC, TextArray(Col_, k), _
                                                    CLng(OutputObj.ScaleX(x1_, vbMillimeters, vbPixels)), _
                                                    CLng(OutputObj.ScaleY(y1_, vbMillimeters, vbPixels)), _
                                                    CLng(OutputObj.ScaleX(x2_, vbMillimeters, vbPixels)), _
                                                    CLng(OutputObj.ScaleY(y2_, vbMillimeters, vbPixels)), _
                                                    Align

                                If Col_ = 1 Then
                                    OutputObj.Line (x1_ - sngCellSpacing, y1_ - sngCellSpacing)-(x1_ - sngCellSpacing + sngTableWidth, y1_ - sngCellSpacing), lngBorderColor
                                End If
                            Next k

                            If Col_ = 1 Then
                                OutputObj.Line (x1_ - sngCellSpacing, y2_ + sngCellSpacing)-(x1_ - sngCellSpacing + sngTableWidth, y2_ + sngCellSpacing), lngBorderColor
                            End If
                            OutputObj.Line (x1_ - sngCellSpacing, y1__)-(x1_ - sngCellSpacing, y2_ + sngCellSpacing), lngBorderColor
                            If Col_ = lngColumnsCount Then
                                OutputObj.Line (x2_ + sngCellSpacing, y1__)-(x2_ + sngCellSpacing, y2_ + sngCellSpacing), lngBorderColor
                            End If
                            y2_ = sngTableTop - sngCellSpacing
                            If FirstRowIsTitle Then y2_ = y2_ + sngTitleHeight
                        Next Col_
                        x2_ = x2_ + sngColumnSpacing
                    Next j
                End With
        End Select
    Next i

    OutputObj.DrawStyle = vbInvisible
    OutputObj.Line (-1, -1)-(sngLeftMargin, sngPH + IndentY), vbWhite, BF
    OutputObj.Line (sngPW - sngRightMargin + IndentX, -1)-(sngPW + 2 * IndentX, sngPH), vbWhite, BF
End Sub

Private Sub Draw_Text(hDC As Long, _
                                           Text As String, _
                                           Left As Long, _
                                           Top As Long, _
                                           Right As Long, _
                                           Bottom As Long, _
                                           Optional Align As TextAlignConstants = DT_LEFT)

Dim OutputRect As RECT

    With OutputRect
        .Top = Top
        .Bottom = Bottom
        .Left = Left
        .Right = Right
    End With
    Call DrawText(hDC, Text, Len(Text), OutputRect, Align)
End Sub

Public Sub SelectText(TxtBox As TextBox)
    On Error Resume Next
    With TxtBox
        .SelStart = 0
        .SelLength = Len(.Text)
    End With
End Sub