frmtest.frm

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

VERSION 5.00
Begin VB.Form frmTest 
   Caption         =   "Test"
   ClientHeight    =   2610
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   2940
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   2610
   ScaleWidth      =   2940
   Begin VB.CommandButton Command8 
      Caption         =   "Preview"
      Height          =   375
      Left            =   10
      TabIndex        =   2
      Top             =   1440
      Width           =   1755
   End
   Begin VB.CommandButton Command7 
      Caption         =   "Print"
      Height          =   375
      Left            =   10
      TabIndex        =   1
      Top             =   1080
      Width           =   1755
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Create Job 1"
      Height          =   375
      Left            =   10
      TabIndex        =   0
      Top             =   0
      Width           =   1755
   End
End
Attribute VB_Name = "frmTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'
Private Sub Command1_Click()
Dim i As Long, j As Long, k As Single
Dim t As clsTables, c As clsColumns
Dim ta As clsTableAttributes, ca As clsColumnAttributes, la As clsLabelAttributes, ia As clsImageAttributes, linea As clsLineAttributes, ra As clsRectangleAttributes, laex As clsLabelExAttributes, pa As clsPointAttributes
Dim ary() As String, str As String
Dim db As Database, rs As Recordset
Dim sngAry() As Single

NewReport
Set db = OpenDatabase(App.Path & "\others\db1.mdb")
Set rs = db.OpenRecordset("select CompanyName,Country,Fax from tbl", dbOpenSnapshot)

rs.MoveLast
rs.MoveFirst
ReDim ary(1 To 4, 1 To rs.RecordCount + 1)
ary(1, 1) = "Company Name"
ary(2, 1) = "Country"
ary(3, 1) = "Fax"

ary(4, 1) = "1,0," & RGB(220, 220, 220) & "," & vbGreen & ",2,0," & RGB(220, 220, 220) & "," & vbGreen & ",3,0," & RGB(220, 220, 220) & "," & vbGreen

For j = 2 To rs.RecordCount + 1
    For i = 1 To 3
        ary(i, j) = rs.Fields(i - 1) & vbNullString
    Next i
    Randomize i * j
    ary(4, j) = IIf(Rnd > 0.97, 1, 0) & "," & RndNum(7) & "," & RGB(RndNum(255), RndNum(255), RndNum(255)) & "," & vbWhite & "," & _
                      IIf(Rnd > 0.97, 2, 0) & "," & RndNum(7) & "," & RGB(RndNum(255), RndNum(255), RndNum(255)) & "," & vbWhite & "," & _
                      IIf(Rnd > 0.97, 3, 0) & "," & RndNum(7) & "," & RGB(RndNum(255), RndNum(255), RndNum(255)) & "," & vbBlack & ",,,,"
    rs.MoveNext
