clsrepeats.cls

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

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsRepeats"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit

Private colRepeats As Collection


Public Sub AddPoint(PointArray As Variant, _
                                        Optional ByVal Size As Integer = 1, _
                                        Optional ByVal Color As Long = vbBlack)

Dim p As New clsPointAttributes

    With p
        .PointArray = PointArray
        .Color = Color
        .Size = IIf(Size = 0, 1, Size)
    End With
    
    colRepeats.Add p
End Sub
                                        
Public Sub AddLine(Optional ByVal X1 As Single, _
                                    Optional ByVal Y1 As Single, _
                                    Optional ByVal X2 As Single, _
                                    Optional ByVal Y2 As Single, _
                                    Optional ByVal Size As Integer = 1, _
                                    Optional ByVal Color As Long = vbBlack)

Dim L As New clsLineAttributes

    With L
        .Color = Color
        .Size = IIf(Size = 0, 1, Size)
        .X1 = X1
        .X2 = X2
        .Y1 = Y1
        .Y2 = Y2
    End With
    
    colRepeats.Add L
End Sub

Public Sub AddLabel(ByVal Caption As String, _
                                        Optional ByVal Left As Single, _
                                        Optional ByVal Top As Single, _
                                        Optional ByVal Right As Single, _
                                        Optional ByVal Bottom As Single, _
                                        Optional ByVal WordWrap As Boolean, _
                                        Optional ByVal Align As TextAlignConstants, _
                                        Optional ByVal ForeColor As Long = vbBlack, _
                                        Optional ByVal FontName As String, _
                                        Optional ByVal FontSize As Single, _
                                        Optional ByVal FontBold As Boolean, _
                                        Optional ByVal FontItalic As Boolean, _
                                        Optional ByVal FontUnderline As Boolean, _
                                        Optional ByVal FontStrikethru As Boolean, _
                                        Optional ByVal BorderWidth As Integer, _
                                        Optional ByVal CellSpacing As Single, _
                                        Optional ByVal BorderColor As Long = vbBlack, _
                                        Optional ByVal FillColor As Long = vbBlack, _
                                        Optional ByVal FillStyle As FillStyleConstants = vbFSTransparent)
                                        
Dim L As New clsLabelAttributes

    With L
        .Align = Align
        .Bottom = Bottom
        .BorderWidth = BorderWidth
        .BorderColor = BorderColor
        .Caption = Caption
        .CellSpacing = CellSpacing
        .FillStyle = FillStyle
        .FillColor = FillColor
        .FontBold = FontBold
        .FontItalic = FontItalic
        .FontName = IIf(FontName = vbNullString, defFontName, FontName)
        .FontSize = IIf(FontSize > 0, FontSize, defFontSize)
        .FontStrikethru = FontStrikethru
        .FontUnderline = FontUnderline
        .ForeColor = ForeColor
        .Left = Left
        .Right = Right
        .Top = Top
        .WordWrap = WordWrap
    End With
    
    colRepeats.Add L
End Sub

Public Sub AddLabelEx(ByVal Caption As String, _
                                            Optional ByVal Left As Single, _
                                            Optional ByVal Top As Single, _
                                            Optional ByVal Right As Single, _
                                            Optional ByVal Bottom As Single, _
                                            Optional ByVal WordWrap As Boolean, _
                                            Optional ByVal Align As TextAlignConstants, _
                                            Optional ByVal ForeColor As Long = vbBlack, _
                                            Optional ByVal Angle As Long, _
                                            Optional ByVal FontName As String, _
                                            Optional ByVal CharHeight As Long, _
                                            Optional ByVal CharWidth As Long, _
                                            Optional ByVal CharWeight As Long, _
                                            Optional ByVal FontItalic As Boolean, _
                                            Optional ByVal FontUnderline As Boolean, _
                                            Optional ByVal FontStrikeOut As Boolean, _
                                            Optional ByVal BorderWidth As Integer, _
                                            Optional ByVal CellSpacing As Single, _
                                            Optional ByVal BorderColor As Long = vbBlack, _
                                            Optional ByVal FillColor As Long = vbBlack, _
                                            Optional ByVal FillStyle As FillStyleConstants = vbFSTransparent)

Dim L As New clsLabelExAttributes

    With L
        .Align = Align
        .Angle = Angle
        .Bottom = Bottom
        .BorderWidth = BorderWidth
        .BorderColor = BorderColor
        .Caption = Caption
        .CellSpacing = CellSpacing
        .FillColor = FillColor
        .FillStyle = FillStyle
        .FontItalic = FontItalic
        .FontName = IIf(FontName = vbNullString, defFontName, FontName)
        .CharHeight = CharHeight
        .CharWeight = CharWeight
        .CharWidth = CharWidth
        .FontStrikeOut = FontStrikeOut
        .FontUnderline = FontUnderline
        .ForeColor = ForeColor
        .Left = Left
        .Right = Right
        .Top = Top
        .WordWrap = WordWrap
    End With
    
    colRepeats.Add L
End Sub

Public Sub AddImage(ByVal Image As IPictureDisp, _
                                        Optional ByVal Left As Single, _
                                        Optional ByVal Top As Single, _
                                        Optional ByVal Width, _
                                        Optional ByVal Height)

Dim i As New clsImageAttributes

    With i
        Set .Image = Image
        .Left = Left
        .Top = Top
        .Width = Width
        .Height = Height
    End With
    
    colRepeats.Add i
End Sub

Public Sub AddRectangle(Optional ByVal BorderColor As Long = vbBlack, _
                                                Optional ByVal BorderWidth As Integer = 1, _
                                                Optional ByVal Left As Single, _
                                                Optional ByVal Top As Single, _
                                                Optional ByVal Right As Single, _
                                                Optional ByVal Bottom As Single, _
                                                Optional ByVal FillColor As Long = vbBlack, _
                                                Optional ByVal FillStyle As FillStyleConstants = vbFSTransparent)

Dim r As New clsRectangleAttributes

    With r
        .BorderColor = BorderColor
        .BorderWidth = IIf(BorderWidth = 0, 1, BorderWidth)
        .Bottom = Bottom
        .FillColor = FillColor
        .FillStyle = FillStyle
        .Left = Left
        .Right = Right
        .Top = Top
    End With
    
    colRepeats.Add r
End Sub

Public Property Get Item(ByVal Index As Integer) As Variant
Attribute Item.VB_UserMemId = 0
    Set Item = colRepeats(Index)
End Property

Public Property Get Count() As Integer
    Count = colRepeats.Count
End Property

Private Sub Class_Initialize()
    Set colRepeats = New Collection
End Sub

Private Sub Class_Terminate()
    Set colRepeats = Nothing
End Sub