Module cCrystal.pkg
1// Package Version 1.0
2Use Windows.pkg
3Use ptrmodes.pkg
4Use LanguageText.Pkg
5Use cCrystalcraxddrt.pkg
6Use cCrystalCDO32.pkg
7Use cCrystalPreview.pkg // activeX preview
8Use seq_chnl.pkg
9Use cApplication.pkg
10
11Struct tCRWCDO
12 String sTable
13 Handle hoCDO
14End_Struct
15
16Define ttDATAFLEX for "crdb_p2bdfapi.dll" // .dat
17Define ttCDO for "crdb_fielddef.dll" // .ttx
18
19// This object is the server for all reports
20Handle ghoCrystalReportServer
21Move 0 to ghoCrystalReportServer
22
23{ HelpTopic=cCrystalReport }
24Class cCrystalReport is a cComAutomationObject
25 Import_Class_Protocol cCrystalIReport
26 Import_Class_Protocol cCrystalIReportEvent
27
28 Procedure Construct_Object
29 Forward Send Construct_Object
30 Set psProgID to "CrystalDesignRunTime.Report"
31 Set psEventId to "{AF376802-6120-4E28-96DD-63FD2DC27B7A}"
32 Set peAutoCreate to acNoAutoCreate
33
34 //Path to report file that was opened.
35 Property String psReportLocation
36
37 //available objects within the report class
38 { Visibility=Private }
39 Property Handle phoDatabase 0
40
41 { Visibility=Private }
42 Property Handle phoDatabaseTables 0
43
44 { Visibility=Private }
45 Property Handle phoFormulaFieldDefinitions 0
46
47 { Visibility=Private }
48 Property Handle phoParamFieldDefinitions 0
49
50 { Visibility=Private }
51 Property Handle phoSortFields 0
52
53 //holds handles of all paramterFieldDefinition objects
54 { Visibility=Private }
55 Property Handle[] phoParams
56
57 //holds handles of all table objects
58 { Visibility=Private }
59 Property Handle[] phoTables
60
61 //holds handles of all cdo objects
62 { Visibility=Private }
63 Property tCRWCDO[] pCDOs
64
65 //## NOT FOR USE WITH MAINREPORT ##
66 // name of subreport (if main report, it is empty)
67 Property String psSubReportName ""
68
69 //## NOT FOR USE WITH SUBREPORTS ##
70
71 { Visibility=Private }
72 Property Handle phoExportObject 0
73
74 { Visibility=Private }
75 Property Handle phoPreviewObject 0
76
77 //holds name and handle of all subreport objects
78 { Visibility=Private }
79 Property Handle[] phoSubReports
80
81 { Visibility=Private }
82 Property Boolean pbSubReportsLoaded FALSE
83
84 //Printer specific properties
85 Property Integer piPrinterCopies 1
86 Property Integer piPrinterStartPage 1
87 Property Integer piPrinterEndPage 0 // we treat zero as "to end of report"
88 Property Boolean pbPrinterCollate TRUE
89 Property Boolean pbPrinterPrompt False
90
91 Property Boolean pbExportPrompt TRUE
92
93 End_Procedure // Construct_Object
94
95 //--------------------
96 // Database Functions
97
98 //Returns handle to database object
99 Function DatabaseObject Returns Handle
100 Handle hoDatabase
101 Variant vDatabase
102 Boolean bAttached
103
104 Get phoDatabase to hoDatabase
105 If (Not(hoDatabase)) Begin
106 Get Create U_cCrystalDatabase to hoDatabase
107 Get ComDatabase To vDatabase
108 Set pvComObject Of hoDatabase To vDatabase
109 Get IsComObjectCreated of hoDatabase to bAttached
110 If (bAttached) Begin
111 Set phoDatabase to hoDatabase
112 End
113 Else Begin
114 Send Destroy of hoDatabase
115 Move 0 to hoDatabase
116 Error DFERR_CRYSTAL_REPORT C_$UnableToCreateDatabaseObject
117 End
118 End
119 Function_Return hoDatabase
120 End_Function // DatabaseObject
121
122 //Creates all table objects
123 { Visibility=Private }
124 Procedure LoadDatabaseTables Handle hoDatabaseTables
125 Variant vComDatabaseTable
126 Handle hoDatabaseTable
127 Integer iTableItem iTableCount
128 Boolean bAttached
129 Handle[] hoTables
130 // create all tables
131 Get ComCount of hoDatabaseTables to iTableCount
132 For iTableItem From 1 To iTableCount
133 Get ComItem of hoDatabaseTables Item iTableItem To vComDatabaseTable
134 Get Create of hoDatabaseTables U_cCrystalDatabaseTable To hoDatabaseTable
135 //Set Name of hoDatabaseTable to ("oTable_"-ComName(hoDatabaseTable)) // for debugging purposes only
136 Set pvComObject Of hoDatabaseTable To vComDatabaseTable
137 Get IsComObjectCreated Of hoDatabaseTable To bAttached
138 If (bAttached) Begin
139 Move hoDatabaseTable to hoTables[iTableItem-1]
140 End
141 Else Begin
142 Send Destroy of hoDatabaseTable
143 Error DFERR_CRYSTAL_REPORT C_$UnableToCreateTableObject
144 End
145 Loop
146 Set phoTables to hoTables
147 End_Procedure // LoadDatabaseTables
148
149 // Returns handle to database collection comautomation object. Creates connection if connection does not already exist.
150 // This is used privately to fill the table array which is accessed publicly via get TableObjects.
151 // We could destroy phoDatatables if we wanted but we are not currently doing so.
152 { Visibility=Private }
153 Function DatabaseTablesObject Returns Handle
154 Boolean bAttached
155 Handle hoDatabaseTables hoDatabase
156 Variant vComDatabaseTables
157
158 Get phoDatabaseTables To hoDatabaseTables
159 If Not (hoDatabaseTables) Begin
160 Get DatabaseObject to hoDatabase // this will return a valid object or generate an error
161 If hoDatabase Begin
162 Get Create Of hoDatabase U_cCrystalDatabaseTables To hoDatabaseTables
163 Get ComTables Of hoDatabase To vComDatabaseTables
164 Set pvComObject Of hoDatabaseTables To vComDatabaseTables
165 //Set Name of hoDatabaseTables to "oComDatabaseTables" // for debugging purposes only
166 Get IsComObjectCreated Of hoDatabaseTables To bAttached
167 If (bAttached) Begin
168 Send LoadDatabaseTables hoDatabaseTables
169 Set phoDatabaseTables To hoDatabaseTables
170 End
171 Else Begin
172 Send Destroy of hoDatabaseTables // remove main object if failed.
173 Move 0 to hoDatabaseTables
174 Error DFERR_CRYSTAL_REPORT C_$UnableToCreateTableObjects
175 End
176 End
177 End
178 Function_Return hoDatabaseTables
179 End_Function // DatabaseTablesObject
180
181 //Returns an array of tables in report
182 Function TableObjects Returns Handle[]
183 Handle hoDatabaseTables
184 Handle[] hoTables
185
186 If Not (phoDatabaseTables(Self)) Begin
187 // If tables haven't been loaded, load them now.
188 Get DatabaseTablesObject to hoDatabaseTables
189 End
190 Get phoTables to hoTables
191 Function_Return hoTables
192 End_Function // TableObjects
193
194 //Returns handle of table from name. Note:ComName returns the object name. This is the
195 //name given to a file (such as an alias name). ComLocation and ComConnectBufferString
196 //return the file the connection is made to.
197 Function GetTableObjectByName String sTable Returns Handle
198 String sHoldName
199 Integer iTableItem iTableCount
200 Handle[] hoTables
201
202 Get TableObjects to hoTables
203 Move (SizeOfArray(hoTables)) to iTableCount
204 For iTableItem From 0 To (iTableCount-1)
205 Get ComName Of hoTables[iTableItem] To sHoldName
206 If (Lowercase(sHoldName) = Lowercase(sTable)) Begin
207 Function_Return hoTables[iTableItem]
208 End
209 Loop
210 Function_Return 0
211 End_Function // GetTableObjectByName
212
213 // Set the location of a dataflex datafile (.dat or .int) to the data directory
214 Function LocateDFFile Handle hoDatabaseTable Returns Boolean
215 Integer iPath iNumPaths
216 Boolean bExists
217 String DirSep sTable sLocation
218 //
219 Move (Sysconf(SYSCONF_DIR_SEPARATOR)) To DirSep
220 Get ComConnectBufferString of hoDatabaseTable to sTable
221 While (Pos("=",sTable))
222 Move (Replace(Left(sTable, Pos("=",sTable)), sTable, "")) to sTable
223 Loop
224 While (Pos(DirSep,sTable))
225 // strip out path until left with filename + extension
226 Move (Replace(Left(sTable, Pos(DirSep,sTable)), sTable, "")) to sTable
227 Loop
228 Get psDataPath Of (phoWorkspace(ghoApplication)) To sLocation
229 If (Right(sLocation, 1) <> DirSep) Begin
230 Append sLocation DirSep
231 End
232 Get CountOfPaths Of (phoWorkspace(ghoApplication)) sLocation To iNumPaths
233 Move (FALSE) to bExists
234 For iPath From 1 To iNumPaths
235 Get psDataPath Of (phoWorkspace(ghoApplication)) To sLocation
236 Get PathAtIndex Of (phoWorkspace(ghoApplication)) sLocation iPath To sLocation
237 If (Right(sLocation, 1) <> DirSep) Begin
238 Append sLocation DirSep
239 End
240 Append sLocation sTable
241 File_Exist sLocation bExists
242 Until ((bExists) Or (iPath=iNumPaths))
243 If (bExists) Begin
244 Set ComLocation Of hoDatabaseTable To sLocation
245 End
246 Else Error DFERR_CRYSTAL_REPORT (SFormat(C_$NoLocationSpecifiedForTable, sTable))
247 Function_Return bExists
248 End_Function // LocateDFFile
249
250 //## NOT FOR USE WITH SUBREPORTS ##
251 // Locate all dataflex files for report and sub-report assign them to the data directory.
252 // If table cannot be relocated, process stops and false is returned; else return true.
253 Function LocateDFFiles Returns Boolean
254 Handle[] SubReportArray
255 Handle hoSubReport
256 Integer iReportItem iReportCount
257 Boolean bOk
258
259 // locate for main report
260 Get LocateDFFilesForReport to bOk
261 If (Not(bOk)) Function_return False
262
263 // Set table locations for subreports
264 Get SubReportObjects to SubReportArray
265 Move (SizeOfArray(SubReportArray)) to iReportCount
266 For iReportItem From 0 To (iReportCount-1)
267 Move SubReportArray[iReportItem] to hoSubReport
268 If (hoSubReport) Begin
269 Get LocateDFFilesForReport of hoSubReport to bOk
270 If (not(bOk)) Function_Return False
271 End
272 Loop
273 Function_return True
274 End_Function // LocateDFFiles
275
276
277 // Locate all dataflex files for this one report assign them to the data directory.
278 // If table cannot be relocated, process stops and false is returned; else return true
279 { Visibility=Private }
280 Function LocateDFFilesForReport Returns Boolean
281 String sTableType
282 Integer iTableItem iTableCount
283 Handle hoDatabaseTable
284 Handle[] hoTables
285 Boolean bOK
286 //
287 Get TableObjects to hoTables
288 Move (SizeOfArray(hoTables)) to iTableCount
289 // Loop through all tables
290 For iTableItem From 0 To (iTableCount-1)
291 Move hoTables[iTableItem] To hoDatabaseTable
292 If (hoDatabaseTable) Begin
293 // Check database type and set location if it matches.
294 Get ComDllName of hoDatabaseTable to sTableType
295 If (sTableType = ttDATAFLEX and ghoApplication) Begin
296 Get LocateDFFile hoDatabaseTable to bOK
297 If (Not(bOK)) Function_return False // Exit loop with error (so we don't get redundant errors)
298 End
299 End
300 Loop
301 Function_return True // it worked
302 End_Function // LocateDFFilesForReport
303
304 //## NOT FOR USE WITH SUBREPORTS ##
305 // Creates a CDO based on a TTX file.
306 Function CreateCDO String sFileName Returns Handle
307 Handle hoCDO
308 tCRWCDO[] CRWCDOs
309 Integer iCDOCount iFieldType iChannel
310 Boolean bOK
311 String sLocation sLine sField sFieldType DirSep
312
313 // Create CDO object
314 Get Create U_cCrystalCrystalComObject to hoCDO
315 // Set Name of hoCDO to ("oCDO_"-sFilename) // for debugging purposes only
316 Send CreateComObject of hoCDO
317 Get IsComObjectCreated of hoCDO To bOk
318 If (bOk) Begin
319 Get pCDOs to CRWCDOs
320 Move (SizeOfArray(CRWCDOs)) to iCDOCount
321 //
322 Move (Sysconf(SYSCONF_DIR_SEPARATOR)) To DirSep
323 Indicate Err FALSE
324 Move (lowercase(sFileName)) to sFileName
325 //
326 Send ComReset of hoCDO
327 If (ghoApplication) begin
328 // Locate Filename in Datapath. This should be replaced with report directory.
329 Get psDataPath Of (phoWorkspace(ghoApplication)) To sLocation
330 If (Right(sLocation, 1) <> DirSep) Begin
331 Append sLocation DirSep
332 End
333 Get psReportLocation to sLocation
334 If (Right(sLocation, 1) <> DirSep) Begin
335 Append sLocation DirSep
336 End
337 End
338 File_Exist (sLocation-sFileName) bOk // True if file exists
339 // If file exists...
340 If (bOk) Begin
341 Get Seq_New_Channel to iChannel
342 If (iChannel = DF_SEQ_CHANNEL_NOT_AVAILABLE) Begin
343 Error DFERR_CRYSTAL_REPORT C_$NoIOChannelAvailableForCDO
344 Move False to bOk
345 End
346 Else Begin
347 Direct_Input channel iChannel (sLocation-sFileName)
348 Repeat
349 Readln sLine
350 If ( Not(SeqEof) and Trim(sLine<>"")) Begin
351 // Reset variables
352 Move "" to sField
353 Move "" to sFieldType
354 Move 0 to iFieldType
355 //
356 Move (Left(sLine, (Pos(" ", sLine)))) to sField
357 Move (Replace(sField, sLine, "")) to sLine
358 Move (Trim(sLine)) to sLine
359 If (Pos(" ", sLine)) Begin
360 Move (Left(sLine, (Pos(" ", sLine)))) to sFieldType
361 End
362 Else Move sLine to sFieldType
363 Move (Trim(lowercase(sFieldType))) to sFieldType
364 //
365 If (sFieldType = "blob") Move OLE_VT_BSTR to iFieldType
366 Else If (sFieldType = "boolean") Move OLE_VT_BOOL to iFieldType
367 Else If (sFieldType = "byte") Move OLE_VT_UI1 to iFieldType
368 Else If (sFieldType = "currency") Move OLE_VT_CY to iFieldType
369 Else If (sFieldType = "date") Move OLE_VT_DATE to iFieldType
370 Else If (sFieldType = "datetime") Move OLE_VT_DATE to iFieldType
371 Else If (sFieldType = "long") Move OLE_VT_I4 to iFieldType
372 Else If (sFieldType = "memo") Move OLE_VT_BSTR to iFieldType
373 Else If (sFieldType = "number") Move OLE_VT_R8 to iFieldType
374 Else If (sFieldType = "short") Move OLE_VT_I2 to iFieldType
375 Else If (sFieldType = "string") Move OLE_VT_BSTR to iFieldType
376 Else Move False to bOK // we didn't find a legal datatype in the ttx file
377
378 If (bOk) Begin
379 Get ComAddField of hoCDO (Trim(sField)) iFieldType to bOk
380 If (Not(bOk)) Begin
381 Error DFERR_CRYSTAL_REPORT (SFormat(C_$ErrorCreatingCDOField, sField))
382 End
383 End
384 else Begin
385 Error DFERR_CRYSTAL_REPORT (SFormat(C_$UnknownFieldTypeForCDO, sFieldType, sField))
386 end
387 end
388 Until ((SeqEof) or not(bOk))
389 Close_Input channel iChannel
390 Send Seq_Release_Channel iChannel
391 End
392 End
393 Else Begin
394 Error DFERR_CRYSTAL_REPORT (SFormat(C_$UnableToLocateCDOFile, sFileName))
395 End
396 End
397 Else Begin
398 Error DFERR_CRYSTAL_REPORT (SFormat(C_$UnableToCreateCDOobject,sFileName))
399 End
400
401 If bOk Begin
402 Move (Left(sFileName, (Length(sFileName)-4))) to CRWCDOs[iCDOCount].sTable
403 Move hoCDO to CRWCDOs[iCDOCount].hoCDO
404 Set pCDOs to CRWCDOs
405 End
406 Else Begin
407 Send Destroy of hoCDO
408 Move 0 to hoCDO
409 End
410
411 Function_Return hoCDO
412 End_Function // CreateCDO
413
414 //## NOT FOR USE WITH SUBREPORTS ##
415 // Converts a safe array to the correct datatypes used by the CDO and attaches data to CDO.
416 // Example usage within OnInitializeReport: Send AppendCDOData of hoReport hoCDO vData
417 Procedure AppendCDOData Handle hoCDO Variant[][] vCDOData
418 Integer iCol iMaxCol iItem iCount iType
419
420 // Get number of columns
421 Get ComGetColCount of hoCDO to iMaxCol
422 // Get number of rows of data in array
423 Move (SizeOfArray(vCDOData)) to iCount
424 For iCol from 0 to (iMaxCol-1)
425 Get ComGetFieldType of hoCDO iCol to iType
426 // For each column Loop through each row and set the proper datatypes according to the CDO
427 For iItem from 0 to (iCount-1)
428 If (iType=OLE_VT_I4) Move (Cast(vCDOData[iItem][iCol],Integer)) to vCDOData[iItem][iCol]
429 Else If (iType = OLE_VT_BSTR) Move (Cast(vCDOData[iItem][iCol],String)) to vCDOData[iItem][iCol]
430 Else If (iType = OLE_VT_BOOL) Move (Cast(vCDOData[iItem][iCol],Boolean)) to vCDOData[iItem][iCol]
431 Else If (iType = OLE_VT_CY) Move (Cast(vCDOData[iItem][iCol],Currency)) to vCDOData[iItem][iCol]
432 Else If (iType = OLE_VT_DATE) Move (Cast(vCDOData[iItem][iCol],Date)) to vCDOData[iItem][iCol]
433 Else If (iType = OLE_VT_R8) Move (Cast(vCDOData[iItem][iCol],Real)) to vCDOData[iItem][iCol]
434 Else If (iType = OLE_VT_I2) Move (Cast(vCDOData[iItem][iCol],Short)) to vCDOData[iItem][iCol]
435 Else If (iType = OLE_VT_UI1) Move (Cast(vCDOData[iItem][iCol],UChar)) to vCDOData[iItem][iCol]
436 Loop
437 Loop
438 If (SizeOfArray(vCDOData)) Send ComAddRows of hoCDO vCDOData
439 End_Procedure // AppendCDOData
440
441
442 //## NOT FOR USE WITH SUBREPORTS ##
443 // Attaches an existing CDO to a report. This is usefull when a cdo is shared by multiple reports.
444 // Create the cdo once and attach it to each report.
445 Procedure AttachCDO String sFileName Handle hoCDO
446 Integer iCDOCount
447 tCRWCDO[] CRWCDOs
448 Get pCDOs to CRWCDOs
449 Move (SizeOfArray(CRWCDOs)) to iCDOCount
450 Move (Left(sFileName, (Length(sFileName)-4))) to CRWCDOs[iCDOCount].sTable
451 Move hoCDO to CRWCDOs[iCDOCount].hoCDO
452 Set pCDOs to CRWCDOs
453 End_Procedure // AttachCDO
454
455 //## NOT FOR USE WITH SUBREPORTS ##
456 // Attaches CDO data to report and subreport CDO objects
457 { Visibility=Private }
458 Procedure AssignCDODataSources tCRWCDO[] CRWCDOs
459 Handle hoCDO hoTable
460 Integer iCDOItem iCDOCount
461 String sTable DirSep sPath sType
462 Move (Sysconf(SYSCONF_DIR_SEPARATOR)) To DirSep
463 Move (SizeOfArray(CRWCDOs)) to iCDOCount
464 For iCDOItem from 0 to (iCDOCount-1)
465 Move CRWCDOs[iCDOItem].hoCDO to hoCDO
466 If (hoCDO) Begin
467 Get GetTableObjectByName CRWCDOs[iCDOItem].sTable to hoTable
468 If (hoTable) Begin
469 Get ComDllName of hoTable to sType
470 If (sType=ttCDO) Begin
471 // Setting the datasource seems to be enough. Even though the TTX file is
472 // not in the same location on the deployment end as the development end,
473 // this does not appear to need to be set. I am leaving this code here in
474 // case someone has a problem with it and needs to use it.
475 //Get ComConnectBufferString of hoTable to sTable
476 //While (Pos("=",sTable))
477 // Move (Replace(Left(sTable, Pos("=",sTable)), sTable, "")) to sTable
478 //Loop
479 //While (Pos(DirSep,sTable))
480 // // strip out path until left with filename + extension
481 // Move (Replace(Left(sTable, Pos(DirSep,sTable)), sTable, "")) to sTable
482 //Loop
483 // Set TTX location to same as report
484 //Get psReportLocation to sPath
485 //Set ComLocation of hoTable to (sPath-sTable)
486 Send ComSetDataSource of hoTable (pvComObject(hoCDO)) 3 1
487 End
488 End
489 End
490 Loop
491 End_Procedure // AssignCDODataSources
492
493
494 // End Database functions
495
496
497 //--------------------
498 // Formula Functions
499
500 //Returns handle to report formula fields collection comautomation object.
501 //Creates connection if connection does not already exist.
502 // This is used privately by AssignFormula
503 { Visibility=Private }
504 Function FormulaFieldDefinitionsObject Returns Handle
505 Variant vFormulaFields
506 Handle hoFormulaFieldDefinitions
507 Boolean bAttached
508
509 Get phoFormulaFieldDefinitions To hoFormulaFieldDefinitions
510 If Not (hoFormulaFieldDefinitions) Begin
511 Get Create U_cCrystalFormulaFieldDefinitions To hoFormulaFieldDefinitions
512 Set phoFormulaFieldDefinitions To hoFormulaFieldDefinitions
513 Get ComFormulaFields To vFormulaFields
514 Set pvComObject Of hoFormulaFieldDefinitions To vFormulaFields
515 //Set Name of hoFormulaFieldDefinitions to "oComFormulaFieldDefinitions" // for debugging purposes only
516 End
517
518 Get IsComObjectCreated Of hoFormulaFieldDefinitions To bAttached
519 If (Not(bAttached)) Begin
520 Send Destroy of hoFormulaFieldDefinitions
521 Move 0 to hoFormulaFieldDefinitions
522 Set phoFormulaFieldDefinitions To 0
523 Error DFERR_CRYSTAL_REPORT C_$UnableToCreateFormulaFieldsObject
524 End
525 Function_Return hoFormulaFieldDefinitions
526 End_Function // FormulaFieldDefinitionsObject
527
528 //Sets report formula field to sValue
529 Procedure AssignFormula String sFormulaName String sValue
530 Variant vFormulaField
531 Handle hoFormulaFieldDefinitions hoFormulaFieldDefinition
532 Boolean bAttached bDisplay
533 // Find formula field and set it's value
534 Get FormulaFieldDefinitionsObject To hoFormulaFieldDefinitions
535 If (hoFormulaFieldDefinitions) Begin
536 Get Create Of hoFormulaFieldDefinitions U_cCrystalFormulaFieldDefinition To hoFormulaFieldDefinition
537 // if the name is not found, RDC generates an error which we want to suppress. We will show the error ourselves
538 Get Display_Error_State to bDisplay
539 Set Display_Error_State to false
540 Get ComGetItemByName Of hoFormulaFieldDefinitions sFormulaName To vFormulaField
541 Set Display_Error_State to bDisplay
542 Set pvComObject Of hoFormulaFieldDefinition To vFormulaField
543 Get IsComObjectCreated Of hoFormulaFieldDefinition To bAttached
544 //Set Name of hoFormulaFieldDefinition to ("Formula_"-ComName(hoFormulaFieldDefinition)) // for debugging purposes only
545 If (bAttached) Begin
546 Set ComText Of hoFormulaFieldDefinition To sValue
547 End
548 Else Begin
549 Error DFERR_CRYSTAL_REPORT (SFormat(C_$UnableToCreateFormulaFieldObject, sFormulaName))
550 End
551 Send Destroy of hoFormulaFieldDefinition
552 End
553 End_Procedure // AssignFormula
554
555 // End Formula Functions
556
557
558 //--------------------
559 // Parameter Functions
560
561 //Creates all Parameter objects
562 { Visibility=Private }
563 Procedure LoadParams handle hoParamFieldDefinitions
564 Variant vParameterFieldDefinition
565 Handle hoParameterFieldDefinition
566 Integer iParamItem iParamCount
567 Handle[] hoParams
568 Boolean bAttached
569 // create all parameters
570 Get ComCount of hoParamFieldDefinitions to iParamCount
571 For iParamItem From 1 To iParamCount
572 Get ComItem of hoParamFieldDefinitions iParamItem To vParameterFieldDefinition
573 Get Create of hoParamFieldDefinitions U_cCrystalParameterFieldDefinition To hoParameterFieldDefinition
574 Set pvComObject Of hoParameterFieldDefinition To vParameterFieldDefinition
575 //Set Name of hoParameterFieldDefinition to ("Parameter_"-ComName(hoParameterFieldDefinition)) // for debugging purposes only
576 Get IsComObjectCreated Of hoParameterFieldDefinition To bAttached
577 If (bAttached) Begin
578 Move hoParameterFieldDefinition to hoParams[iParamItem-1]
579 End
580 Else Begin
581 Send Destroy of hoParameterFieldDefinition
582 Error DFERR_CRYSTAL_REPORT C_$ErrorLoadingParamFieldObjects
583 End
584 Loop
585 Set phoParams to hoParams
586 End_Procedure // LoadParams
587
588 //Returns handle to report parameter fields collection comautomation object.
589 //Creates connection if connection does not already exist.
590 //This is used privately to load the params object which is accessed publicly via Get ParamObjects.
591 // We could destroy phoParamFieldDefinitions when this is done, but we are currently not doing so.
592 { Visibility=Private }
593 Function ParameterFieldDefinitionsObject Returns Handle
594 Variant vParamFields
595 Handle hoParamFieldDefinitions
596 Boolean bAttached
597
598 Get phoParamFieldDefinitions To hoParamFieldDefinitions
599 If Not (hoParamFieldDefinitions) Begin
600 Get Create U_cCrystalParameterFieldDefinitions To hoParamFieldDefinitions
601 Set phoParamFieldDefinitions To hoParamFieldDefinitions
602 Get ComParameterFields To vParamFields
603 Set pvComObject Of hoParamFieldDefinitions To vParamFields
604 Send LoadParams hoParamFieldDefinitions
605 //Set Name of hoParamFieldDefinitions to "oComParamFieldDefinitions" // for debugging purposes only
606 End
607
608 Get IsComObjectCreated Of hoParamFieldDefinitions To bAttached
609 If not (bAttached) Begin
610 Send Destroy of hoParamFieldDefinitions
611 Move 0 to hoParamFieldDefinitions
612 Set phoParamFieldDefinitions To 0
613 Error DFERR_CRYSTAL_REPORT C_$UnableToCreateParamFieldsObject
614 End
615 Function_Return hoParamFieldDefinitions
616 End_Function // ParameterFieldDefinitionsObject
617
618 //Returns an array of Parameters in report
619 Function ParamObjects Returns Handle[]
620 Handle hoParamFieldDefinitions
621 Handle[] hoParams
622
623 If Not (phoParamFieldDefinitions(Self)) Begin
624 // If Params haven't been loaded, load them now.
625 Get ParameterFieldDefinitionsObject To hoParamFieldDefinitions
626 End
627 Get phoParams to hoParams
628 Function_Return hoParams
629 End_Function // ParamObjects
630
631 //Returns handle of Parameter object from name
632 Function GetParamObjectByName String sParamName Returns Handle
633 String sHoldName
634 Integer iParamItem iParamCount
635 Handle[] hoParams
636
637 Get ParamObjects to hoParams
638 Move (SizeOfArray(hoParams)) to iParamCount
639 For iParamItem From 0 To (iParamCount-1)
640 Get ComParameterFieldName Of hoParams[iParamItem] To sHoldName
641 If (Lowercase(sHoldName) = Lowercase(sParamName)) Begin
642 Function_Return hoParams[iParamItem]
643 End
644 Loop
645 Function_Return 0
646 End_Function // GetParamObjectByName
647
648 // End Parameter Functions
649
650
651 //--------------------
652 // Sort Functions
653
654 //Returns handle to report record sort fields collection comautomation object.
655 //Creates connection if connection does not already exist.
656 // This is used privately by the various sort methods (DeleteSortOrder, DeleteNthSortField and AppendSortField)
657 { Visibility=Private }
658 Function SortFieldsObject Returns Handle
659 Variant vSortFields
660 Handle hoSortFields
661 Boolean bAttached
662
663 Get phoSortFields To hoSortFields
664 If Not (hoSortFields) Begin
665 Get Create U_cCrystalSortFields To hoSortFields
666 Set phoSortFields To hoSortFields
667 Get ComRecordSortFields To vSortFields
668 Set pvComObject Of hoSortFields To vSortFields
669 //Set Name of hoSortFields to "oSortFields" // for debugging purposes only
670 End
671
672 Get IsComObjectCreated Of hoSortFields To bAttached
673 If Not (bAttached) Begin
674 Send Destroy of hoSortFields
675 Move 0 to hoSortFields
676 Set phoSortFields To 0
677 Error DFERR_CRYSTAL_REPORT C_$UnableToCreateRecordSortObject
678 Function_Return 0
679 End
680 Function_Return hoSortFields
681 End_Function // SortFieldsObject
682
683 //Deletes current record sort order
684 Procedure DeleteSortOrder
685 Handle hoSortFields
686 Integer iSortItem iSortCount
687 Get SortFieldsObject To hoSortFields
688 If (hoSortFields) Begin
689 Get ComCount of hoSortFields to iSortCount
690 For iSortItem From 1 To iSortCount
691 Send ComDelete Of hoSortFields 1
692 Loop
693 End
694 End_Procedure // DeleteSortOrder
695
696 //Deletes current record sort order at position iSortItem
697 Procedure DeleteNthSortField Integer iSortItem
698 Handle hoSortFields
699 Get SortFieldsObject To hoSortFields
700 If (hoSortFields) Begin
701 Send ComDelete Of hoSortFields iSortItem
702 End
703 End_Procedure // DeleteNthSortField
704
705 //Adds table field to record sort order
706 Procedure AppendSortField String sTable String sField crSortDirection SortOrder
707 Variant vField vFields
708 Handle hoSortFields hoDatabaseTable hoTableFields hoTableField
709 Boolean bOK bAttached
710 string sName
711 integer iField iFieldCount
712
713 Get SortFieldsObject To hoSortFields
714 If (hoSortFields) Begin
715 Get GetTableObjectByName sTable To hoDatabaseTable
716 Move (hoDatabaseTable) to bOk
717 If bOk Begin
718 // create temporary object for all table fields
719 Get Create U_cCrystalDatabaseFieldDefinitions to hoTableFields
720 Get Create U_cCrystalDatabaseFieldDefinition to hoTableField
721 Get ComFields of hoDatabaseTable To vFields
722 Set pvComObject of hoTableFields To vFields
723 Get IsComObjectCreated of hoTableFields to bAttached
724 If (bAttached) Begin
725 Move (lowercase(sField)) to sField // we will do a lc comparison
726 Get ComCount of hoTableFields to iFieldCount
727 Move False to bOk
728 Move 1 to iField
729 While (not(bOk) and (iField<=iFieldCount))
730 Get ComItem of hoTableFields iField to vField
731 Set pvComObject of hoTableField To vField
732 Get IsComObjectCreated of hoTableField to bAttached
733 If (bAttached) Begin
734 Get ComDatabaseFieldName of hoTableField to sName
735 If (lowercase(sName)=sField) Begin
736 Send ComAdd Of hoSortFields vField SortOrder
737 Move True to bOk
738 end
739 end
740 Increment iField
741 End
742 End
743 Send Destroy of hoTableField
744 Send Destroy of hoTableFields
745 End
746 // if can't find table or field or whatever
747 If Not bOk Begin
748 Error DFERR_CRYSTAL_REPORT (SFormat(C_$CannotAddSortField, sTable, sField))
749 end
750 End
751 End_Procedure // AppendSortField
752
753 //Adds formula field to record sort order
754 Procedure AppendSortFormulaField String sFormulaName crSortDirection SortOrder
755 Variant vField
756 Handle hoSortFields hoFormulaFieldDefinitions
757 Boolean bOK bAttached bDisplay
758
759 Get SortFieldsObject To hoSortFields
760 If (hoSortFields) Begin
761 // Find formula field and set it's value
762 Get FormulaFieldDefinitionsObject To hoFormulaFieldDefinitions
763 If (hoFormulaFieldDefinitions) Begin
764 // if the name is not found, RDC generates an error which we want to suppress. We will show the error ourselves
765 Get Display_Error_State to bDisplay
766 Set Display_Error_State to false
767 Get ComGetItemByName Of hoFormulaFieldDefinitions sFormulaName To vField
768 Set Display_Error_State to bDisplay
769 End
770 //
771 Move (Not(IsNullComObject(vField))) To bOK
772 If bOk Begin
773 Send ComAdd Of hoSortFields vField SortOrder
774 End
775 // if can't find formula field
776 If Not bOk Begin
777 Error DFERR_CRYSTAL_REPORT (SFormat(C_$CannotAddSortFormulaField, sFormulaName))
778 end
779 End
780 End_Procedure // AppendSortFormulaField
781
782
783 // End Sort Functions
784
785
786 //--------------------
787 // Begin Subreport Functions
788
789 //## NOT FOR USE WITH SUBREPORTS ##
790 //Loads all subreports into an array. Note: All objects are of a report are checked to check if it is
791 //a subreport. If it is a subreport, it is then created at the report level. All test objects are
792 //destroyed when this process is complete.
793 { Visibility=Private }
794 Procedure LoadSubreports
795 handle hoAreas hoArea hoSections hoSection hoReportObjs hoSubReport hoTemp
796 variant vAreas vArea vSections vSection vReports vSubReport vReport
797 integer iArea iSection iSubReport iKind iCount
798 Handle[] SubReportArray
799 string sName
800 Boolean bAttached
801
802 Get phoSubReports to SubReportArray
803 Get Create U_cCrystalAreas to hoAreas
804 Get Create U_cCrystalArea to hoArea
805 Get Create U_cCrystalSections to hoSections
806 Get Create U_cCrystalSection to hoSection
807 Get Create U_cCrystalReportObjects to hoReportObjs
808 Get Create U_cCrystalSubreportObject to hoTemp // temp subreport object to test ComKind
809
810 Get ComAreas to vAreas
811 Set pvComObject Of hoAreas To vAreas
812
813 For iArea from 1 to (ComCount(hoAreas))
814 Get ComItem of hoAreas iArea to vArea
815 Set pvComObject Of hoArea To vArea
816
817 Get ComSections of hoArea to vSections
818 Set pvComObject Of hoSections To vSections
819
820 For iSection from 1 to (ComCount(hoSections))
821 Get ComItem of hoSections iSection to vSection
822 Set pvComObject Of hoSection To vSection
823
824 Get ComReportObjects of hoSection to vReports
825 Set pvComObject Of hoReportObjs To vReports
826
827 For iSubReport from 1 to (ComCount(hoReportObjs))
828 Get ComItem of hoReportObjs iSubReport to vSubReport
829 Set pvComObject Of hoTemp To vSubReport
830
831 Get ComKind of hoTemp to iKind
832 If (iKind=crSubreportObject) begin
833 Get ComSubReportName of hoTemp to sName
834 // Open subreport
835 Get ComOpenSubreport of hoTemp To vReport
836 Get Create U_cCrystalReport To hoSubReport
837 //Set Name of hoSubReport to ("oSubReport_"-sName) // for debugging purposes only
838 Set pvComObject Of hoSubReport To vReport
839 Get IsComObjectCreated of hoSubReport to bAttached
840 If (bAttached) Begin
841 // Assign subreport the same location as main report
842 Set psReportLocation of hoSubReport to (psReportLocation(Self))
843 Move hoSubReport to SubReportArray[iCount]
844 Set psSubReportName of hoSubReport to (Trim(sName))
845 Increment iCount
846 End
847 Else Begin
848 Error DFERR_CRYSTAL_REPORT (SFormat(C_$SubreportCouldNotBeOpened, sName))
849 Send Destroy of hoSubReport
850 End
851 End
852 Loop
853 Loop
854 Loop
855 Send Destroy of hoAreas
856 Set phoSubReports to SubReportArray
857 Set pbSubReportsLoaded to TRUE
858 End_Procedure // LoadSubreports
859
860 //## NOT FOR USE WITH SUBREPORTS ##
861 //Returns an array of subreports in report
862 Function SubReportObjects Returns Handle[]
863 Handle[] SubReportArray
864 If not (pbSubReportsLoaded(Self)) Begin
865 // If subreports haven't been loaded, load them now.
866 Send LoadSubreports
867 End
868 Get phoSubReports to SubReportArray
869 Function_Return SubReportArray
870 End_Function // SubReportObjects
871
872 //## NOT FOR USE WITH SUBREPORTS ##
873 //Returns handle of subreport object comautomation object. Creates
874 //connection if connection does not already exist
875 Function GetSubReportObjectbyName String sReportName Returns Handle
876 Integer iReportItem iReportCount
877 String sHoldName
878 Handle[] SubReportArray
879
880 // Check to see if subreport has already been accessed and return it's handle
881 Get SubReportObjects to SubReportArray
882 Move (SizeOfArray(SubReportArray)) to iReportCount
883 For iReportItem From 0 To (iReportCount-1)
884 If (SubReportArray[iReportItem]) Begin
885 Move (psSubReportName(SubReportArray[iReportItem])) to sHoldName
886 If (lowercase(sHoldName)=lowercase(sReportName)) Begin
887 Function_Return SubReportArray[iReportItem]
888 End
889 End
890 Loop
891 End_Function // GetSubReportObjectbyName
892
893 // End Subreport Functions
894
895
896 //--------------------
897 // Begin Output Funtions
898
899 //## NOT FOR USE WITH SUBREPORTS ##
900 // Creates export object if it doesn't exist
901 Function ExportObject Returns Handle
902 Handle hoExport hcExportObject
903 Variant vExport
904 Boolean bAttached
905
906 Get phoExportObject to hoExport
907 If (Not(hoExport)) Begin
908 Delegate Get phcExportObject to hcExportObject
909 Get Create hcExportObject to hoExport
910 Get ComExportOptions To vExport
911 Set pvComObject Of hoExport To vExport
912 //Set Name of hoExport to "oExport" // for debugging purposes only
913 Get IsComObjectCreated of hoExport to bAttached
914 If (bAttached) Begin
915 Set phoExportObject to hoExport
916 End
917 Else Begin
918 Send Destroy of hoExport
919 Move 0 to hoExport
920 Set phoExportObject to 0
921 Error DFERR_CRYSTAL_REPORT C_$ErrorCreatingExportObject
922 End
923 End
924 Function_Return hoExport
925 End_Function // ExportObject
926
927 { Visibility=Private }
928 Function PreviewerName Returns String
929 Handle hoPreviewerParent
930 String sPreviewerName
931
932 Get Parent of Self to hoPreviewerParent
933 If (hoPreviewerParent) Begin
934 Get Object_Label of hoPreviewerParent to sPreviewerName
935 Move (sPreviewerName - "_Previewer") to sPreviewerName
936 End
937 Else Begin
938 Move "oPreviewer" to sPreviewerName
939 End
940
941 Function_Return sPreviewerName
942 End_Function
943
944
945 //## NOT FOR USE WITH SUBREPORTS ##
946 // Returns handle of preview object
947 Function PreviewObject Returns Handle
948 Handle hoPreview hoMain hoClientArea hcPreviewObject
949 String sTitle sPreviewerName
950 Boolean bAttached
951
952 Get phoPreviewObject to hoPreview
953 // This creates a MDI style viewer. The view that gets created (determined by phcPreviewObject)
954 // will get placed inside of the client-area-object within the main-panel-id. If either of these
955 // objects do not exist, this will not work (and you will get an error). In such a case, you'd
956 // want to create a replacement PreviewObject method using this as a model where you'd place
957 // the previewer wherever you want.
958 If (Not(hoPreview)) Begin
959 Delegate Get phcPreviewObject to hcPreviewObject
960 Get Main_Panel_ID To hoMain
961 If (not(hoMain)) Begin
962 Error DFERR_CRYSTAL_REPORT C_$NoMainPanelObject
963 Function_return 0
964 end
965 Get Client_Id of hoMain to hoClientArea
966 If (not(hoClientArea)) Begin
967 Error DFERR_CRYSTAL_REPORT C_$NoClientAreaObject
968 Function_return 0
969 End
970 Get Create Of hoClientArea hcPreviewObject To hoPreview
971 If (hoPreview) Begin
972 Get PreviewerName to sPreviewerName
973 Set Name of hoPreview to sPreviewerName
974 Set phoPreviewObject to hoPreview
975 Get ComReportTitle to sTitle
976 If (sTitle = "") Get psReportName to sTitle
977 // Note that this requires that the preview object understands the Label Message
978 Set Label Of hoPreview To sTitle
979 End
980 End
981 Function_Return hoPreview
982 End_Function // PreviewObject
983
984 //## NOT FOR USE WITH SUBREPORTS ##
985 // Override the default preview object
986 Procedure AssignPreviewObject Handle hoPreview
987 If (phoPreviewObject(Self)) Begin
988 Error DFERR_CRYSTAL_REPORT C_$PreviewObjectAlreadyAssigned
989 End
990 Else Set phoPreviewObject to hoPreview
991 End_Procedure // AssignPreviewObject
992
993 //## NOT FOR USE WITH SUBREPORTS ##
994 // Return handle of activeX preview object.
995 Function ActiveXReportViewerObject Returns Handle
996 Handle hoPreview
997 Get PreviewObject to hoPreview
998 If (hoPreview) Function_Return (phoActiveXReportViewer(hoPreview))
999 Function_Return 0
1000 End_Function // ActiveXReportViewerObject
1001
1002 //## NOT FOR USE WITH SUBREPORTS ##
1003 //Printer specific
1004 { Visibility=Private }
1005 Procedure PrintReport
1006 Integer iStartPage iEndPage iCopies
1007 Boolean bCollate bPrompt
1008 Get piPrinterStartPage to iStartPage
1009 Get piPrinterEndPage to iEndPage
1010 Get pbPrinterCollate to bCollate
1011 Get piPrinterCopies to iCopies
1012 Get pbPrinterPrompt to bPrompt
1013 // if endpage is 0, we assume end of report. Startpage must always be specified (default=1).
1014 If (iEndPage=0) begin
1015 Send ComPrintout bPrompt iCopies bCollate iStartPage nothing
1016 end
1017 Else begin
1018 Send ComPrintout bPrompt iCopies bCollate iStartPage iEndPage
1019 end
1020 End_Procedure //PrintReport
1021
1022 //Export specific
1023 { Visibility=Private }
1024 Procedure ExportReport
1025 Boolean bPrompt
1026 Get pbExportPrompt to bPrompt
1027 Send ComExport bPrompt
1028 End_Procedure // ExportReport
1029
1030
1031 // End Output Functions
1032
1033End_Class // cCrystalReport
1034
1035
1036// Main crystal report class
1037
1038{ HelpTopic=cCrystal }
1039Class cCrystal is a cObject
1040
1041 Procedure Construct_Object
1042 Forward Send Construct_Object
1043
1044 // destination of report
1045 { EnumList="Print_To_File, Print_To_Printer, Print_To_Window" }
1046 { Category=Report }
1047 Property Integer peOutputDestination Print_To_Window
1048
1049 // name of report to be run
1050 { Category=Report }
1051 Property String psReportName ""
1052
1053 // controls if dat or int files are automatically located.
1054 { Category=Behavior }
1055 Property Boolean pbAutoLocateDFFiles True
1056
1057 // Can be set true by the developer within the events to stop a report from running.
1058 { DesignTime=False }
1059 Property Boolean pbCanceled False
1060
1061 // Determines if a report is canceled if an error occurs. This can changed as often as needed to handle any particular
1062 // section of code. If you want to try to handle an error, set this false (and be careful).
1063 { Category="Error Handling" }
1064 Property Boolean pbCancelIfError True
1065
1066 // Handle of classes used. Can be used to change the class of the composite child reportobject class
1067 { Category=Report }
1068 Property Handle phcReportObject U_cCrystalReport
1069 { Category=Report }
1070 Property Handle phcPreviewObject U_cCrystalPreview
1071 { Category=Report }
1072 Property Handle phcExportObject U_cCrystalExportOptions
1073
1074 // if set to false, Crystal errors will not be sent to the error object.
1075 { Category="Error Handling" }
1076 { PropertyType=Boolean }
1077 Property Integer Display_Error_State True
1078 { DesignTime=False }
1079 Property Boolean pbHasErrors False
1080
1081 { Visibility=Private }
1082 Property Handle Old_Error_Object_Id 0
1083
1084 { Visibility=Private }
1085 Property integer Error_Processing_State False
1086
1087 // report com object.
1088 { Visibility=Private }
1089 Property Handle phoReportObject 0
1090
1091 End_Procedure // Construct_Object
1092
1093 // returns handle of attached com applicaton object. This creates this as a global object
1094 // which is assigned to ghoCrystalReportServer. It then does a com attach. If the attach fails,
1095 // zero is returned indicating failure. This can be used to test if the crystal rdc com objects
1096 // are installed.
1097 Function ApplicationObject returns handle
1098 Boolean bDisplay bAttached
1099 Handle hoError
1100
1101 If (Not(ghoCrystalReportServer)) Begin
1102 // if no application object, create this at the destkop level.
1103 Get Create of (If(ghoApplication, ghoApplication, desktop)) U_cCrystalApplication to ghoCrystalReportServer
1104 End
1105 Get IsComObjectCreated of ghoCrystalReportServer To bAttached
1106
1107 If not bAttached begin
1108 Move Error_Object_Id to hoError
1109 Get Display_Error_State to bDisplay
1110 Move Self to Error_Object_Id
1111 Set Display_Error_State to false
1112 Send CreateComObject of ghoCrystalReportServer
1113 Move hoError to Error_Object_Id
1114 Set Display_Error_State to bDisplay
1115
1116 Get IsComObjectCreated of ghoCrystalReportServer To bAttached
1117 If Not bAttached Begin
1118 Function_Return 0
1119 End
1120 End
1121 Function_return ghoCrystalReportServer
1122 End_Function // ApplicationObject
1123
1124 // Return handle to existing report
1125 Function ReportObject Returns Handle
1126 Function_Return (phoReportObject(Self))
1127 End_Function // ReportObject
1128
1129 // Intended to be used by developer
1130 { MethodType=Event }
1131 Procedure OnInitializeReport Handle hoReport
1132 End_Procedure // OnInitializeReport
1133
1134 // Intended to be used by developer
1135 { MethodType=Event }
1136 Procedure OnPrintReport Handle hoReport
1137 End_Procedure // OnPrintReport
1138
1139 // Intended to be used by developer
1140 { MethodType=Event }
1141 Procedure OnExportReport Handle hoReport
1142 End_Procedure // OnExportReport
1143
1144 // Intended to be used by developer
1145 { MethodType=Event }
1146 Procedure OnDisplayReport Handle hoReport
1147 End_Procedure // OnDisplayReport
1148
1149 // Can be sent by developer (and possible augmented) in more advanced situations
1150 Procedure PrintReport Handle hoReport
1151 boolean bCancel
1152 Send OnPrintReport hoReport // developer event
1153 Get pbCanceled to bCancel // developer might have canceled the report
1154 If (not(bCancel)) Begin
1155 Send PrintReport of hoReport
1156 End
1157 End_Procedure // PrintReport
1158
1159 // Can be sent by developer (and possible augmented) in more advanced situations
1160 Procedure ExportReport Handle hoReport
1161 boolean bCancel
1162 Send OnExportReport hoReport // developer event
1163 Get pbCanceled to bCancel // developer might have canceled the report
1164 If (not(bCancel)) Begin
1165 Send ExportReport of hoReport
1166 End
1167 End_Procedure // ExportReport
1168
1169 // Can be sent by developer (and possible augmented) in more advanced situations
1170 Procedure DisplayReport Handle hoReport
1171 boolean bCancel
1172 Handle hoPreview
1173 Send OnDisplayReport hoReport // developer event
1174 Get pbCanceled to bCancel // developer might have canceled the report
1175 If (not(bCancel)) Begin
1176 Get PreviewObject of hoReport to hoPreview
1177 Send DisplayReport of hoPreview hoReport
1178 End
1179 End_Procedure // DisplayReport
1180
1181 // Creates report object if it doesn't exist. Opens psReportName.
1182 Function OpenReport Returns Boolean
1183 Handle hoReport hoWorkspace hoSubReport hcReportObject hoApplicationObject
1184 Variant vReport
1185 Boolean bAttached bExists bOk bCanceled
1186 String sReport sReportPath DirSep
1187 Integer iPath iNumPaths iReportItem iReportCount
1188 tCRWCDO[] CRWCDOs
1189 Handle[] SubReportArray
1190
1191
1192 Set pbCanceled to False // this can be set true by developers within events to stop the report
1193
1194 // Check if Report application Server has already been created started. If not
1195 // do so. If this returns 0, we failed and the report cannot be run.
1196 Get ApplicationObject to hoApplicationObject
1197 If not hoApplicationObject begin
1198 Error DFERR_CRYSTAL_REPORT C_$FailedToConnectCrystalAutomation
1199 Function_Return FALSE
1200 End
1201
1202
1203 // Create report Object if it doesn't exist
1204 Get ReportObject to hoReport
1205 If (hoReport) Begin
1206 // Check to see if report object already has a report opened.
1207 Get IsComObjectCreated Of hoReport To bAttached
1208 If (bAttached) Begin
1209 Error DFERR_CRYSTAL_REPORT C_$ReportIsAlreadyOpened
1210 Function_Return FALSE
1211 End
1212 End
1213
1214 If (Not(hoReport)) Begin
1215 Get phcReportObject to hcReportObject
1216 Get Create hcReportObject to hoReport
1217 //Set Name of hoReport to "oReport" // for debugging purposes only
1218 Set phoReportObject to hoReport
1219 End
1220
1221 If (not(hoReport)) Begin
1222 Error DFERR_CRYSTAL_REPORT (SFormat(C_$ErrorOpeningReport, sReport))
1223 Function_Return FALSE
1224 End
1225
1226 // at this point the report is created (but not attached to a COM report).
1227
1228 Move True to bOk // keep track of errors during init process
1229
1230 Get psReportName to sReport
1231 Move (Sysconf(SYSCONF_DIR_SEPARATOR)) To DirSep
1232 // Did the user give us the path and file name?
1233 If (Pos(DirSep, sReport)) Begin
1234 File_Exist sReport bExists
1235 End
1236 Else Move (FALSE) to bExists
1237
1238 If bExists Begin
1239 Move sReport To sReportPath
1240 End
1241 Else If (ghoApplication) Begin
1242 // If no path was given, locate report in the workspace data directory(s). You can only
1243 // do this if an application object exists.
1244 Get phoWorkspace of ghoApplication to hoWorkspace
1245 Get psDataPath of hoWorkspace To sReportPath
1246 Get CountOfPaths Of hoWorkspace sReportPath To iNumPaths
1247 // iterate through each datapath until report is located
1248 For iPath From 1 To iNumPaths
1249 Get psDataPath Of hoWorkspace To sReportPath
1250 Get PathAtIndex Of hoWorkspace sReportPath iPath To sReportPath
1251 // Make sure path ends with a DirSep before we append the report name.
1252 If (Right(sReportPath,1)<>DirSep) Begin
1253 Append sReportPath DirSep sReport
1254 End
1255 File_Exist sReportPath bExists
1256 Until ((bExists) Or (iPath=iNumPaths))
1257 End
1258
1259 If (Not(bExists)) Begin
1260 Move False to bOk
1261 Error DFERR_CRYSTAL_REPORT (SFormat(C_$UnabletoLocateReport, sReport))
1262 End
1263
1264 // If Report was found, open it.
1265 If (bOk) Begin
1266 //open report
1267 Get ComOpenReport of hoApplicationObject sReportPath crOpenReportByDefault to vReport
1268 Set pvComObject Of hoReport To vReport
1269 Get IsComObjectCreated Of hoReport To bOk
1270 If (Not(bOk)) Begin
1271 Error DFERR_CRYSTAL_REPORT (SFormat(C_$ErrorOpeningReport, sReport))
1272 End
1273 End
1274
1275 If (bOk) Begin
1276 //set report location
1277 While (Right(sReportPath,1)<>DirSep)
1278 Move (Left(sReportPath, (Length(sReportPath)-1))) to sReportPath
1279 Loop
1280 Set psReportLocation of hoReport to sReportPath
1281 //auto locate dat and int files.
1282 If (pbAutoLocateDFFiles(Self)) Begin
1283 Get LocateDFFiles of hoReport to bOk
1284 End
1285 End
1286
1287 If (bOk) Begin
1288 // Always default forumula syntax to crystal syntax
1289 Set ComFormulaSyntax of hoReport to crCrystalSyntaxFormula
1290
1291 Send OnInitializeReport hoReport
1292 Get pbCanceled to bCanceled // developer might have canceled the report
1293 If bCanceled Move False to bOk
1294 End
1295
1296 If (bOk) Begin
1297 // Set CDO data source (if any)
1298 Get pCDOs of hoReport to CRWCDOs
1299 If (SizeOfArray(CRWCDOs)>0) Begin
1300 Send AssignCDODataSources of hoReport CRWCDOs
1301 // Set CDO data source (if any) for subreports
1302 Get SubReportObjects of hoReport to SubReportArray
1303 Move (SizeOfArray(SubReportArray)) to iReportCount
1304 For iReportItem From 0 To (iReportCount-1)
1305 Move SubReportArray[iReportItem] to hoSubReport
1306 If (hoSubReport) Begin
1307 Send AssignCDODataSources of hoSubReport CRWCDOs
1308 End
1309 Loop
1310 End
1311 End
1312
1313 // we check pbCancaled one last time at the at end of the process. It is possible that OnError is setting this
1314 // to True and that could happen any time. So we check at the very last moment here.
1315 If (bOk) Begin
1316 Get pbCanceled to bCanceled
1317 If bCanceled Move False to bOk
1318 End
1319
1320 // if any error occured, destroy the report
1321 If (not(bOk)) begin
1322 Send DestroyReportObject
1323 end
1324 Function_Return bOk
1325
1326 End_Function // OpenReport
1327
1328 Procedure OutputReport
1329 Handle hoReport
1330 Integer iDestination
1331 Get ReportObject to hoReport
1332 // We would not have a report object if there was a
1333 If (hoReport) Begin
1334 Get peOutputDestination to iDestination
1335 If (iDestination= PRINT_TO_WINDOW) Begin
1336 Send DisplayReport hoReport
1337 End
1338 Else If (iDestination= PRINT_TO_FILE) Begin
1339 Send ExportReport hoReport
1340 End
1341 Else If ((iDestination=PRINT_TO_PRINTER_NO_DIALOG) or (iDestination=PRINT_TO_PRINTER)) Begin
1342 Send PrintReport hoReport
1343 End
1344 Else Error DFERR_CRYSTAL_REPORT C_$NoPrintDestinationDefined
1345 End
1346 End_Procedure // OuputReport
1347
1348 { Visibility=Private }
1349 Procedure DestroyReportObject
1350 Boolean bCanClose
1351
1352 If (phoReportObject(Self)) Begin
1353 Send Destroy of (phoReportObject(Self))
1354 Set phoReportObject to 0
1355 End
1356
1357 // also close the application object. Closing a report and not closing the application object it
1358 // uses seems to create a memory leak (which is a Crystal RDC thing that we cannot control). See BT 3901
1359 If (ghoCrystalReportServer) Begin
1360
1361 // assertion: I don't think this can ever be a can't close. If so, this will report an
1362 // assertion but it will keep doing whatever it does.
1363 If (IsComObjectCreated(ghoCrystalReportServer)) Begin
1364 Get ComCanClose of ghoCrystalReportServer to bCanClose
1365 If not bCanClose Begin
1366 Error DFERR_CRYSTAL_REPORT "Assert: Cannot close crystal application object"
1367 End
1368 End
1369
1370 Send ReleaseComObject of ghoCrystalReportServer
1371 End
1372 End_Procedure // DestroyReportObject
1373
1374 Procedure CloseReport
1375 Send DestroyReportObject
1376 End_Procedure // CloseReport
1377
1378 Procedure RunReport
1379 Boolean bOK
1380 Set pbHasErrors to false
1381 // direct to local error handler
1382 Set Old_Error_Object_id to Error_Object_id
1383 Move self to Error_Object_id
1384
1385 Get OpenReport to bOK
1386 If (bOK) Begin
1387 Send OutputReport
1388 Send CloseReport
1389 End
1390
1391 // restore error handler
1392 Get Old_Error_Object_id to Error_Object_id
1393 End_Procedure // RunReport
1394
1395 // when RunReport is called, errors are directed here.
1396 { MethodType=Event Visibility=Private }
1397 Procedure Error_Report integer ErrNum integer iErrLine string ErrMsg
1398 Handle hoError
1399 Boolean bCancelOnError
1400 If (error_processing_state(self)=False) Begin
1401 Set Error_processing_State to True // prevents recursion
1402 Set pbHasErrors to True // an error has occurred in the report
1403 If (Display_Error_State(self)) Begin // if we display, direct to old error object
1404 Get Old_Error_Object_Id to hoError
1405 Send Error_Report of (if(hoError, hoError, desktop)) ErrNum iErrLine ErrMsg
1406 End
1407 If (pbCancelIfError(self)) begin
1408 Set pbCanceled to True
1409 End
1410 Send onError ErrNum iErrLine ErrMsg
1411 Set Error_processing_State to False
1412 End
1413 End_procedure // Error_Report
1414
1415 // Event called by Error_Report. For augmentation.
1416 { MethodType=Event }
1417 Procedure OnError integer ErrNum integer iErrLine string ErrMsg
1418 End_procedure // OnError
1419
1420 Function CrystalString String sVal Returns String
1421 String sNewVal sHold
1422 If (Not(Pos('"', sVal))) Function_Return ('"'+sVal+'"')
1423 If (Not(Pos("'", sVal))) Function_Return ("'"+sVal+"'")
1424 Move '"' To sNewVal
1425 While (Pos('"', sVal))
1426 Move (Left(sVal, (Pos('"', sVal)-1))) To sHold
1427 Move (Replace((sHold+'"'), sVal, "")) To sVal
1428 If (sNewVal <> '"') Append sNewVal '+"'
1429 Append sNewVal sHold '"' "+'" '"' "'"
1430 Loop
1431 If (Length(sVal)) Append sNewVal '+"' sVal '"'
1432 Function_Return sNewVal
1433 End_Function // CrystalString
1434
1435 Function CrystalInteger Integer iVal Returns String
1436 Function_Return (String(iVal))
1437 End_Function // CrystalInteger
1438
1439 Function CrystalNumber Number nVal Returns String
1440 Integer iDecimalSeparator
1441 String sFormattedNumber
1442 // Crystal requires a string with a decimal point for numeric separator
1443 Get_Attribute DF_DECIMAL_SEPARATOR To iDecimalSeparator
1444 Move (string(nVal)) To sFormattedNumber
1445 Move (Replace (Character (iDecimalSeparator), sFormattedNumber, ".")) To sFormattedNumber
1446 Function_Return sFormattedNumber
1447 End_Function // CrystalNumber
1448
1449 Function CrystalDate DateTime dtVal Returns String
1450 Function_Return ("date(" + string(DateGetYear(dtVal)) + "," + string(DateGetMonth(dtVal)) + "," +string(DateGetDay(dtVal)) +")")
1451 End_Function // CrystalDate
1452
1453 // compatibility methods
1454
1455 { Obsolete=True }
1456 Procedure Run_Report
1457 Send RunReport
1458 End_Procedure // Run_Report
1459
1460 // Get / sets report name
1461 { MethodType=Property Obsolete=True }
1462 Function Report_Name Returns String
1463 Function_Return (psReportName(Self))
1464 End_Function // Report_Name
1465
1466 { MethodType=Property Obsolete=True }
1467 { DesignTime=False }
1468 Procedure Set Report_Name String sReportName
1469 Set psReportName to sReportName
1470 End_Procedure // Set Report_Name
1471
1472 // Gets / Sets report output destination. Will return output device mode of report view if none specified.
1473 { MethodType=Property Obsolete=True }
1474 Function Output_Destination Returns Integer
1475 Function_Return (peOutputDestination(Self))
1476 End_Function // Output_Destination
1477
1478 { MethodType=Property Obsolete=True }
1479 { DesignTime=False }
1480 Procedure Set Output_Destination Integer DevMode
1481 Set peOutputDestination To DevMode
1482 End_Procedure // Set Output_Destination
1483
1484End_Class // cCrystal
1485
1486