Next j
With PrinterEx
    .Orientation = OPortrait
    .PageSize = sizeA4
    .BottomMargin = 30
    .LeftMargin = 10
    .RightMargin = 10
    .TopMargin = 30
    With .Repeats
        .AddRectangle vbRed, , , PrinterEx.TopMargin, PrinterEx.PrintableWidth - PrinterEx.LeftMargin - PrinterEx.RightMargin, PrinterEx.PrintableHeight - PrinterEx.BottomMargin, , vbFSTransparent
        .AddLabelEx "sample text", 130, 0, 190, 20, True, , vbYellow, -100, , 10, 10, , , , , 5, 1, vbBlue, , vbFSTransparent
        .AddLabelEx "sample text", 40, 0, 90, 20, True, , vbBlue, -100, , 10, 10, , , , , 5, 1, vbYellow, vbRed, vbDownwardDiagonal
        .AddLabel CStr(Now), 60, 16, 100, 25, , DT_RIGHT, vbRed, "courier", , True, True
        .AddImage LoadPicture(App.Path & "\others\previous.ico"), 100, 260
        .AddLabel "page  &[Page]", 5, 3, 30, 15, , DT_LEFT, vbRed, , 10
        .AddLabel "- &[Page] -", 150, 280, 170, 285, , DT_CENTER
        .AddLabelEx "- &[Page] -", 125, 260, 150, 275, True, , vbBlack, -200, , 10, 10
        .AddLine 0, 260, PrinterEx.PrintableWidth, 260
        .AddRectangle vbMagenta, 2, 50, 261, 65, 270, vbGreen, vbVerticalLine
        .AddLabel "footer", 20, 260, 30, 265, , DT_LEFT
        
        ReDim sngAry(1 To 2, 1 To 1)
        sngAry(1, 1) = 120
        sngAry(2, 1) = 265
        .AddPoint sngAry, 10, vbBlue
    End With

    Set la = .Labels.Add("", 100, 10, 140, 30)
    With la
        .BorderWidth = 5
        .FillStyle = vbDiagonalCross
        .BorderColor = vbWhite
    End With
    
    Set la = .Labels.Add("qrew df fdg d", 5, 2, 30, 10, True)
    la.Align = DT_CENTER
    la.ForeColor = vbGreen
    la.FontSize = 12
    
    Set la = .Labels.Add("aWWWWWa aWWWWWWa", 0, 0, 30, 10, True)
    la.BorderWidth = 5
    la.BorderColor = vbRed
    la.FillStyle = vbCross
    la.FillColor = vbYellow
    la.WordWrap = True
    la.Align = DT_CENTER
    la.ForeColor = vbBlue
    
    Set ia = .Images.Add(LoadPicture(App.Path & "\others\gerb.jpg"), 38, 0)
    
    Set la = .Labels.Add("text on the image", 42, -10, 65, 0)
    la.FontSize = 10
    la.FontBold = True
    la.WordWrap = True
    la.ForeColor = vbRed
    
    Set la = .Labels.Add("sample text" & vbCrLf & "sample text sample text", , , , , True)
    With la
        .BorderWidth = 2
        .BorderColor = vbRed
        .ForeColor = vbGreen
        .FontName = "times"
        .FillStyle = vbFSSolid
        .FillColor = vbYellow
        .Left = 25
        .Top = 2
        .Right = 80
        .Bottom = 7
        .Align = DT_LEFT
        .WordWrap = True
    End With
    
    Set la = .Labels.Add("abc ABC", , 8, 7, 10)
    la.BorderWidth = 1
    la.Align = DT_CENTER
    
    ReDim sngAry(1 To 2, 1 To 1)
    sngAry(1, 1) = 100
    sngAry(2, 1) = 50
    Set pa = .Points.Add(sngAry)
    pa.Size = 20
    pa.Color = vbRed

    Set laex = .LabelsEx.Add("sample text", 20, 5, 90, 75)
    With laex
        .Align = DT_BOTTOM
        .Angle = 500
        .CellSpacing = 2
        .BorderWidth = 2
        .CharHeight = 20
        .CharWidth = 15
        .ForeColor = vbYellow
        .FillColor = vbRed
        .FillStyle = vbHorizontalLine
        .BorderColor = vbCyan
    End With
    
    Set laex = .LabelsEx.Add("sample text", 120, -70, 190, 0)
    With laex
        .Align = DT_BOTTOM
        .Angle = 500
        .CellSpacing = 2
        .BorderWidth = 2
        .CharHeight = 20
        .CharWidth = 15
        .ForeColor = vbBlue
        .BorderColor = vbYellow
    End With
    Set ra = .Rectangles.Add(100, -20, 110, -10)
    ra.FillColor = vbYellow
    ra.BorderWidth = 5
    ra.FillStyle = vbUpwardDiagonal
    ra.BorderColor = vbRed
    Set ra = .Rectangles.Add(130, -10, 140, 0)
    ra.FillColor = vbRed
    ra.FillStyle = vbFSTransparent
    ra.BorderWidth = 5
    ra.BorderColor = vbYellow
    Set ta = .Tables.Add(ary, 1, 20, 2, 1)
    With ta
        .TitleFontBold = True
        .BodyForeColor = vbBlue
        .TitleHeight = 10
        .TitleWordWrap = True
        .FirstRowIsTitle = True
        .BodyWordWrap = True
        .ColumnSpacing = 2
        .TotalColumns = 3
        .BorderColor = vbGreen
        Set ca = .Columns.Add(20, DT_CENTER, DT_LEFT)
        Set ca = .Columns.Add(20, DT_CENTER, DT_LEFT)
        Set ca = .Columns.Add(18, DT_CENTER, DT_RIGHT)
        Set ca = .Columns.Add
    End With
    
    Set linea = .Lines.Add(0, 1, .PrintableWidth, 1)
    linea.Color = vbRed
    linea.Size = 5
    Set linea = .Lines.Add(10, 0.6, .PrintableWidth - 10, 0.6)
    linea.Color = vbBlue
    linea.Size = 2
    Set la = .Labels.Add("ttttew cx", 0, 5, 8, 8)
    la.ForeColor = vbYellow
    .PageBreaks.Add
    Set la = .Labels.Add("Graph Sample", .PrintableWidth \ 2 - 40, 1, .PrintableWidth \ 2 + 20, 16, True)
    la.FontSize = 14
    la.FontBold = True
    la.FontUnderline = True
    la.WordWrap = True
    la.Align = DT_CENTER
    la.ForeColor = vbRed
    Set linea = .Lines.Add(5, 10, 5, 120, True)
    linea.Size = 4
    Set linea = .Lines.Add(5, 10, 5.5, 13, True)
    linea.Size = 4
    Set linea = .Lines.Add(5, 10, 4.5, 13, True)
    linea.Size = 4
    Set linea = .Lines.Add(5, 120, 170, 120, True)
    linea.Size = 4
    Set linea = .Lines.Add(167, 120.5, 170, 120, True)
    linea.Size = 4
    Set linea = .Lines.Add(167, 119.5, 170, 120, True)
    linea.Size = 4
    Set laex = .LabelsEx.Add("payments", 1.5, 12, 4.5, 30, True)
    laex.Angle = 900
    laex.Align = DT_BOTTOM
    laex.CharHeight = 5
    laex.CharWidth = 4
    laex.ForeColor = vbBlue
    Set laex = .LabelsEx.Add("days", 162, 121, 185, 125, True)
    laex.CharHeight = 5
    laex.CharWidth = 4
    laex.ForeColor = vbBlue
    j = 0
    For i = 5 To 160 Step 10
        Set la = .Labels.Add(j, i - 3, 121.5, i + 3, 125, True)
        la.Align = DT_CENTER
        la.ForeColor = vbBlue
        Set linea = .Lines.Add(i, 120, i, 120.6, True)
        Set linea = .Lines.Add(i + 5, 18, i + 5, 120.6, True)
        j = j + 1
    Next i
    For i = 20 To 110 Step 10
        Set linea = .Lines.Add(5, i, 162, i, True)
    Next i
    
    For i = 12 To 152 Step 10
        Randomize i
        j = 19 + Rnd * 100
        Set ra = .Rectangles.Add(i + 0.5, j, i + 5.5, 119.8, True)
        ra.FillColor = RGB(180, 180, 200)
        ra.FillStyle = vbDiagonalCross
        ra.BorderColor = vbBlue
        Set laex = .LabelsEx.Add(120 - j, i, j - 7, i + 6, j, True)
        laex.Align = DT_BOTTOM + DT_NOCLIP
        laex.Angle = 400
        laex.CharHeight = 7
        laex.CharWidth = 5
        laex.ForeColor = vbRed
    Next i
    Erase sngAry
    i = 1
    For k = 5 To 20.5 Step 0.005
        ReDim Preserve sngAry(1 To 2, 1 To i)
        sngAry(1, i) = 10 * k - 44.5
        sngAry(2, i) = 30 * Sin(k) + 80
        i = i + 1
    Next k
    Set pa = .Points.Add(sngAry, True)
    pa.Size = 2
    pa.Color = RGB(40, 77, 117)
    
