• Home
 · 
• Miscellaneous
 · 
• Crystal Report Engine 6.0 ( cpeaut32.dll ) - example of using different methods( you can eliminate

Crystal Report Engine 6.0 ( cpeaut32.dll ) - example of using different methods( you can eliminate

Crystal Report Engine 6.0 ( cpeaut32.dll ) - example of using different methods( you can eliminate with this class the bug of Crsytal ocx

API Declarations


' add reference to cpeauto32.dll and msrdo20.dll
Dim sServerName As String
Dim sDatabaseName As String
Dim sUID As String
Dim sPWD As String

Dim crystalSection As CRPEAuto.Section
Dim crystalSections As CRPEAuto.Sections
Dim crystalSectionOption As CRPEAuto.SectionOptions

Private CR_ReportObjects As CRPEAuto.ReportObjects
Private CR_Sections As CRPEAuto.Sections
Private CR_Section As CRPEAuto.Section
Private CR_SubObject As CRPEAuto.SubreportObject
Private CR_SubReport As CRPEAuto.Report
Private CR_Db As CRPEAuto.Database
Private CR_DbTables As CRPEAuto.DatabaseTables
Private CR_DbTable As CRPEAuto.DatabaseTable

Dim stProcedure As CRPEAuto.DatabaseParameter
Dim stProcedures As CRPEAuto.DatabaseParameters
Dim crystalApplication As CRPEAuto.Application
Dim crystalReport As CRPEAuto.Report
Dim db As CRPEAuto.Database
Dim dbtables As CRPEAuto.DatabaseTables
Dim dbTable As CRPEAuto.DatabaseTable
Dim crystalFormFieldDefns As CRPEAuto.FormulaFieldDefinitions
Dim crystalFormFieldDefn As CRPEAuto.FormulaFieldDefinition
Private mvarReportName As String 'the name of the report
Private mvarStoredProcedureName As rdoQuery 'stored procedure name

' comment : main.bas

Public Const WS_MINIMIZE = 536870912 ' Make a window of minimum size.
Public Const WS_VISIBLE = 268435456 ' Make a window that is visible when it first appears (for overlapping and pop-up windows).
Public Const WS_DISABLED = 134217728 'Make a window that is disabled when it first appears.
Public Const WS_CLIPSIBLINGS = 67108864 ' Clip child windows with respect to one another.
Public Const WS_CLIPCHILDREN = 33554432 'Exclude the area occupied by child windows when drawing inside the parent window.
Public Const WS_MAXIMIZE = 16777216 ' Make a window of maximum size.
Public Const WS_CAPTION = 12582912 ' Make a window that includes a title bar.
Public Const WS_BORDER = 8388608 ' Make a window that includes a border.
Public Const WS_DLGFRAME = 4194304 'Make a window that has a double border but no title.
Public Const WS_VSCROLL = 2097152 'Make a window that includes a vertical scroll bar.
Public Const WS_HSCROLL = 1048576 'Make a window that includes a horizontal scroll bar.
Public Const WS_SYSMENU = 524288 ' Include the system menu box.
Public Const WS_THICKFRAME = 262144 ' Include the thick frame that can be used to size the window.
Public Const WS_MINIMIZEBOX = 131072 'Include the minimize box.
Public Const WS_MAXIMIZEBOX = 65536 ' Include the maximize box.
Public Const CW_USEDFAULT = -32768 ' Assign the child window the default horizontal and vertical position, and the default height and width.
Public Const ErrorFileNotFound = 20507



Rate Crystal Report Engine 6.0 ( cpeaut32.dll ) - example of using different methods( you can eliminate

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

Public Function SetLocationReport(msServerName As String, msDatabaseName As String,       msUID As String, msPWD As String) As Boolean
On Error GoTo err
    sServerName = msServerName
    sDatabaseName = msDatabaseName
    sUID = msUID
    sPWD = msPWD
    Dim i As Integer
    Set db = crystalReport.Database
    
    Set dbtables = db.Tables

    For i = 1 To dbtables.Count
        Set dbTable = dbtables(i)
        Call dbTable.SetLogOnInfo(sServerName, sDatabaseName, sUID, sPWD)
        dbTable.Location = sDatabaseName & ".dbo." & GetTableName(dbTable.Location)
    Next i
    db.Verify
    Set stProcedures = db.Parameters
    Set crystalFormFieldDefns = crystalReport.FormulaFields
' for subreports
    Dim j As Integer
    Dim k As Integer
    Set CR_Sections = crystalReport.Sections
    For i = 1 To CR_Sections.Count
        Set CR_Section = CR_Sections.Item(i)
        Set CR_ReportObjects = CR_Section.ReportObjects
        For j = 1 To CR_ReportObjects.Count
            If CR_ReportObjects.Item(j).Kind = crSubreportObject Then
                Set CR_SubObject = CR_ReportObjects.Item(j)
                Set CR_SubReport = crystalReport.OpenSubreport(CR_SubObject.Name)
                Set CR_Db = CR_SubReport.Database
                Set CR_DbTables = CR_Db.Tables
                For k = 1 To CR_DbTables.Count
                    Set CR_DbTable = CR_DbTables.Item(k)
                    Call CR_DbTable.SetLogOnInfo(sServerName, sDatabaseName, sUID, sPWD)
                    CR_DbTable.Location = sDatabaseName & ".dbo." & GetTableName(CR_DbTable.Location)
                Next k
            End If
        Next j
    Next i
    SetLocationReport = True
Exit Function
err:
    If ErrorFileNotFound Then
        MsgBox "The file" & mvarReportName & " was not found !", vbCritical
        SetLocationReport = False
        Exit Function
    End If
    
    Call PrintError("SetLocationReport")
End Function

Public Sub FormulaString(text As String, FormulaFieldName As String)
    On Error GoTo err
'set formula value
    Dim i As Integer
    For i = 1 To crystalFormFieldDefns.Count
        Set crystalFormFieldDefn = crystalFormFieldDefns.Item(i)
        If crystalFormFieldDefn.FormulaFieldName = FormulaFieldName Then
           crystalFormFieldDefn.text = " ' " & text & " ' "
           Exit Sub
        End If
    Next i
Exit Sub
err:
    Call PrintError("FormulaString")
End Sub

Public Property Get StoredProcedure() As rdoQuery
    Set StoredProcedure = mvarStoredProcedureName
End Property
Public Property Let ReportName(ByVal vData As String)
On Error GoTo err
'set report name
    mvarReportName = vData
    Set crystalReport = crystalApplication.OpenReport _
    (mvarReportName)
Exit Property
err:
    If ErrorFileNotFound Then
        MsgBox "The file " & mvarReportName & " was not found !", vbCritical
        Exit Property
    End If
    PrintError ("Error open file")
End Property
Public Property Get ReportName() As String
    ReportName = mvarReportName
End Property
Private Sub Class_Initialize()
    Set crystalApplication = CreateObject("Crystal.CRPE.Application")
End Sub
Private Sub Class_Terminate()
    On Error Resume Next
    Set dbTable = Nothing
    Set stProcedure = Nothing
    Set stProcedures = Nothing
    Set crystalApplication = Nothing
    Set crystalReport = Nothing
    Set db = Nothing
    Set dbtables = Nothing
    Set crystalFormFieldDefns = Nothing
    Set crystalFormFieldDefn = Nothing
    sServerName = ""
    sDatabaseName = ""
    sUID = ""
    sPWD = ""
    Set CR_ReportObjects = Nothing
    Set CR_Sections = Nothing
    Set CR_Section = Nothing
    Set CR_SubObject = Nothing
    Set CR_SubReport = Nothing
    Set CR_Db = Nothing
    Set CR_DbTables = Nothing
    Set CR_DbTable = Nothing
    Set crystalSections = Nothing
    Set crystalSection = Nothing
    Set crystalSectionOption = Nothing

End Sub
Public Sub PrintReport(preview As Boolean, Optional Title As String, Optional hWnd As Variant, _
        Optional left As Integer = 0, Optional top As Integer = 0, Optional width As Integer = 800, _
        Optional height As Integer = 550)
On Error GoTo err
' print or preview
    With crystalReport.PrintWindowOptions
        .HasPrintSetupButton = True
        .HasExportButton = True
        .HasSearchButton = True
        .HasCancelButton = True
        .HasCloseButton = True
        .HasRefreshButton = True
        .HasGroupTree = True
        .HasNavigationControls = True
        .HasProgressControls = True
    End With
    If preview = True Then
        If Not IsMissing(hWnd) Then
            crystalReport.preview Title & " " & mvarReportName, left, top, width, height, _
            WS_VISIBLE And WS_THICKFRAME And WS_SYSMENU And _
            WS_MAXIMIZEBOX And WS_MINIMIZEBOX And WS_MAXIMIZE, CLng(hWnd)
        Else
            crystalReport.preview Title & " " & mvarReportName, left, top, width, height, WS_VISIBLE And WS_THICKFRAME And WS_SYSMENU And _
            WS_MAXIMIZEBOX And WS_MINIMIZEBOX And WS_MAXIMIZE
        End If
    Else
        crystalReport.PrintOut False
    End If
Exit Sub
err:
    Call PrintError("PrintReport")

End Sub

Public Sub SetStoredProcedureParam(vData() As Variant)
On Error GoTo eroare
' params for Crystal Report file (.rpt)
    Dim i As Integer
    For i = 1 To UBound(vData)
        Set stProcedure = stProcedures.Item(i)
        If IsDate(vData(i)) Then
            ' crystal report date format
            stProcedure.Value = spDate(vData(i), True)
        Else
            stProcedure.Value = vData(i)
        End If
    Next i
Exit Sub
err:
    Call PrintError("SetStoredProcedureParam")
End Sub
Public Function SetData(res As rdoResultset) As Boolean
On Error GoTo err
' set datasource for report, important sometimes for speed
' it can be modified to use ADO
    Set db = crystalReport.Database
    Set dbtables = db.Tables
    Set dbTable = dbtables(1)
    Call dbTable.SetPrivateData(3, res)
    Set crystalFormFieldDefns = crystalReport.FormulaFields
    SetData = True
Exit Function
err:
    SetData = False
    Call PrintError("SetData")
End Function

Public Sub SectionVisible(i As Integer, visible As Boolean)
On Error GoTo err
' the counter begin with 1 from top !
    Set crystalSections = crystalReport.Sections
    Set crystalSection = crystalSections(i)
    Set crystalSectionOption = crystalSection.Options
    crystalSectionOption.visible = visible
Exit Sub
err:
    Call PrintError("SectionVisible")
End Sub



' comment :  main.bas

Public Function GetTableName(s As String) As String
'return the name of the table or stored procedure
On Error GoTo eroare
    Dim k As Integer
    Dim s1 As String
    Dim m As Integer
    k = InStr(1, s, ".dbo.")
    m = Len(Mid(s, 1, k + 4))
    GetTableName = Mid(s, k + 5, Len(s) - k)
    Exit Function
err:
  Call MsgBox("Error in GetTableName()" + vbCrLf + Err.Description, _
                vbOKOnly + vbExclamation, "ERROR")
End Function

Public Sub PrintError(text As String)
    MsgBox Err.Description & " Error number : " & Err.Number, , text
End Sub
Public Sub CenterMe(myForm As Form)
    myForm.left = (Screen.width - myForm.width) / 2
    myForm.top = (Screen.height - myForm.height) / 2
End Sub

Public Function spDate(ByVal TmpDate As Date, Optional TimeCover) As String
' CHECK THIS FUNCTION !!!!
  Dim TmpStr As String
  Dim TmpDay, TmpMonth As String
  On Error GoTo eroare
  
    TmpMonth = CStr(Month(TmpDate))
    TmpDay = CStr(Day(TmpDate))
    
  If Not IsMissing(TimeCover) Then
    If Month(TmpDate) < 10 Then TmpMonth = "0" + CStr(Month(TmpDate))
    If Day(TmpDate) < 10 Then TmpDay = "0" + CStr(Day(TmpDate))
    spDate = CStr(Year(TmpDate)) + "-" + TmpMonth + "-" + TmpDay
    If CBool(TimeCover) = True Then
        spDate = spDate + " 00:00:00.000"
    Else
        spDate = spDate + " 23:00:00.000"
    End If
  Else
    If Month(TmpDate) < 10 Then TmpMonth = "0" + CStr(Month(TmpDate))
    If Day(TmpDate) < 10 Then TmpDay = "0" + CStr(Day(TmpDate))
    spDate = CStr(Year(TmpDate)) + "-" + TmpMonth + "-" + TmpDay + " 00:00:00.000"
  End If
  
  Exit Function

err:
  Call MsgBox("Err in spDate()" + vbCrLf + err.Description, _
                vbOKOnly + vbExclamation, "ERROR " + CStr(err))
End Function


Example of calling class methods :

With crReport
        .ReportName = "file.rpt"
        If .SetLocationReport(svrDSN, svrDatabase, svrUID, svrPWD) = False Then
            GoTo err
            Exit Sub
        End If
        Dim myVar() As Variant
        ReDim myVar(1)
        myVar(1) = id
        .SetStoredProcedureParam myVar()
        .FormulaString "name", "value"
        .PrintReport True, "Report", frmMain.hwnd, 0, 0, frmMain.Width,  frmmain.Height
End With