inc/method/m-txtrep.i

   1 &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12
   2 &ANALYZE-RESUME
   3 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Method-Library
   4 /*--------------------------------------------------------------------------
   5     Library     : m-txtrep.i
   6     Purpose     : Methods for producing text-based reports
   7     Author(s)   : Andrew McMillan
   8     Notes       : m-rbrun.i is included to get the correct printer name.
   9   ------------------------------------------------------------------------*/
  10
  11 DEF VAR txtrep-print-file AS CHAR NO-UNDO.
  12 DEF VAR txtrep-control-file AS CHAR NO-UNDO.
  13 DEF VAR txtrep-file-suffix AS CHAR NO-UNDO INITIAL ".TMP".
  14 DEF VAR txtrep-prefix AS CHAR INITIAL "REP" NO-UNDO.
  15 DEF VAR txtrep-preview-window AS HANDLE NO-UNDO.
  16 DEF VAR txtrep-printer AS CHAR NO-UNDO.
  17 DEF VAR txtrep-delim AS CHAR INITIAL "~\" NO-UNDO.
  18 DEF VAR txtrep-output-mode AS CHAR INITIAL "txtrep" NO-UNDO.
  19 DEF VAR txtrep-email-address AS CHAR NO-UNDO.
  20
  21 DEF VAR pclrep-delimiter    AS CHAR NO-UNDO INITIAL "|".
  22 DEF VAR pclrep-font-text    AS CHAR NO-UNDO.
  23 DEF VAR pclrep-font-code    AS CHAR NO-UNDO.
  24 DEF VAR pclrep-font-height  AS CHAR NO-UNDO.
  25 DEF VAR pclrep-font-cols    AS CHAR NO-UNDO.
  26 DEF VAR pclrep-current-font AS INT NO-UNDO INITIAL ?.
  27 DEF VAR pclrep-current-font-height AS DEC NO-UNDO.
  28
  29 DEF VAR pclrep-page-number   AS INT NO-UNDO INITIAL 0.
  30 DEF VAR pclrep-page-position AS DEC NO-UNDO INITIAL 0.
  31 DEF VAR pclrep-page-height   AS DEC NO-UNDO.
  32 DEF VAR pclrep-preview-mode  AS LOGICAL NO-UNDO.
  33 DEF VAR pclrep-between-pages AS LOGICAL NO-UNDO INITIAL No.
  34
  35 DEF VAR pclrep-footer-height AS DEC NO-UNDO.
  36
  37 DEF VAR htmlrep-browser      AS CHAR NO-UNDO INITIAL 'START C:~\Program Files~\Internet Explorer~\iexplore.exe'.
  38
  39 DEF VAR wine-printing AS LOGICAL NO-UNDO INITIAL NO.
  40 DEF VAR apms-spool AS CHAR NO-UNDO.
  41
  42 {inc/ofc-this.i}
  43 {inc/ofc-set-l.i "Windows-Printing" "windows-printing"}
  44
  45 IF OPSYS = "UNIX" THEN DO:
  46   txtrep-delim = "/".
  47   windows-printing = No.
  48 END.
  49
  50 apms-spool = OS-GETENV( "APMSSPOOL" ).
  51 IF apms-spool NE ? AND apms-spool NE "" THEN DO:
  52     wine-printing = YES.
  53     htmlrep-browser = 'xxiexplore.exe'.
  54 END.
  55
  56 {inc/ofc-set.i "PDF-Output-Directory" "pdf-output-directory"}
  57 IF NOT AVAILABLE(OfficeSetting) THEN
  58     pdf-output-directory = "".
  59
  60 /* _UIB-CODE-BLOCK-END */
  61 &ANALYZE-RESUME
  62
  63
  64 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  65
  66 /* ********************  Preprocessor Definitions  ******************** */
  67
  68
  69
  70 /* _UIB-PREPROCESSOR-BLOCK-END */
  71 &ANALYZE-RESUME
  72
  73
  74 /* ************************  Function Prototypes ********************** */
  75
  76 &IF DEFINED(EXCLUDE-htmlrep-style) = 0 &THEN
  77
  78 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD htmlrep-style Method-Library
  79 FUNCTION htmlrep-style RETURNS CHARACTER
  80   ( INPUT sname AS CHAR, INPUT sformat AS CHAR )  FORWARD.
  81
  82 /* _UIB-CODE-BLOCK-END */
  83 &ANALYZE-RESUME
  84
  85 &ENDIF
  86
  87 &IF DEFINED(EXCLUDE-pclrep-test-bottom) = 0 &THEN
  88
  89 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD pclrep-test-bottom Method-Library
  90 FUNCTION pclrep-test-bottom RETURNS LOGICAL
  91   ( INPUT lines AS DECIMAL )  FORWARD.
  92
  93 /* _UIB-CODE-BLOCK-END */
  94 &ANALYZE-RESUME
  95
  96 &ENDIF
  97
  98 &IF DEFINED(EXCLUDE-tag) = 0 &THEN
  99
 100 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD tag Method-Library
 101 FUNCTION tag RETURNS CHARACTER
 102   ( INPUT tagtype AS CHAR, INPUT tagtext AS CHAR, INPUT attributes AS CHAR )  FORWARD.
 103
 104 /* _UIB-CODE-BLOCK-END */
 105 &ANALYZE-RESUME
 106
 107 &ENDIF
 108
 109
 110 /* *********************** Procedure Settings ************************ */
 111
 112 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
 113 /* Settings for THIS-PROCEDURE
 114    Type: Method-Library
 115    Allow:
 116    Frames: 0
 117    Add Fields to: Neither
 118    Other Settings: INCLUDE-ONLY
 119  */
 120 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
 121
 122 /* *************************  Create Window  ************************** */
 123
 124 &ANALYZE-SUSPEND _CREATE-WINDOW
 125 /* DESIGN Window definition (used by the UIB)
 126   CREATE WINDOW Method-Library ASSIGN
 127          HEIGHT             = .45
 128          WIDTH              = 30.86.
 129 /* END WINDOW DEFINITION */
 130                                                                         */
 131 &ANALYZE-RESUME
 132
 133 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB Method-Library
 134 /* ************************* Included-Libraries *********************** */
 135
 136 {inc/method/m-bqmgr.i}
 137 {src/adm/method/attribut.i}
 138 {inc/string.i}
 139
 140 /* _UIB-CODE-BLOCK-END */
 141 &ANALYZE-RESUME
 142
 143
 144
 145
 146
 147 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Method-Library
 148
 149
 150 /* ***************************  Main Block  *************************** */
 151
 152 RUN txtrep-initialise.
 153
 154 /* _UIB-CODE-BLOCK-END */
 155 &ANALYZE-RESUME
 156
 157
 158 /* **********************  Internal Procedures  *********************** */
 159
 160 &IF DEFINED(EXCLUDE-copy-to-printer) = 0 &THEN
 161
 162 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE copy-to-printer Method-Library
 163 PROCEDURE copy-to-printer :
 164 /*------------------------------------------------------------------------------
 165   Purpose:  Run a command to copy the report to the printer.
 166 ------------------------------------------------------------------------------*/
 167 DEF VAR temp-bat AS CHAR INITIAL "." NO-UNDO.
 168 DEF VAR dir-name AS CHAR NO-UNDO.
 169 DEF VAR control-name AS CHAR NO-UNDO.
 170 DEF VAR print-name AS CHAR NO-UNDO.
 171
 172 DEF VAR cmd AS CHAR NO-UNDO.
 173 DEF VAR prt-ctrl AS CHAR NO-UNDO.
 174 DEF VAR rows   AS INT NO-UNDO.
 175 DEF VAR cols AS INT NO-UNDO.
 176
 177   IF windows-printing THEN DO:
 178     OUTPUT TO PRINTER PAGE-SIZE 0.
 179     INPUT FROM VALUE(txtrep-control-file) BINARY.
 180     /* Read from control file and output to printer */
 181     REPEAT:
 182       IMPORT UNFORMATTED prt-ctrl.
 183       PUT CONTROL prt-ctrl.
 184     END.
 185     INPUT CLOSE.
 186     INPUT FROM VALUE(txtrep-print-file) BINARY.
 187     /* Read from print file and output to printer */
 188     REPEAT:
 189       IMPORT UNFORMATTED prt-ctrl.
 190       PUT CONTROL prt-ctrl.
 191     END.
 192     INPUT CLOSE.
 193   END.
 194   ELSE DO:
 195     /* Make sure that the printer is reset after the job */
 196     OUTPUT TO VALUE(txtrep-print-file) APPEND.
 197     RUN make-control-string( "PCL", 'reset,portrait,a4', OUTPUT prt-ctrl, OUTPUT rows, OUTPUT cols ).
 198     PUT CONTROL prt-ctrl.
 199     OUTPUT CLOSE.
 200
 201     /* calculate name of temporary batch file */
 202     IF SESSION:TEMP-DIRECTORY <> ? THEN temp-bat = SESSION:TEMP-DIRECTORY.
 203     IF LENGTH(temp-bat) <> R-INDEX( temp-bat, txtrep-delim) THEN temp-bat = temp-bat + txtrep-delim.
 204     temp-bat = temp-bat + "PrgPrint.BAT".
 205
 206     dir-name = SUBSTRING( txtrep-print-file, 1, R-INDEX(txtrep-print-file, txtrep-delim) ).
 207     control-name = SUBSTRING( txtrep-control-file, R-INDEX(txtrep-control-file, txtrep-delim) + 1 ).
 208     print-name = SUBSTRING( txtrep-print-file, R-INDEX(txtrep-print-file, txtrep-delim) + 1 ).
 209
 210     IF OPSYS = "UNIX" THEN DO:
 211       /* dir-name = REPLACE( dir-name, txtrep-delim, "/" ). */
 212       OS-COMMAND SILENT VALUE(
 213             "cat " + dir-name + control-name + " " + dir-name + print-name
 214                    + " | tee /tmp/lastrep.pcl "
 215                    + " | apms_lpr " + txtrep-printer ).
 216     END.
 217     ELSE DO:
 218       cmd = 'PP "' + txtrep-printer + '" ' + dir-name + ' ' + control-name + " " + print-name.
 219       /* MESSAGE cmd VIEW-AS ALERT-BOX. */
 220
 221       OUTPUT TO VALUE(temp-bat).
 222       IF txtrep-output-mode <> "pdf" THEN DO:
 223           IF wine-printing THEN DO:
 224               OS-RENAME VALUE(txtrep-control-file) VALUE(apms-spool + control-name).
 225               OS-RENAME VALUE(txtrep-print-file) VALUE(apms-spool + print-name).
 226               OUTPUT TO VALUE(apms-spool + "print.list") APPEND.
 227               PUT UNFORMATTED control-name " " + print-name + "~n".
 228               OUTPUT CLOSE.
 229           END.
 230           ELSE DO:
 231               PUT UNFORMATTED cmd + "~n".
 232               PUT UNFORMATTED "COPY /B " + dir-name + control-name + " + " + dir-name + print-name + " " + dir-name + 'lastrep.pcl~n'.
 233               OUTPUT CLOSE.
 234
 235               OS-COMMAND SILENT VALUE(temp-bat).
 236           END.
 237       END.
 238     END.
 239   END.
 240
 241 END PROCEDURE.
 242
 243 /* _UIB-CODE-BLOCK-END */
 244 &ANALYZE-RESUME
 245
 246 &ENDIF
 247
 248 &IF DEFINED(EXCLUDE-get-current-printer) = 0 &THEN
 249
 250 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE get-current-printer Method-Library
 251 PROCEDURE get-current-printer :
 252 /*------------------------------------------------------------------------------
 253   Purpose:     Set the value of txtrep-printer to reflect the current printer.
 254 ------------------------------------------------------------------------------*/
 255 DEF BUFFER CurrPrinter FOR RP.
 256
 257   DEF VAR user-name AS CHAR NO-UNDO.
 258   {inc/username.i "user-name"}
 259
 260   FIND FIRST CurrPrinter WHERE
 261     CurrPrinter.UserName = user-name AND
 262     CurrPrinter.ReportID = "Current Printer" NO-LOCK NO-ERROR.
 263
 264   IF NOT AVAILABLE CurrPrinter THEN
 265   DO:
 266     DEF VAR printer-name AS CHAR NO-UNDO.  /* we don't use this value */
 267     DEF VAR success AS LOGI NO-UNDO.
 268
 269     printer-name = SESSION:PRINTER-NAME.
 270     txtrep-printer = SESSION:PRINTER-PORT.
 271
 272     CREATE CurrPrinter.
 273     ASSIGN
 274       CurrPrinter.UserName = user-name
 275       CurrPrinter.ReportID = "Current Printer"
 276       CurrPrinter.Char1    = printer-name
 277       CurrPrinter.Char2    = txtrep-printer.
 278
 279     FIND CURRENT CurrPrinter NO-LOCK.
 280   END.
 281
 282   /* Set the value of the port (more useful than printer name for copying to it) */
 283   txtrep-printer = CurrPrinter.Char2.
 284 &IF DEFINED(BQ-MGR) &THEN
 285   IF VALID-HANDLE(bq-mgr) AND CurrPrinter.Char4 <> "" THEN
 286     txtrep-printer = CurrPrinter.Char4.
 287 &ENDIF
 288
 289 END PROCEDURE.
 290
 291 /* _UIB-CODE-BLOCK-END */
 292 &ANALYZE-RESUME
 293
 294 &ENDIF
 295
 296 &IF DEFINED(EXCLUDE-htmlrep-body) = 0 &THEN
 297
 298 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE htmlrep-body Method-Library
 299 PROCEDURE htmlrep-body :
 300 /*------------------------------------------------------------------------------
 301   Purpose:
 302 ------------------------------------------------------------------------------*/
 303 PUT CONTROL "</head>~n<body>~n".
 304
 305 END PROCEDURE.
 306
 307 /* _UIB-CODE-BLOCK-END */
 308 &ANALYZE-RESUME
 309
 310 &ENDIF
 311
 312 &IF DEFINED(EXCLUDE-htmlrep-finish) = 0 &THEN
 313
 314 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE htmlrep-finish Method-Library
 315 PROCEDURE htmlrep-finish :
 316 /*------------------------------------------------------------------------------
 317   Purpose:
 318 ------------------------------------------------------------------------------*/
 319 /* OUTPUT TO VALUE(txtrep-print-file) KEEP-MESSAGES APPEND PAGE-SIZE 0. */
 320 PUT CONTROL "</body~n</html>~n~n".
 321 OUTPUT CLOSE.
 322
 323 /* MESSAGE '"' + htmlrep-browser + '" ' + txtrep-print-file . */
 324
 325 IF apms-spool EQ ? OR apms-spool EQ "" THEN DO:
 326   OS-COMMAND VALUE( htmlrep-browser + '" ' + txtrep-print-file ).
 327 END.
 328
 329 DEF VAR dir-name AS CHAR NO-UNDO.
 330 dir-name = SUBSTRING( txtrep-print-file, 1, R-INDEX(txtrep-print-file, txtrep-delim) ).
 331
 332 /* Save the file so we can see it later */
 333 OS-DELETE VALUE(  dir-name + 'lastrep.html' )  NO-ERROR.
 334 OS-COMMAND SILENT VALUE( 'COPY "' + txtrep-print-file + '" "' + dir-name + 'lastrep.html"~n').
 335
 336 OS-DELETE VALUE( txtrep-control-file )  NO-ERROR.
 337 /*
 338 OS-DELETE VALUE( txtrep-print-file )    NO-ERROR.
 339 */
 340
 341 END PROCEDURE.
 342
 343 /* _UIB-CODE-BLOCK-END */
 344 &ANALYZE-RESUME
 345
 346 &ENDIF
 347
 348 &IF DEFINED(EXCLUDE-htmlrep-start) = 0 &THEN
 349
 350 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE htmlrep-start Method-Library
 351 PROCEDURE htmlrep-start :
 352 /*------------------------------------------------------------------------------
 353   Purpose:
 354 ------------------------------------------------------------------------------*/
 355 DEF INPUT PARAMETER page-title AS CHAR NO-UNDO.
 356
 357 PUT CONTROL '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">~n'
 358   + '<html>~n<head>~n<title>' + page-title + "</title>~n"
 359   + '<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">~n'.
 360
 361     txtrep-output-mode   = "htmlrep".
 362     pclrep-preview-mode  = TRUE.
 363     pclrep-font-text     = "".
 364     pclrep-font-code     = "".
 365     pclrep-font-height   = "0" .
 366     pclrep-current-font-height = 0.
 367     pclrep-font-cols     = "1".
 368     pclrep-current-font  = 1.
 369     pclrep-page-number   = 0.
 370     pclrep-page-position = 0.
 371     pclrep-between-pages = No.
 372
 373 END PROCEDURE.
 374
 375 /* _UIB-CODE-BLOCK-END */
 376 &ANALYZE-RESUME
 377
 378 &ENDIF
 379
 380 &IF DEFINED(EXCLUDE-make-control-string) = 0 &THEN
 381
 382 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE make-control-string Method-Library
 383 PROCEDURE make-control-string :
 384 /*------------------------------------------------------------------------------
 385   Purpose:  Build the control string for the printer.
 386 ------------------------------------------------------------------------------*/
 387 DEF INPUT PARAMETER txtrep-language AS CHAR NO-UNDO. /* currently must be "PCL" */
 388 DEF INPUT PARAMETER txtrep-commands AS CHAR NO-UNDO.  /* comma separated list */
 389 DEF OUTPUT PARAMETER txtrep-ctrl AS CHAR NO-UNDO.
 390 DEF OUTPUT PARAMETER txtrep-rows AS INT NO-UNDO.
 391 DEF OUTPUT PARAMETER txtrep-cols AS INT NO-UNDO.
 392
 393 DEF VAR page-height AS DEC NO-UNDO.
 394 DEF VAR line-height AS DEC NO-UNDO.
 395
 396   CASE txtrep-language:
 397     WHEN "PCL" THEN DO:
 398       RUN pcl-control-string( txtrep-commands, OUTPUT txtrep-ctrl,
 399                      OUTPUT txtrep-cols, OUTPUT line-height, OUTPUT page-height ).
 400       txtrep-rows = INTEGER( (page-height / line-height) - 2.5 ).
 401 /*      MESSAGE line-height SKIP page-height. */
 402     END.
 403     OTHERWISE DO:
 404       MESSAGE "Printer language " + txtrep-language + " is not supported."
 405             VIEW-AS ALERT-BOX ERROR TITLE "Bad Printer Language".
 406     END.
 407   END CASE.
 408
 409 END PROCEDURE.
 410
 411 /* _UIB-CODE-BLOCK-END */
 412 &ANALYZE-RESUME
 413
 414 &ENDIF
 415
 416 &IF DEFINED(EXCLUDE-output-control-file) = 0 &THEN
 417
 418 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE output-control-file Method-Library
 419 PROCEDURE output-control-file :
 420 /*------------------------------------------------------------------------------
 421   Purpose:  Send the output to a file.
 422 ------------------------------------------------------------------------------*/
 423 DEF INPUT PARAMETER txtrep-printer-control AS CHAR NO-UNDO.
 424
 425   OUTPUT TO VALUE(txtrep-control-file) PAGE-SIZE 0.
 426   PUT CONTROL txtrep-printer-control.
 427   OUTPUT CLOSE.
 428
 429 END PROCEDURE.
 430
 431 /* _UIB-CODE-BLOCK-END */
 432 &ANALYZE-RESUME
 433
 434 &ENDIF
 435
 436 &IF DEFINED(EXCLUDE-pcl-control-string) = 0 &THEN
 437
 438 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE pcl-control-string Method-Library
 439 PROCEDURE pcl-control-string :
 440 /*------------------------------------------------------------------------------
 441   Purpose:  Control string for PCL
 442 ------------------------------------------------------------------------------*/
 443 DEF INPUT PARAMETER txtrep-commands AS CHAR NO-UNDO.
 444 DEF OUTPUT PARAMETER txtrep-ctrl AS CHAR NO-UNDO.
 445 DEF OUTPUT PARAMETER txtrep-cols AS INT NO-UNDO.
 446 DEF OUTPUT PARAMETER line-height AS DEC NO-UNDO.
 447 DEF OUTPUT PARAMETER page-height AS DEC NO-UNDO INITIAL 11.25.
 448
 449 DEF VAR i AS INT NO-UNDO.
 450 DEF VAR command AS CHAR NO-UNDO.
 451 DEF VAR no-commands AS INT NO-UNDO.
 452 no-commands = NUM-ENTRIES( txtrep-commands ).
 453
 454 &SCOP NUM-RESULTS 9
 455 DEF VAR result AS CHAR EXTENT {&NUM-RESULTS} INITIAL "" NO-UNDO.
 456
 457 DEF VAR page-width AS DECIMAL INITIAL 7.75 NO-UNDO.
 458 DEF VAR width AS LOGICAL INITIAL yes NO-UNDO.
 459 DEF VAR cpi AS DECIMAL INITIAL 10 NO-UNDO.
 460 DEF VAR lpi AS DECIMAL INITIAL 6 NO-UNDO.
 461 DEF VAR lm AS INTEGER INITIAL 0 NO-UNDO.
 462 DEF VAR tm AS INTEGER INITIAL 0 NO-UNDO.
 463
 464
 465 &IF DEFINED(DEBUG-END) &THEN
 466   debug-event("Printer control command is: " + txtrep-commands ).
 467 &ENDIF
 468
 469   /****  For each command in the txtrep-commands we build up the various components
 470          of the control string  *****************************************/
 471   DO i = 1 TO no-commands:
 472     command = ENTRY( i, txtrep-commands ).
 473     CASE command:
 474       WHEN 'eject'      THEN result[1] = result[1] + "0h".
 475
 476       WHEN 'reset'      THEN ASSIGN
 477         result[2] = "e"
 478         result[4] = result[4] + "0l".
 479
 480       WHEN 'lm'        THEN DO:
 481         i = i + 1.
 482         lm = INTEGER( ENTRY( i, txtrep-commands ) ).
 483         result[5] = result[5] + ENTRY( i, txtrep-commands ) + "l".
 484       END.
 485
 486
 487       WHEN 'a4'         THEN result[4] = result[4] + "26a".
 488       WHEN 'portrait'   THEN ASSIGN
 489             result[4] = result[4] + "0o"      page-width =  7.75    page-height = 11.25 .
 490       WHEN 'landscape'  THEN ASSIGN
 491             result[4] = result[4] + "1o"      page-width = 11.25    page-height =  7.75 .
 492       WHEN 'duplex'     THEN result[4] = result[4] + "1s".
 493       WHEN 'simplex'    THEN result[4] = result[4] + "0s".
 494       WHEN 'short'      THEN result[4] = result[4] + "2s".
 495       WHEN 'bin'        THEN DO:
 496         i = i + 1.
 497         result[4] = result[4] + ENTRY( i, txtrep-commands ) + "h".
 498       END.
 499       WHEN 'lpi'        THEN DO:
 500         i = i + 1.
 501         lpi = INTEGER( ENTRY( i, txtrep-commands ) ) .
 502         /* set vertical motion index */
 503         result[4] = result[4] + STRING( (48 / lpi) ) + "c".
 504       END.
 505       WHEN 'tm'        THEN DO:
 506         i = i + 1.
 507         tm = INTEGER( ENTRY( i, txtrep-commands ) ).
 508         result[4] = result[4] + ENTRY( i, txtrep-commands ) + "e".
 509       END.
 510
 511
 512
 513       WHEN 'courier'    THEN ASSIGN
 514             result[7] = "10U"           result[9] = result[9] + "4099t" .
 515       WHEN 'lineprinter' THEN ASSIGN
 516             result[7] = "10U"
 517             result[8] = result[8] + "0p16.67h8.5v0s0b"
 518             result[9] = result[9] + "0t"    cpi = 16.66     lpi = 8.5 .
 519       WHEN 'times'      THEN ASSIGN
 520             result[7] = "8U"            result[9] = result[9] + "4101t" width = no .
 521       WHEN 'univers'  THEN ASSIGN
 522             result[7] = "8U"            result[9] = result[9] + "4148t" width = no .
 523       WHEN 'helvetica'  THEN ASSIGN
 524             result[7] = "8U"            result[9] = result[9] + "4148t" width = no .
 525       WHEN 'garamond'  THEN ASSIGN
 526             result[7] = "8U"            result[9] = result[9] + "4197t" width = no .
 527       WHEN 'antiqueolive'  THEN ASSIGN
 528             result[8] = result[8] + "1p0s0b"
 529             result[7] = "8U"            result[9] = result[9] + "4168t" width = no .
 530       WHEN 'coronet'  THEN ASSIGN
 531             result[8] = result[8] + "1p1s0b"
 532             result[7] = "8U"            result[9] = result[9] + "4116t" width = no .
 533       WHEN 'marigold'  THEN ASSIGN
 534             result[7] = "8U"            result[9] = result[9] + "4297t" width = no .
 535       WHEN 'albertus'  THEN ASSIGN
 536             result[7] = "8U"            result[9] = result[9] + "4362t" width = no .
 537       WHEN 'omega'  THEN ASSIGN
 538             result[7] = "8U"            result[9] = result[9] + "4113t" width = no .
 539       WHEN 'fixed'          THEN ASSIGN result[8] = result[8] + "0p"   width = yes .
 540       WHEN 'proportional'   THEN ASSIGN result[8] = result[8] + "1p"   width = no .
 541       WHEN 'expanded'       THEN result[8] = result[8] + "24s".
 542       WHEN 'outline'        THEN result[8] = result[8] + "32s".
 543       WHEN 'black'          THEN result[8] = result[8] + "5b".
 544       WHEN 'thin'           THEN result[8] = result[8] + "-5b".
 545       WHEN 'italic'         THEN result[8] = result[8] + "1s".
 546       WHEN 'bold'           THEN result[8] = result[8] + "3b".
 547       WHEN 'light'          THEN result[8] = result[8] + "-3b".
 548       WHEN 'normal'         THEN result[8] = result[8] + "0b0s".
 549       WHEN 'point'     THEN DO:
 550         i = i + 1.
 551         ASSIGN
 552           result[8] = result[8] + ENTRY( i, txtrep-commands ) + "v"
 553           /* 137 is an approximation - w:h scale is dependent on font */
 554           cpi = 137 / INTEGER( ENTRY( i, txtrep-commands ) )
 555           /* 72 is good because that's how 'point' is defined */
 556           lpi = 72 / INTEGER( ENTRY( i, txtrep-commands ) ).
 557       END.
 558       WHEN 'cpi'     THEN DO:
 559         i = i + 1.
 560         ASSIGN
 561           result[8] = result[8] + ENTRY( i, txtrep-commands ) + "h"
 562           cpi = INTEGER( ENTRY( i, txtrep-commands ) ) .
 563       END.
 564
 565     END CASE.
 566
 567   END.
 568
 569
 570   /**** Finally!  We build the printer control string ********************/
 571   txtrep-ctrl = "".
 572   result[8] = result[8] + result[9].
 573   result[9] = "".
 574   DO i = 1 TO {&NUM-RESULTS}:
 575     IF result[i] <> "" THEN DO:
 576       /* Convert trailing letter to caps as end of sequence */
 577       SUBSTRING( result[i], LENGTH(result[i]), 1) =
 578                  CAPS( SUBSTRING( result[i], LENGTH(result[i]), 1) ).
 579       txtrep-ctrl = txtrep-ctrl + "~033".
 580       CASE i:
 581         WHEN 1 THEN txtrep-ctrl = txtrep-ctrl + "&l".   /* eject */
 582         WHEN 2 THEN /* no prefix applies */.    /* reset */
 583         WHEN 3 THEN txtrep-ctrl = txtrep-ctrl + "".     /* not used */
 584         WHEN 4 THEN txtrep-ctrl = txtrep-ctrl + "&l".   /* page characteristics */
 585         WHEN 5 THEN txtrep-ctrl = txtrep-ctrl + "&a".   /* margins (left only) */
 586         WHEN 6 THEN txtrep-ctrl = txtrep-ctrl + "".     /* not used */
 587         WHEN 7 THEN txtrep-ctrl = txtrep-ctrl + "(".    /* symbol set */
 588         WHEN 8 THEN txtrep-ctrl = txtrep-ctrl + "(s".   /* font characteristics */
 589         WHEN 9 THEN /* added onto '4' */ .      /* font */
 590       END CASE.
 591
 592       txtrep-ctrl = txtrep-ctrl + result[i].
 593     END.
 594   END.
 595
 596   /**** Calculate the cols (sometimes this will be garbage!) */
 597   /**** The line-height and page-height is more dependable   */
 598   ASSIGN
 599     txtrep-cols = INT( IF width THEN (cpi * page-width - 0.5) - lm ELSE 9999 )
 600     line-height = 25.4 / lpi
 601     page-height = (page-height * 25.4) - ((tm + 2) * line-height)
 602   .
 603
 604   IF txtrep-output-mode = "pdf" THEN DO:
 605     txtrep-ctrl = "[-pdf-]>CONTROL:" + txtrep-commands + "[-pdf-]".
 606   END.
 607
 608
 609 &IF DEFINED(DEBUG-END) &THEN
 610   debug-event("Printer control string is: " + txtrep-ctrl ).
 611   debug-event("line-height=" + STRING(line-height)
 612          + ",  page-height=" + STRING(page-height)
 613          + ",  txtrep-cols=" + STRING(txtrep-cols)
 614          + ",  cpi=" + STRING(cpi) + ",  lpi=" + STRING(lpi)
 615          + ",  lm=" + STRING(lm) + ",  tm=" + STRING(tm) ).
 616 &ENDIF
 617
 618 END PROCEDURE.
 619
 620 /* _UIB-CODE-BLOCK-END */
 621 &ANALYZE-RESUME
 622
 623 &ENDIF
 624
 625 &IF DEFINED(EXCLUDE-pcl-move-relative) = 0 &THEN
 626
 627 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE pcl-move-relative Method-Library
 628 PROCEDURE pcl-move-relative :
 629 /*------------------------------------------------------------------------------
 630   Purpose:
 631   Parameters:  <none>
 632   Notes:
 633 ------------------------------------------------------------------------------*/
 634
 635   DEF INPUT PARAMETER rows AS DEC NO-UNDO.
 636   DEF INPUT PARAMETER cols AS DEC NO-UNDO.
 637
 638   IF txtrep-output-mode = "pdf" THEN DO:
 639     PUT CONTROL "[-pdf-]>MOVEREL:" + TRIM(STRING( rows, "+>>>>9.99" ) ) + ",".
 640     pclrep-page-position = pclrep-page-position + ( rows * pclrep-current-font-height ).
 641     IF cols <> ? THEN PUT CONTROL TRIM( STRING( cols, "+>>>>9.99" ) ).
 642     PUT CONTROL "[-pdf-]".
 643   END.
 644   ELSE DO:
 645     PUT CONTROL CHR(27) + "&a" + TRIM( STRING( rows, "+>>>>9.99" ) ) + "R".
 646     pclrep-page-position = pclrep-page-position + ( rows * pclrep-current-font-height ).
 647
 648     IF cols = ? THEN
 649       PUT CONTROL CHR(12).
 650     ELSE
 651       PUT CONTROL CHR(27) + "&a" + TRIM( STRING( cols, "+>>>>9.99" ) ) + "C".
 652   END.
 653
 654 END PROCEDURE.
 655
 656 /* _UIB-CODE-BLOCK-END */
 657 &ANALYZE-RESUME
 658
 659 &ENDIF
 660
 661 &IF DEFINED(EXCLUDE-pcl-moveto) = 0 &THEN
 662
 663 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE pcl-moveto Method-Library
 664 PROCEDURE pcl-moveto :
 665 /*------------------------------------------------------------------------------
 666   Purpose:
 667   Parameters:  <none>
 668   Notes:
 669 ------------------------------------------------------------------------------*/
 670
 671   DEF INPUT PARAMETER rows AS DEC NO-UNDO.
 672   DEF INPUT PARAMETER cols AS DEC NO-UNDO.
 673
 674   IF txtrep-output-mode = "pdf" THEN DO:
 675     PUT CONTROL "[-pdf-]>MOVEABS:" + TRIM(STRING( rows, "+>>>>9.99" ) ) + ","
 676                            + TRIM( STRING( cols, "+>>>>9.99" ) ) + "[-pdf-]".
 677   END.
 678   ELSE DO:
 679     PUT CONTROL CHR(27) + "&a" + TRIM( STRING( rows, "->>>>9.99" ) ) + "R".
 680     PUT CONTROL CHR(27) + "&a" + TRIM( STRING( cols, "->>>>9.99" ) ) + "C".
 681   END.
 682   pclrep-page-position = rows * pclrep-current-font-height .
 683
 684 END PROCEDURE.
 685
 686 /* _UIB-CODE-BLOCK-END */
 687 &ANALYZE-RESUME
 688
 689 &ENDIF
 690
 691 &IF DEFINED(EXCLUDE-pclrep-down-by) = 0 &THEN
 692
 693 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE pclrep-down-by Method-Library
 694 PROCEDURE pclrep-down-by :
 695 /*------------------------------------------------------------------------------
 696   Purpose:
 697 ------------------------------------------------------------------------------*/
 698 DEF INPUT PARAMETER rows AS DEC NO-UNDO.
 699
 700   IF pclrep-preview-mode THEN DO:
 701     rows = ROUND( rows, 0).
 702     IF NOT(pclrep-between-pages) AND pclrep-test-bottom( rows ) THEN
 703       RUN pclrep-page-break.        /* footer half */
 704     ELSE IF rows >= 1 THEN DO:
 705       IF NOT(pclrep-between-pages) THEN DO:
 706         IF pclrep-page-position <= 0 THEN RUN pclrep-page-break.   /* header half */
 707       END.
 708       RUN pclrep-line( "", FILL("~n", INT(rows)) ).
 709     END.
 710   END.
 711   ELSE IF NOT(pclrep-between-pages) AND pclrep-test-bottom( rows ) THEN
 712     RUN pclrep-page-break.          /* footer half */
 713   ELSE DO:
 714     IF NOT(pclrep-between-pages) THEN DO:
 715       IF pclrep-page-position <= 0 THEN RUN pclrep-page-break.   /* header half */
 716     END.
 717     PUT CONTROL CHR(27) + "&a" + TRIM( STRING( rows, "+>>>>9.999" ), " 9" ) + "R".
 718     pclrep-page-position = pclrep-page-position + ( rows * pclrep-current-font-height ).
 719   END.
 720
 721 END PROCEDURE.
 722
 723 /* _UIB-CODE-BLOCK-END */
 724 &ANALYZE-RESUME
 725
 726 &ENDIF
 727
 728 &IF DEFINED(EXCLUDE-pclrep-finish) = 0 &THEN
 729
 730 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE pclrep-finish Method-Library
 731 PROCEDURE pclrep-finish :
 732 /*------------------------------------------------------------------------------
 733   Purpose:  Finish running a pclrep report
 734 ------------------------------------------------------------------------------*/
 735
 736  RUN pclrep-page-break.
 737  RUN view-output-file ( pclrep-preview-mode ).
 738
 739 END PROCEDURE.
 740
 741 /* _UIB-CODE-BLOCK-END */
 742 &ANALYZE-RESUME
 743
 744 &ENDIF
 745
 746 &IF DEFINED(EXCLUDE-pclrep-line) = 0 &THEN
 747
 748 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE pclrep-line Method-Library
 749 PROCEDURE pclrep-line :
 750 /*------------------------------------------------------------------------------
 751   Purpose:  Print a line in a selected font
 752 ------------------------------------------------------------------------------*/
 753 DEF INPUT PARAMETER font-text AS CHAR NO-UNDO.
 754 DEF INPUT PARAMETER line-text AS CHAR NO-UNDO.
 755
 756   IF font-text = ? THEN font-text = "".
 757   IF line-text = ? THEN line-text = "".
 758
 759   DEF VAR position-increment AS DEC NO-UNDO.
 760   DEF VAR i AS INT NO-UNDO.
 761
 762 /*  MESSAGE "pclrep-line" pclrep-between-pages pclrep-page-position . */
 763   /* initialisation, or first half of page break, sets page-position to 0 */
 764   IF NOT(pclrep-between-pages) THEN DO:
 765     IF pclrep-page-position <= 0 THEN RUN pclrep-page-break.   /* header half */
 766   END.
 767
 768   RUN pclrep-select-font( font-text ).
 769   position-increment = (IF line-text = "" THEN 1 ELSE NUM-ENTRIES(line-text, "~n")).
 770
 771   IF NOT(pclrep-between-pages) THEN DO:
 772     /* If we're not in a page break we might be over the end of the page */
 773     IF pclrep-test-bottom(position-increment) THEN DO:
 774       RUN pclrep-page-break.        /* footer half */
 775       RUN pclrep-page-break.        /* header half */
 776       RUN pclrep-select-font( font-text ).
 777     END.
 778   END.
 779
 780   IF TRIM(line-text, " ") = "" THEN PUT SKIP(1).
 781   ELSE PUT UNFORMATTED line-text SKIP.
 782   pclrep-page-position = pclrep-page-position + pclrep-current-font-height * position-increment.
 783
 784 END PROCEDURE.
 785
 786 /* _UIB-CODE-BLOCK-END */
 787 &ANALYZE-RESUME
 788
 789 &ENDIF
 790
 791 &IF DEFINED(EXCLUDE-pclrep-page-break) = 0 &THEN
 792
 793 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE pclrep-page-break Method-Library
 794 PROCEDURE pclrep-page-break :
 795 /*------------------------------------------------------------------------------
 796   Purpose:
 797 ------------------------------------------------------------------------------*/
 798   /* This variable turns off the pagination logic so we don't get too recursive */
 799  /* MESSAGE 'page break' pclrep-page-position. */
 800   IF pclrep-page-position > 0 THEN DO:
 801     /* footer half, since we're somewhere on the page... */
 802     pclrep-between-pages = Yes.
 803     RUN inst-page-footer IN THIS-PROCEDURE NO-ERROR.
 804     pclrep-between-pages = No.
 805     PUT CONTROL CHR(12).
 806     pclrep-page-position = 0.
 807     RETURN.
 808   END.
 809
 810   /* otherwise it must be the header half */
 811   pclrep-page-number = pclrep-page-number + 1.
 812
 813   pclrep-between-pages = Yes.
 814   RUN inst-page-header IN THIS-PROCEDURE NO-ERROR.
 815   pclrep-between-pages = No.
 816
 817 END PROCEDURE.
 818
 819 /* _UIB-CODE-BLOCK-END */
 820 &ANALYZE-RESUME
 821
 822 &ENDIF
 823
 824 &IF DEFINED(EXCLUDE-pclrep-paragraph) = 0 &THEN
 825
 826 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE pclrep-paragraph Method-Library
 827 PROCEDURE pclrep-paragraph :
 828 /*------------------------------------------------------------------------------
 829   Purpose:
 830 ------------------------------------------------------------------------------*/
 831 DEF INPUT PARAMETER this-font AS CHAR NO-UNDO.
 832 DEF INPUT PARAMETER s1 AS CHAR NO-UNDO.
 833 DEF INPUT PARAMETER cols AS INT NO-UNDO.
 834 DEF INPUT PARAMETER lm AS INT NO-UNDO.
 835
 836 DEF VAR wrapped AS CHAR NO-UNDO.
 837 DEF VAR i AS INT NO-UNDO.
 838 DEF VAR n AS INT NO-UNDO.
 839
 840   wrapped = WRAP( s1, cols  ).
 841   n = NUM-ENTRIES( wrapped, "~n" ).
 842   DO i = 1 TO n:
 843     RUN pclrep-line( this-font, FILL(" ",lm) + ENTRY( i, wrapped, "~n" ) ).
 844   END.
 845
 846 END PROCEDURE.
 847
 848 /* _UIB-CODE-BLOCK-END */
 849 &ANALYZE-RESUME
 850
 851 &ENDIF
 852
 853 &IF DEFINED(EXCLUDE-pclrep-select-font) = 0 &THEN
 854
 855 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE pclrep-select-font Method-Library
 856 PROCEDURE pclrep-select-font :
 857 /*------------------------------------------------------------------------------
 858   Purpose:  Select a particular font for this (and subsequent) lines.
 859 ------------------------------------------------------------------------------*/
 860 DEF INPUT PARAMETER font-text AS CHAR NO-UNDO.
 861
 862   IF pclrep-preview-mode OR font-text = "" OR font-text = ? THEN RETURN.
 863
 864   IF font-text = ENTRY( pclrep-current-font, pclrep-font-text, pclrep-delimiter) THEN
 865     RETURN.     /* quick check results in nothing to do */
 866
 867   pclrep-current-font = LOOKUP( font-text, pclrep-font-text, pclrep-delimiter).
 868
 869   IF pclrep-current-font = 0 THEN
 870   DO:
 871
 872     /* add into the list */
 873     DEF VAR code AS CHAR NO-UNDO.
 874     DEF VAR cols  AS DEC NO-UNDO.
 875     DEF VAR height AS DEC NO-UNDO.
 876     DEF VAR ignored AS DEC NO-UNDO.
 877
 878     pclrep-current-font = NUM-ENTRIES( pclrep-font-text, pclrep-delimiter ) + 1.
 879     RUN pcl-control-string ( font-text, OUTPUT code, OUTPUT cols,
 880                                                    OUTPUT height, OUTPUT ignored).
 881     IF height < 0.01 THEN height = 1.   /* just to catch wierd conditions */
 882     ASSIGN
 883         pclrep-font-text   = pclrep-font-text   + pclrep-delimiter + font-text
 884         pclrep-font-code   = pclrep-font-code   + pclrep-delimiter + code
 885         pclrep-font-height = pclrep-font-height + pclrep-delimiter + STRING( height )
 886         pclrep-current-font-height = height
 887         pclrep-font-cols   = pclrep-font-cols   + pclrep-delimiter + STRING( cols ).
 888
 889   END.
 890   ELSE
 891     pclrep-current-font-height = DEC(ENTRY( pclrep-current-font, pclrep-font-height, pclrep-delimiter )).
 892
 893   /* Change the font */
 894   IF txtrep-output-mode = "pdf" THEN DO:
 895     PUT CONTROL "[-pdf-]>CONTROL:" + font-text + "[-pdf-]".
 896   END.
 897   ELSE DO:
 898     PUT CONTROL ENTRY( pclrep-current-font, pclrep-font-code, pclrep-delimiter ).
 899   END.
 900
 901 END PROCEDURE.
 902
 903 /* _UIB-CODE-BLOCK-END */
 904 &ANALYZE-RESUME
 905
 906 &ENDIF
 907
 908 &IF DEFINED(EXCLUDE-pclrep-skip-to) = 0 &THEN
 909
 910 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE pclrep-skip-to Method-Library
 911 PROCEDURE pclrep-skip-to :
 912 /*------------------------------------------------------------------------------
 913   Purpose:  Skip to a position on the page
 914 ------------------------------------------------------------------------------*/
 915 DEF INPUT PARAMETER new-pos AS DEC NO-UNDO.
 916
 917 /*
 918 DEF VAR y-pos AS DECIMAL NO-UNDO.
 919   y-pos = new-pos - DECIMAL( ENTRY(pclrep-current-font,pclrep-font-height,pclrep-delimiter)).
 920 */
 921
 922   DO WHILE pclrep-page-position <= new-pos:
 923     RUN pclrep-line( "", "").
 924   END.
 925
 926 END PROCEDURE.
 927
 928 /* _UIB-CODE-BLOCK-END */
 929 &ANALYZE-RESUME
 930
 931 &ENDIF
 932
 933 &IF DEFINED(EXCLUDE-pclrep-start) = 0 &THEN
 934
 935 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE pclrep-start Method-Library
 936 PROCEDURE pclrep-start :
 937 /*------------------------------------------------------------------------------
 938   Purpose:
 939 ------------------------------------------------------------------------------*/
 940 DEF INPUT PARAMETER preview AS LOGICAL NO-UNDO.
 941 DEF INPUT PARAMETER page-reset AS CHAR NO-UNDO.
 942
 943 DEF VAR prt-ctrl AS CHAR NO-UNDO.
 944 DEF VAR line-height AS DEC NO-UNDO.
 945 DEF VAR cols AS DEC NO-UNDO.
 946
 947   RUN pcl-control-string ( "reset," + page-reset, OUTPUT prt-ctrl, OUTPUT cols,
 948                         OUTPUT line-height, OUTPUT pclrep-page-height ).
 949   RUN output-control-file ( prt-ctrl ).
 950
 951   ASSIGN
 952     pclrep-preview-mode  = preview
 953     pclrep-font-text     = page-reset
 954     pclrep-font-code     = prt-ctrl
 955     pclrep-font-height   = STRING( line-height )
 956     pclrep-current-font-height = line-height
 957     pclrep-font-cols     = STRING( cols )
 958     pclrep-current-font  = 1
 959     pclrep-page-number   = 0
 960     pclrep-page-position = 0
 961     pclrep-between-pages = No.
 962
 963 END PROCEDURE.
 964
 965 /* _UIB-CODE-BLOCK-END */
 966 &ANALYZE-RESUME
 967
 968 &ENDIF
 969
 970 &IF DEFINED(EXCLUDE-send-to-printer) = 0 &THEN
 971
 972 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE send-to-printer Method-Library
 973 PROCEDURE send-to-printer :
 974 /*------------------------------------------------------------------------------
 975   Purpose:  Send the report to the printer via Windows.
 976 ------------------------------------------------------------------------------*/
 977 DEF INPUT PARAMETER font-num AS INTEGER NO-UNDO.
 978 DEF INPUT PARAMETER landscape AS LOGICAL NO-UNDO.
 979 DEF INPUT PARAMETER show-dialog AS LOGICAL NO-UNDO.
 980
 981 DEF VAR lsuccess AS LOGI INITIAL No NO-UNDO.
 982 DEF VAR pr-flags AS INT NO-UNDO.
 983
 984   pr-flags = (IF show-dialog  THEN 1 ELSE 0)
 985            + (IF landscape    THEN 2 ELSE 0).
 986
 987   RUN adecomm/_osprint.p ( CURRENT-WINDOW, txtrep-print-file, font-num, pr-flags,
 988                            0, 0, OUTPUT lsuccess ).
 989
 990 END PROCEDURE.
 991
 992 /* _UIB-CODE-BLOCK-END */
 993 &ANALYZE-RESUME
 994
 995 &ENDIF
 996
 997 &IF DEFINED(EXCLUDE-set-viewer-title) = 0 &THEN
 998
 999 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE set-viewer-title Method-Library