'    .PageBreaks.Add
'    Set la = .Labels.Add("Win Codes", .PrintableWidth / 2 - 30, 10, .PrintableWidth / 2 + 20, 20)
'    la.FontSize = 20
'    la.Align = DT_CENTER
'
'    ReDim ary(1 To 4, 1 To 65536)
'    ary(1, 1) = "Dec"
'    ary(2, 1) = "Hex"
'    ary(3, 1) = "Char"
'    For k = 2 To 65536
'        ary(1, k) = k - 1
'        ary(2, k) = "(" & Hex(k - 1) & ")"
'        ary(3, k) = ChrW(k - 1)
'    Next k
'    Set ta = .Tables.Add(ary, 3, 3, 2)
'    With ta
'        '.BodyFontName = "Arial Unicode"
'        .TitleHeight = 5
'        .BodyHeight = 4
'        .TotalColumns = 5
'        .ColumnSpacing = 2
'        .CellSpacing = 0.5
'        .Columns.Add 11, DT_CENTER, DT_CENTER + DT_VCENTER
'        .Columns.Add 12, DT_CENTER, DT_CENTER + DT_VCENTER
'        .Columns.Add 10, DT_CENTER, DT_CENTER + DT_VCENTER
'        .Columns.Add
'
'    End With

    .PageBreaks.Add
    Set la = .Labels.Add("da dkla", 0, 0, 50, 15)
    With la
        .FontBold = True
        .FontItalic = True
        .FontSize = 45
        .FontUnderline = True
        .ForeColor = &HFFAACC
        .FontName = "courier"
        .Align = DT_NOCLIP
    End With
    
    Set linea = .Lines.Add(150, 150, 10, 10)
    linea.Size = 10
End With

rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
MsgBox "job created"
End Sub


'
Private Sub Command7_Click()
PrinterEx.PrintDoc Me.hWnd
End Sub

'
Private Sub Command8_Click()
PrinterEx.PreviewDoc Me.hWnd, True
End Sub

Private Function RndNum(n As Integer) As Integer
    Randomize n + Timer
    RndNum = Int(Rnd * n)
End Function