1Use Crystal\CheckForCrystal.dg 2Use dfrptvw.pkg 3Use DataDict.pkg 4Use dfRadio.pkg 5Use Windows.pkg 6Use dfCmbFrm.pkg 7Use File_dlg.Pkg 8Use cCrystal.pkg 9Use Customer.DD 10 11DEFERRED_VIEW Activate_oCustomerListCR FOR ; 12; 13Object oCustomerListCR is a ReportView 14 15 // This ReportView is a sample of the use of cCrystal.pkg. This package 16 // allows a connection to Crystal Reports using COM Automation objects. 17 // It is based on Crystal Reports XI or higher. The sample shows a simple 18 // report in which the user can aplly the following actions: 19 // - Adjust the sort order 20 // - Adjust the selection. 21 // - Adjust a formula in the report 22 // - Select the output destination. (Window, Printer, or Disk) 23 24 Set Label to "Customer List" 25 Set Location to 2 3 26 Set Size to 216 380 27 Set piMinSize to 216 380 28 29 Object Customer_DD is a Customer_DataDictionary 30 Send DefineAllExtendedFields 31 End_Object // Customer_DD 32 33 Set Main_DD to Customer_DD 34 Set Server to Customer_DD 35 36 Object oSortOrderRadioGroup is a RadioGroup 37 Set Size to 102 86 38 Set Location to 10 10 39 Set Label to "Sort Order" 40 Object oNumberSortRadio is a Radio 41 Set Label to "Sort by Number" 42 Set Size to 10 65 43 Set Location to 13 10 44 End_Object // oNumberSortRadio 45 46 Object oNameSortRadio is a Radio 47 Set Label to "Sort by Name" 48 Set Size to 10 59 49 Set Location to 27 10 50 End_Object // oNameSortRadio 51 52 Object oDescAscCheckBox is a CheckBox 53 Set Label to "Descending" 54 Set Size to 10 55 55 Set Location to 82 10 56 End_Object // oDescAscCheckBox 57 58 // Adjust the shadow of the boundary groups 59 Procedure AdjustBoundaryShadow Integer iGroupNum 60 Set Enabled_State of oNumberSelGroup to (iGroupNum = 0) 61 Set Enabled_State of oNameSelGroup to (iGroupNum <> 0) 62 End_Procedure // AdjustBoundaryShadow 63 64 // Augemented to setup the output destination of the Crystal 65 // Report. The procedure is sent when the user changes the 66 // selection. 67 Procedure Notify_Select_State Integer iNewItem Integer iOldItem 68 Forward Send Notify_Select_State iNewItem iOldItem 69 70 // Dynamically shadow the boundary groups 71 Send AdjustBoundaryShadow iNewItem 72 End_Procedure // Notify_Select_State 73 74 // Returns the sort order selected by the user 75 Function IsNameOrder Returns Boolean 76 Integer iCurrent 77 Get Current_radio to iCurrent 78 Function_Return (iCurrent=1) 79 End_Function // IsNameOrder 80 81 // Returns if the sort order is descending or ascending 82 Function IsDesc Returns Boolean 83 Boolean bChecked 84 Get Checked_state of oDescAscCheckBox to bChecked 85 Function_Return bChecked 86 End_Function // IsDesc 87 88 End_Object // oSortOrderRadioGroup 89 90 Object oNumberSelGroup is a Group 91 Set Size to 49 275 92 Set Location to 10 101 93 Set Label to "Number Criteria" 94 Object oStartCustNumber is a Form 95 Set Label to "Start reporting at number:" 96 Set Size to 13 85 97 Set Location to 10 92 98 Set Label_Col_Offset to 2 99 Set Label_Justification_Mode to jMode_Right 100 Set Form_DataType to 0 101 Set Prompt_Button_Mode to pb_PromptOn 102 103 // The following code connects the customer selection list to this form 104 Set Prompt_Object to Customer_sl 105 106 // this is called by the prompt list upon initialization. This will let us 107 // set special properties for the list's one time use. In this case we 108 // want the intial column and the export column to be name (col 0) 109 Procedure Prompt_Callback Integer hPrompt 110 Set peUpdateMode of hPrompt to umPromptValue 111 Set piUpdateColumn of hPrompt to 0 112 End_Procedure 113 114 115 End_Object // oStartCustNumber 116 117 Object oEndCustNumber is a Form 118 Set Label to "Stop reporting at number:" 119 Set Size to 13 85 120 Set Location to 26 92 121 Set Label_Col_Offset to 2 122 Set Label_Justification_Mode to jMode_Right 123 Set Form_DataType to 0 124 Set Prompt_Button_Mode to pb_PromptOn 125 126 // The following code connects the customer selection list to this form 127 Set Prompt_Object to Customer_sl 128 129 // this is called by the prompt list upon initialization. This will let us 130 // set special properties for the list's one time use. In this case we 131 // want the intial column and the export column to be number (col 0) 132 Procedure Prompt_Callback Integer hPrompt 133 Set peUpdateMode of hPrompt to umPromptValue 134 Set piUpdateColumn of hPrompt to 0 135 End_Procedure 136 137 End_Object // oEndCustNumber 138 139 140 // The start customer number 141 Function StartNumber Returns Integer 142 Integer iValue 143 Get Value of oStartCustNumber to iValue 144 Function_Return iValue 145 End_Function // StartNumber 146 147 // The end customer number 148 Function EndNumber Returns Integer 149 Integer iValue 150 Get Value of oEndCustNumber to iValue 151 Function_Return iValue 152 End_Function // StartNumber 153 154 End_Object // oNumberSelGroup 155 156 Object oNameSelGroup is a Group 157 Set Size to 49 275 158 Set Location to 63 101 159 Set Label to "Name Criteria" 160 Object oStartCustName is a Form 161 Set Label to "Start reporting at customer:" 162 Set Size to 13 178 163 Set Location to 10 92 164 Set Label_Col_Offset to 2 165 Set Label_Justification_Mode to jMode_Right 166 Set Prompt_Button_Mode to pb_PromptOn 167 168 // The following code connects the customer selection list to this form 169 Set Prompt_Object to Customer_sl 170 171 // this is called by the prompt list upon initialization. This will let us 172 // set special properties for the list's one time use. In this case we 173 // want the intial column and the export column to be name (col 1) 174 Procedure Prompt_Callback Integer hPrompt 175 Set peUpdateMode of hPrompt to umPromptValue 176 Set piUpdateColumn of hPrompt to 1 177 End_Procedure 178 179 End_Object // oStartCustName 180 181 Object oEndCustName is a Form 182 Set Label to "End reporting at customer:" 183 Set Size to 13 178 184 Set Location to 26 92 185 Set Label_Col_Offset to 2 186 Set Label_Justification_Mode to jMode_Right 187 Set Prompt_Button_Mode to pb_PromptOn 188 189 // The following code connects the customer selection list to this form 190 Set Prompt_Object to Customer_sl 191 192 // this is called by the prompt list upon initialization. This will let us 193 // set special properties for the list's one time use. In this case we 194 // want the intial column and the export column to be name (col 1) 195 Procedure Prompt_Callback Integer hPrompt 196 Set peUpdateMode of hPrompt to umPromptValue 197 Set piUpdateColumn of hPrompt to 1 198 End_Procedure 199 200 End_Object // oEndCustName 201 202 203 // The start customer name 204 Function StartCustomer Returns String 205 String sName 206 Get Value of oStartCustName to sName 207 Function_Return sName 208 End_Function // StartCustomer 209 210 // The end customer name 211 Function EndCustomer Returns String 212 String sName 213 Get Value of oEndCustName to sName 214 Function_Return sName 215 End_Function // StartCustomer 216 217 End_Object // oNameSelGroup 218 219 Object oDestRadioGroup is a RadioGroup 220 Set Size to 76 122 221 Set Location to 116 10 222 Set Label to "Output destination" 223 Object oWindowRadio is a Radio 224 Set Label to "Print to Window" 225 Set Size to 10 67 226 Set Location to 17 10 227 End_Object // oWindowRadio 228 229 Object oPrinterRadio is a Radio 230 Set Label to "Print to Printer" 231 Set Size to 10 61 232 Set Location to 31 10 233 End_Object // oPrinterRadio 234 235 Object oExportFileRadio is a Radio 236 Set Label to "Export to File" 237 Set Size to 10 57 238 Set Location to 46 10 239 End_Object // oExportFileRadio 240 241 Object oExportOptionsRadio is a Radio 242 Set Label to "Prompt for Export Options" 243 Set Size to 10 97 244 Set Location to 60 10 245 End_Object // oExportOptionsRadio 246 247 248 // Augemented to setup the output destination of the Crystal 249 // Report. The procedure is sent when the user changes the 250 // selection. 251 Procedure Notify_Select_State Integer iNewItem Integer iOldItem 252 Forward Send Notify_Select_State iNewItem iOldItem 253 Set Enabled_State of oFileTypeGroup to (iNewItem = 2) 254 End_Procedure 255 256 Enum_List 257 Define rdWindow 258 Define rdPrinter 259 Define rdExport 260 Define rdExportPrompt 261 End_Enum_List 262 263 Function ReportDestination Returns Integer 264 Integer iVal 265 Get Current_Radio to iVal 266 If (iVal = 0) Function_Return rdWindow 267 Else If (iVal = 1) Function_Return rdPrinter 268 Else If (iVal = 2) Function_Return rdExport 269 Else Function_Return rdExportPrompt 270 End_Function // ReportDestination 271 272 End_Object // oDestRadioGroup 273 274 Object oFileTypeGroup is a Group 275 Set Size to 76 238 276 Set Location to 116 137 277 Set Label to "Export File Settings" 278 Object oFileNameForm is a Form 279 Set Label to "File Name:" 280 Set Size to 13 131 281 Set Location to 13 48 282 Set Label_Col_Offset to 2 283 Set Label_Justification_Mode to jMode_Right 284 Set Prompt_Button_Mode to pb_PromptOn 285 286 // Default item value 287 Set Value to "Custlst.doc" 288 289 // Send when the prompt key is pressed, start selection list 290 Procedure Prompt 291 String sSelectedFile 292 String sExtension 293 String sFilter 294 Integer iType 295 Integer iSelected 296 297 // Setup initial file name 298 Get Value to sSelectedFile 299 If (sSelectedFile="") Begin 300 Get FileExt of oTypeCombo to sExtension 301 Move ("CustLst" + sExtension) to sSelectedFile 302 End 303 304 // Create a filter for the save as dialog 305 Get FileType of oTypeCombo to iType 306 If (iType=crEFTWordForWindows) Move "Word (*.doc)|*.doc" to sFilter 307 Else If (iType=crEFTPortableDocFormat) Move "Adobe PDF (*.doc)|*.doc" to sFilter 308 Else If (iType=crEFTExactRichText) Move "Rich Text (*.rtf)|*.rtf" to sFilter 309 Else If (iType=crEFTHTML40) Move "HTML (*.html)|*.html" to sFilter 310 Else If (iType=crEFTXML) Move "XML (*.xml)|*.xml" to sFilter 311 312 Move (sFilter + "|All Files|*.*") to sFilter 313 314 Set Filter_String of oNewDialog to sFilter 315 Set File_Title of oNewDialog to sSelectedFile 316 317 // Start the save as dialog 318 Get Show_Dialog of oNewDialog to iSelected 319 If iSelected Begin 320 Get File_Name of oNewDialog to sSelectedFile 321 Set Value to sSelectedFile 322 End 323 End_Procedure // Start_Prompt 324 325 // Returns the name of the file to export to 326 Function FileName Returns String 327 String sSelectedFile sExt 328 329 // Get file name 330 Get Value to sSelectedFile 331 If (sSelectedFile="") Begin 332 Get FileExt of oTypeCombo to sExt 333 Move ("Custlst"-sExt) to sSelectedFile 334 End 335 Function_Return sSelectedFile 336 End_Function // FileName 337 338 End_Object // oFileNameForm 339 340 Object oTypeCombo is a ComboForm 341 Set Label to "File Type:" 342 Set Size to 13 131 343 Set Location to 29 48 344 Set Form_Border to 0 345 Set Label_Col_Offset to 2 346 Set Label_Justification_Mode to jMode_Right 347 Set Combo_Sort_State to False 348 Set Entry_State to False 349 350 // Augmented to fill the list with export file types. 351 Procedure Combo_Fill_List 352 Send Combo_Add_Item "Word" // 0 353 Send Combo_Add_Item "Adobe PDF" // 1 354 Send Combo_Add_Item "Rich Text Format" // 2 355 Send Combo_Add_Item "HTML" // 3 356 Send Combo_Add_Item "XML" // 4 357 End_Procedure // Combo_Fill_List 358 359 // Type to export to 360 Function FileType Returns Integer 361 String sFileTypeName 362 Integer iFileTypeValue 363 Integer iSelectedItem 364 365 Get Value 0 to sFileTypeName 366 Get Combo_Item_Matching sFileTypeName to iSelectedItem 367 If (iSelectedItem=0) Move crEFTWordForWindows to iFileTypeValue 368 Else If (iSelectedItem=1) Move crEFTPortableDocFormat to iFileTypeValue 369 Else If (iSelectedItem=2) Move crEFTExactRichText to iFileTypeValue 370 Else If (iSelectedItem=3) Move crEFTHTML40 to iFileTypeValue 371 Else Move crEFTXML to iFileTypeValue 372 373 Function_Return iFileTypeValue 374 End_Function // FileType 375 376 // Function: FileExt 377 // Purpose : Extension for the type to export to 378 Function FileExt Returns String 379 String sFileTypeExt 380 Integer iFileTypeValue 381 382 Get FileType to iFileTypeValue 383 If (iFileTypeValue=crEFTWordForWindows) Move ".doc" to sFileTypeExt 384 Else If (iFileTypeValue=crEFTPortableDocFormat) Move ".pdf" to sFileTypeExt 385 Else If (iFileTypeValue=crEFTExactRichText) Move ".rtf" to sFileTypeExt 386 Else If (iFileTypeValue=crEFTHTML40) Move ".html" to sFileTypeExt 387 Else Move ".xml" to sFileTypeExt 388 389 Function_Return sFileTypeExt 390 End_Function // FileExt 391 392 // Function: ChangeExtension 393 // Purpose : Must extension be dynamically updated? 394 Function ChangeExtension Returns Integer 395 Function_Return (Checked_State(oApplyExtCheckBox)) 396 End_Function // ChangeExtension 397 398 // Procedure: OnCloseUp 399 // Purpose : Augemented to auto,matically change the extension of the 400 // filename 401 Procedure OnChange 402 String sOldName 403 String sExtension 404 Integer sChangeExt 405 406 Get ChangeExtension to sChangeExt 407 If sChangeExt Begin 408 Get FileName of oFileNameForm to sOldName 409 Get FileExt to sExtension 410 Set Value of oFileNameForm to (Left(sOldName, (Pos(".", sOldName) - 1)) + sExtension) 411 End 412 End_Procedure // OnChange 413 414 End_Object // oTypeCombo 415 416 Object oApplyExtCheckBox is a CheckBox 417 Set Label to "Apply combo extension" 418 Set Size to 10 89 419 Set Location to 46 48 420 421 // Apply extensions by default 422 Set Checked_State to True 423 424 End_Object // oApplyExtCheckBox 425 426 Object oNewDialog is a SaveAsDialog 427 Set Dialog_Caption to "Customer report export to disk, give file name" 428 Set HideReadOnly_State to True 429 430 End_Object // oNewDialog 431 432 End_Object // oFileTypeGroup 433 434 Object oRunButton is a Button 435 Set Label to "Run Report" 436 Set Size to 14 51 437 Set Location to 198 271 438 Set Default_State to True 439 440 Procedure OnClick 441 Boolean bCrystalOK 442 443 Get CheckCrystalEnvironment of oCheckForCrystal to bCrystalOK 444 If (bCrystalOK) Begin 445 Send RunReport of oCustCrystalReport 446 End 447 Else Begin 448 Send DisplayDialog of oCheckForCrystal 449 End 450 451 End_Procedure // OnClick 452 453 End_Object // oRunButton 454 455 Object oCancelButton is a Button 456 Set Label to "Cancel" 457 Set Location to 198 325 458 459 Procedure OnClick 460 Send Request_Cancel 461 End_Procedure // OnClick 462 463 End_Object // oCancelButton 464 465 Object oCustCrystalReport is a cCrystal 466 Set psReportName to "CustomerList.rpt" 467 468 // Procedure: OnInitializeReport 469 // Purpose : This is a hook message sent by the Open_report procedure. You may use this 470 // procedure to set selection values, print options, etc. This procedure is 471 // intended for augmentation; it has no action by default. 472 Procedure OnInitializeReport Handle hoReport 473 String sStartCust sEndCust sSelection 474 Integer iStartCustomerNumber iEndCustomerNumber iSortDirection 475 Integer eDest eOutputDestination 476 Boolean bDesc bSortByName 477 478 Get ReportDestination of oDestRadioGroup to eDest 479 If (eDest=rdWindow) Move Print_to_Window to eOutputDestination 480 Else If (eDest=rdPrinter) Move Print_to_Printer to eOutputDestination 481 Else Move Print_to_File to eOutputDestination 482 483 Set peOutputDestination to eOutputDestination 484 485 Get IsNameOrder of oSortOrderRadioGroup to bSortByName 486 Get IsDesc of oSortOrderRadioGroup to bDesc 487 488 // Setup the selection formula 489 Move "" to sSelection 490 If (bSortByName) Begin 491 // Set a selection formula for the report. 492 Get StartCustomer of oNameSelGroup to sStartCust 493 Get EndCustomer of oNameSelGroup to sEndCust 494 495 If (Trim(sStartCust)<>"") ; 496 Append sSelection "{Customer.Name} >= " '"' (Trim(sStartCust)) '"' 497 If (Trim(sEndCust)<>"") ; 498 Append sSelection (If(sSelection<>"", " and ", "")) "{Customer.Name} <= " '"' (Trim(sEndCust)) '"' 499 End 500 Else Begin 501 Get StartNumber of oNumberSelGroup to iStartCustomerNumber 502 Get EndNumber of oNumberSelGroup to iEndCustomerNumber 503 504 If (iStartCustomerNumber>0) ; 505 Append sSelection "{Customer.Customer_Number} >= " iStartCustomerNumber 506 If (iEndCustomerNumber>0) ; 507 Append sSelection (If(sSelection<>"", " and ", "")) "{Customer.Customer_Number} <= " iEndCustomerNumber 508 End 509 Set ComRecordSelectionFormula of hoReport to sSelection 510 511 // Change the formula so the report reflects the selection. Remove 512 // quotes from the formula. 513 If (sSelection="") ; 514 Send AssignFormula of hoReport "SelTxt" ('"' + "NONE" + '"') 515 Else ; 516 Send AssignFormula of hoReport "SelTxt" ('"' + (Replaces('"', sSelection, "")) + '"') 517 518 // Delete old sort order 519 Send DeleteSortOrder of hoReport 520 521 // Setup new sort order 522 Move (If(bDesc, crDescendingOrder, crAscendingOrder)) to iSortDirection 523 524 If (bSortByName) Begin 525 Send AppendSortField of hoReport "Customer" "Name" iSortDirection 526 End 527 Else Begin 528 Send AppendSortField of hoReport "Customer" "Customer_Number" iSortDirection 529 End 530 531 End_Procedure // OnInitializeReport 532 533 Procedure OnPrintReport Handle hoReport 534 // prompt to set-up printer 535 Forward Send OnPrintReport hoReport 536 537 Set pbPrinterPrompt of hoReport to True 538 End_Procedure // OnPrintReport 539 540 Procedure OnExportReport Handle hoReport 541 String sFileName 542 Integer iFileType eDest 543 Handle hoExport 544 Boolean bExists 545 546 Forward Send OnExportReport hoReport 547 548 // Export object receives export information 549 Get ExportObject of hoReport to hoExport 550 551 Get ReportDestination of oDestRadioGroup to eDest 552 553 // Use Export Options on Screen 554 // if rdExportPrompt, it will already just do a prompt. 555 // if rdExport we must set all the values 556 If (eDest=rdExport) Begin 557 558 // don't prompt for export information, we will set it below. 559 Set pbExportPrompt of hoReport to False 560 561 Get FileName of oFileNameForm to sFileName 562 Get FileType of oTypeCombo to iFileType 563 564 // Where the report is being exported to, and what type of 565 // file is being created. 566 Set ComDestinationType of hoExport to crEDTDiskFile 567 Set ComFormatType of hoExport to iFileType 568 569 //Sample for export to disk file (word) 570 If (iFileType=crEFTWordForWindows) Begin 571 Set ComDiskFileName of hoExport to sFileName 572 End 573 //Sample for export to disk file (pdf) 574 If (iFileType=crEFTPortableDocFormat) Begin 575 Set ComDiskFileName of hoExport to sFileName 576 End 577 //Sample for export to disk file (rtf) 578 If (iFileType=crEFTExactRichText) Begin 579 Set ComDiskFileName of hoExport to sFileName 580 End 581 //Sample for export to disk file (XML) 582 If (iFileType=crEFTXML) Begin 583 Set ComXMLFileName of hoExport to sFileName 584 End 585 //Sample for export to disk file (HTML) 586 If (iFileType=crEFTHTML40) Begin 587 Set ComHTMLFileName of hoExport to sFileName 588 End 589 End 590 End_Procedure // OnExportReport 591 592 End_Object // oCustCrystalReport 593 594CD_End_Object // oCustomerListCR