by Gabriel (3 Submissions)
Category: Miscellaneous
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Sun 4th March 2001
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
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
VBcoders
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
No comments have been posted about Crystal Report Engine 6.0 ( cpeaut32.dll ) - example of using different methods( you can eliminate . Why not be the first to post a comment about Crystal Report Engine 6.0 ( cpeaut32.dll ) - example of using different methods( you can eliminate .