1000 PROCEDURE set-viewer-title :
1001 /*------------------------------------------------------------------------------
1002   Purpose:  Set the title in the report viewer window.
1003 ------------------------------------------------------------------------------*/
1004 DEF INPUT PARAMETER title-text AS CHAR NO-UNDO.
1005
1006   RUN set-title IN txtrep-preview-window ( title-text ).
1007
1008 END PROCEDURE.
1009
1010 /* _UIB-CODE-BLOCK-END */
1011 &ANALYZE-RESUME
1012
1013 &ENDIF
1014
1015 &IF DEFINED(EXCLUDE-txtrep-do-email) = 0 &THEN
1016
1017 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE txtrep-do-email Method-Library
1018 PROCEDURE txtrep-do-email :
1019 /*------------------------------------------------------------------------------
1020   Purpose:
1021 ------------------------------------------------------------------------------*/
1022 DEF INPUT PARAMETER email-string AS CHAR NO-UNDO.
1023 DEF INPUT PARAMETER email-subject AS CHAR NO-UNDO.
1024 DEF INPUT PARAMETER email-template AS CHAR NO-UNDO.
1025
1026 IF email-string <> "" AND email-template <> "" THEN DO:
1027   IF txtrep-output-mode = "pdf" THEN
1028     PUT CONTROL "[-pdf-]>EMAIL:" + email-string + "|" + email-subject + "|" + email-template + "[-pdf-]".
1029 END.
1030 ELSE
1031   MESSAGE "Email and email template parameters required"
1032     VIEW-AS ALERT-BOX ERROR TITLE "Email or template blank".
1033
1034 END PROCEDURE.
1035
1036 /* _UIB-CODE-BLOCK-END */
1037 &ANALYZE-RESUME
1038
1039 &ENDIF
1040
1041 &IF DEFINED(EXCLUDE-txtrep-initialise) = 0 &THEN
1042
1043 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE txtrep-initialise Method-Library
1044 PROCEDURE txtrep-initialise :
1045 /*------------------------------------------------------------------------------
1046   Purpose:  Initialise the important parameters
1047 ------------------------------------------------------------------------------*/
1048 DEF VAR temp-dir AS CHAR NO-UNDO.
1049
1050   temp-dir = OS-GETENV("APMSTEMP":U).
1051   IF temp-dir = ? OR temp-dir = "" THEN temp-dir = OS-GETENV("TMP":U).
1052   IF temp-dir = ? OR temp-dir = "" THEN temp-dir = OS-GETENV("TEMP":U).
1053   IF temp-dir = ? OR temp-dir = "" THEN temp-dir = SESSION:TEMP-DIRECTORY .
1054   temp-dir = temp-dir + txtrep-delim.
1055
1056   txtrep-print-file = temp-dir + txtrep-prefix + STRING( TIME, "99999") + txtrep-file-suffix.
1057   txtrep-control-file = temp-dir + "CTL" + STRING( TIME, "99999") + txtrep-file-suffix.
1058
1059   IF txtrep-delim NE "/" THEN DO:
1060     DO WHILE INDEX( txtrep-print-file, "/" ) > 0:
1061       SUBSTRING( txtrep-print-file, INDEX( txtrep-print-file, "/" ), 1) = txtrep-delim.
1062     END.
1063     DO WHILE INDEX( txtrep-control-file, "/" ) > 0:
1064       SUBSTRING( txtrep-control-file, INDEX( txtrep-control-file, "/" ), 1) = txtrep-delim.
1065     END.
1066   END.
1067
1068   /* Set the 'txtrep-printer' to printer port */
1069   RUN get-current-printer.
1070
1071 END PROCEDURE.
1072
1073 /* _UIB-CODE-BLOCK-END */
1074 &ANALYZE-RESUME
1075
1076 &ENDIF
1077
1078 &IF DEFINED(EXCLUDE-txtrep-output-mode) = 0 &THEN
1079
1080 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE txtrep-output-mode Method-Library
1081 PROCEDURE txtrep-output-mode :
1082 /*------------------------------------------------------------------------------
1083   Purpose:
1084 ------------------------------------------------------------------------------*/
1085 DEF INPUT PARAMETER mode AS CHAR NO-UNDO.
1086
1087 txtrep-output-mode = mode.
1088
1089 END PROCEDURE.
1090
1091 /* _UIB-CODE-BLOCK-END */
1092 &ANALYZE-RESUME
1093
1094 &ENDIF
1095
1096 &IF DEFINED(EXCLUDE-txtrep-pdf-filename) = 0 &THEN
1097
1098 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE txtrep-pdf-filename Method-Library
1099 PROCEDURE txtrep-pdf-filename :
1100 /*------------------------------------------------------------------------------
1101   Purpose:     Indicate that the output will be a PDF and the filename
1102   Parameters:  filename (without the extension)
1103   Notes:
1104 ------------------------------------------------------------------------------*/
1105 DEF INPUT PARAMETER pdf-file-name AS CHAR NO-UNDO.
1106
1107 txtrep-print-file = pdf-output-directory + '/' + pdf-file-name + '.protopdf'.
1108
1109 END PROCEDURE.
1110
1111 /* _UIB-CODE-BLOCK-END */
1112 &ANALYZE-RESUME
1113
1114 &ENDIF
1115
1116 &IF DEFINED(EXCLUDE-view-output-file) = 0 &THEN
1117
1118 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE view-output-file Method-Library
1119 PROCEDURE view-output-file :
1120 /*------------------------------------------------------------------------------
1121   Purpose:  Close the output file now that we've finished with it.
1122 ------------------------------------------------------------------------------*/
1123 DEF INPUT PARAMETER txtrep-is-preview AS LOGI NO-UNDO.
1124
1125   IF txtrep-is-preview THEN DO:
1126     RUN win/w-report.w PERSISTENT SET txtrep-preview-window.
1127     RUN dispatch IN txtrep-preview-window ( 'initialize':U ).
1128     RUN load-editor IN txtrep-preview-window ( txtrep-print-file, txtrep-control-file ).
1129     WAIT-FOR CLOSE OF txtrep-preview-window.
1130   END.
1131   ELSE DO:
1132     RUN copy-to-printer.
1133 DEF VAR user-name AS CHAR NO-UNDO.
1134 {inc/username.i "user-name"}
1135     IF CAN-FIND( UsrGroupMember WHERE UsrGroupMember.UserName = user-name AND UsrGroupMember.GroupName = "Programmer") THEN PAUSE 5 NO-MESSAGE.
1136     OS-DELETE VALUE( txtrep-control-file )  NO-ERROR.
1137     IF txtrep-output-mode <> "pdf" THEN
1138         OS-DELETE VALUE( txtrep-print-file ) NO-ERROR.
1139   END.
1140
1141 END PROCEDURE.
1142
1143 /* _UIB-CODE-BLOCK-END */
1144 &ANALYZE-RESUME
1145
1146 &ENDIF
1147
1148 &IF DEFINED(EXCLUDE-vs-output-file) = 0 &THEN
1149
1150 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE vs-output-file Method-Library
1151 PROCEDURE vs-output-file :
1152 /*------------------------------------------------------------------------------
1153   Purpose:  Close the output file now that we've finished with it.
1154 ------------------------------------------------------------------------------*/
1155 DEF INPUT PARAMETER txtrep-is-preview AS LOGI NO-UNDO.
1156 DEF INPUT PARAMETER font-num AS INTEGER NO-UNDO.
1157 DEF INPUT PARAMETER landscape AS LOGICAL NO-UNDO.
1158 DEF INPUT PARAMETER show-dialog AS LOGICAL NO-UNDO.
1159
1160   IF txtrep-is-preview THEN DO:
1161     RUN win/w-report.w PERSISTENT SET txtrep-preview-window.
1162     RUN dispatch IN txtrep-preview-window ( 'initialize':U ).
1163     RUN load-editor IN txtrep-preview-window ( txtrep-print-file, txtrep-control-file ).
1164     RUN set-print-details IN txtrep-preview-window ( font-num, landscape, show-dialog ) NO-ERROR.
1165   END.
1166   ELSE DO:
1167     RUN send-to-printer( font-num, landscape, show-dialog ).
1168     OS-DELETE VALUE( txtrep-control-file ).
1169     OS-DELETE VALUE( txtrep-print-file ).
1170   END.
1171
1172 END PROCEDURE.
1173
1174 /* _UIB-CODE-BLOCK-END */
1175 &ANALYZE-RESUME
1176
1177 &ENDIF
1178
1179 /* ************************  Function Implementations ***************** */
1180
1181 &IF DEFINED(EXCLUDE-htmlrep-style) = 0 &THEN
1182
1183 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION htmlrep-style Method-Library
1184 FUNCTION htmlrep-style RETURNS CHARACTER
1185   ( INPUT sname AS CHAR, INPUT sformat AS CHAR ) :
1186 /*------------------------------------------------------------------------------
1187   Purpose:  Since Progress deals less handily with braces...
1188 ------------------------------------------------------------------------------*/
1189
1190   RETURN "    " + sname + "~{" + sformat + "~}~n".
1191
1192 END FUNCTION.
1193
1194 /* _UIB-CODE-BLOCK-END */
1195 &ANALYZE-RESUME
1196
1197 &ENDIF
1198
1199 &IF DEFINED(EXCLUDE-pclrep-test-bottom) = 0 &THEN
1200
1201 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION pclrep-test-bottom Method-Library
1202 FUNCTION pclrep-test-bottom RETURNS LOGICAL
1203   ( INPUT lines AS DECIMAL ) :
1204 /*---------------------------------------------------------------------------
1205   Returns 'TRUE' if current position + 'lines' would be off the bottom.
1206 ---------------------------------------------------------------------------*/
1207 DEF VAR test-pos AS DEC NO-UNDO.
1208 DEF VAR text-end AS DEC NO-UNDO.
1209
1210   test-pos = (pclrep-page-position + (lines * pclrep-current-font-height)).
1211   text-end = (pclrep-page-height - pclrep-footer-height).
1212
1213 /*
1214 &IF DEFINED(DEBUG-END) &THEN
1215     debug-event( "Page position " + STRING(pclrep-page-position)
1216            + ",   Test position " + STRING(test-pos)
1217            + ",   Text ends at " + STRING(text-end)
1218            + ",   Lines " + STRING(lines)
1219            + ",   Pg Height " + STRING(pclrep-page-height)
1220            + ",   Ftr Height " + STRING(pclrep-footer-height)
1221            + ",   Font Height " + STRING(pclrep-current-font-height)).
1222 &ENDIF
1223 */
1224
1225   RETURN test-pos >= text-end .
1226
1227 END FUNCTION.
1228
1229 /* _UIB-CODE-BLOCK-END */
1230 &ANALYZE-RESUME
1231
1232 &ENDIF
1233
1234 &IF DEFINED(EXCLUDE-tag) = 0 &THEN
1235
1236 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION tag Method-Library
1237 FUNCTION tag RETURNS CHARACTER
1238   ( INPUT tagtype AS CHAR, INPUT tagtext AS CHAR, INPUT attributes AS CHAR ) :
1239 /*------------------------------------------------------------------------------
1240   Purpose:  Enclose the tagtext value in quotes
1241     Notes:
1242 ------------------------------------------------------------------------------*/
1243
1244   RETURN "<" + tagtype + " " + attributes + ">"
1245        + tagtext
1246        + "</" + tagtype + ">".
1247
1248 END FUNCTION.
1249
1250 /* _UIB-CODE-BLOCK-END */
1251 &ANALYZE-RESUME
1252
1253 &ENDIF
1254