Programmer 7500

home *** CD-ROM | disk | FTP | other *** search

/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PRINTR3.ZIP / PRINTR2.PRT < prev next >

Wrap

Text File | 1989-12-21 | 44.9 KB | 904 lines

D-Xref 6.3 12-21-1989 at 10 : 04 - - Listing for : c:\turbo-5\bulletin\printr2.pas Page 1 Line : D Statement 1 : 0 2 : 0 {$S-,V-} 3 : 0 (****************************************************************************) 4 : 0 (* *) 5 : 0 (* Mesa Software *) 6 : 0 (* 3302 Fourth Ave, Suite 101 *) 7 : 0 (* San Diego, Ca. 92103 *) 8 : 0 (* *) 9 : 0 (* *) 10 : 0 (* Program : Unit Printr2 File Name : printr2.pas *) 11 : 0 (* *) 12 : 0 (* Release : Version 1.0 Date : Dec. 15, 1989 *) 13 : 0 (* *) 14 : 0 (* *) 15 : 0 (****************************************************************************) 16 : 0 17 : 0 Unit printr2; 18 : 0 Interface 19 : 0 20 : 0 {Requires TJocks5. 21 : 0 Use at your own risk. Mesa Software assumes no 22 : 0 liability for the use of this software} 23 : 0 24 : 0 uses CRT,dos,fastttt5,miscttt5,winttt5,strnttt5,keyttt5; 25 : 0 26 : 0 G-1CONST-0H 27 : 0 esc = #27; 28 : 0 off = #0; 29 : 0 NLQ = (esc + '!' + #1); 30 : 0 NLQ_OFF = (esc + '!' + #0); 31 : 0 Supercrpt = (esc + 'S' + #0); 32 : 0 Subscrpt = (esc + 'S' + #1); 33 : 0 scrp_off = (esc + 'T'); 34 : 0 Comprsd = (esc + #15); 35 : 0 uncomprsd = (esc + #18); 36 : 0 Emphaszd = (esc + 'E'); 37 : 0 unemphszd = (esc + 'F'); 38 : 0 Dbl_prtng = (esc + 'G'); 39 : 0 un_dbl = (esc + 'H'); 40 : 0 41 : 0 dbl_wid = (esc + 'W' + #1); 42 : 0 un_wid = (esc + 'W' + off); 43 : 0 44 : 0 {The two print commands below are the same as the two 45 : 0 above.} 46 : 0 expanded = esc + '!' + #48; 47 : 0 unexpand = esc + 'W' + off; 48 : 0 49 : 0 50 : 0 undr_lin = (esc + '-' + #1); 51 : 0 undr_lin_off = (esc + '-' + off); 52 : 0 backspc = (#8); 53 : 0 char_byte = '$'; 54 : 0 {This is the char you see in the banner and 55 : 0 report headers. Try !,*,#, or %. Taylor D-Xref 6.3 12-21-1989 at 10 : 04 - - Listing for : c:\turbo-5\bulletin\printr2.pas Page 2 Line : D Statement 56 : 0 your chars for different reports} 57 : 0 58 : 0 thirteen = 13; 59 : 0 backspace = #8; 60 : 0 centered = #27 + 'a' + #1; 61 : 0 left_margin = #27 + 'a' + off; 62 : 0 line_feed = #10; 63 : 0 form_feed = #12; 64 : 0 carig_rtn = #13; 65 : 0 author = 'Tom Devanney'; 66 : 0 67 : 0 G-1TYPE-0H 68 : 0 Datestr = G-1STRING-0H[8]; 69 : 0 70 : 0 G-1VAR-0H 71 : 0 G-1LST-0H : G-1TEXT-0H; 72 : 0 page : G-1STRING-0H; 73 : 0 num : G-1INTEGER-0H; 74 : 0 75 : 0 G-1FUNCTION-0H Printer_on : G-1BOOLEAN-0H; 76 : 0 G-1PROCEDURE-0H Beepr; 77 : 0 G-1PROCEDURE-0H banner(co_nam,addrs,city,st,zip,phone,rpt_title : G-1STRING-0H); 78 : 0 G-1PROCEDURE-0H Report_hdr(Rpt_Title,co_nam,addrs,city,st,zip,page : G-1STRING-0H); 79 : 0 G-1FUNCTION-0H IO_Not_OK(num : word) : G-1BOOLEAN-0H; 80 : 0 G-1FUNCTION-0H GetSystemDate : Datestr; 81 : 0 G-1FUNCTION-0H NumToStr(number : LongInt) : G-1STRING-0H; 82 : 0 G-1PROCEDURE-0H Check_color(G-1VAR-0H Textf,G-1BACK-0H : G-1BYTE-0H); 83 : 0 84 : 0 {======================================================================} 85 : 0 86 : 0 Implementation 87 : 0 88 : 0 {======================================================================} 89 : 0 90 : 0 91 : 0 G-1PROCEDURE-0H Check_color(G-1VAR-0H Textf,G-1BACK-0H : G-1BYTE-0H); 92 : 0 93 : 0 {This is to change any color combo into white on black for monochrome 94 : 0 screens} 95 : 0 96 : 1 G-1BEGIN-0H 97 : 1 | G-1IF-0H (baseOfScreen <> $B800) G-1THEN-0H 98 : 2 | G-1BEGIN-0H 99 : 2 | | Textf := 15; 100 : 2 | | G-1BACK-0H := 0; 101 : 1 | G-1END-0H; 102 : 0 G-1END-0H; 103 : 0 104 : 0 G-1FUNCTION-0H GetSystemDate : Datestr; {string[10]} 105 : 0 106 : 0 {This is to get a system date from the system and return as a string} 107 : 0 108 : 0 G-1VAR-0H 109 : 0 regs : Registers; 110 : 0 st2,st3,st4 : G-1STRING-0H[10]; 111 : 0 D-Xref 6.3 12-21-1989 at 10 : 04 - - Listing for : c:\turbo-5\bulletin\printr2.pas Page 3 Line : D Statement 112 : 1 G-1BEGIN-0H 113 : 1 | G-1FILLCHAR-0H(regs,G-1SIZEOF-0H(regs),0); 114 : 1 | Regs.AH := $2A; {Interrupt for system date} 115 : 1 | G-1MSDOS-0H(regs); 116 : 1 | G-1WITH-0H regs G-1DO-0H 117 : 2 | G-1BEGIN-0H 118 : 2 | | G-1STR-0H(CX, st2); {year} 119 : 2 | | G-1STR-0H(DH, st3); {Month} 120 : 2 | | G-1STR-0H(DL, st4); {Day} 121 : 1 | G-1END-0H; 122 : 1 | G-1IF-0H G-1LENGTH-0H(st3) = 1 G-1THEN-0H st3 := '0' + st3; 123 : 1 | G-1IF-0H G-1LENGTH-0H(st4) = 1 G-1THEN-0H st4 := '0' + st4; 124 : 1 | getsystemdate := st3 + '/' + st4 + '/' + G-1COPY-0H(st2,3,2); 125 : 0 G-1END-0H; 126 : 0 127 : 0 128 : 0 G-1FUNCTION-0H NumToStr(number : LongInt) : G-1STRING-0H; 129 : 0 130 : 0 {-Convert a longinteger,word,integer,byte to a string} 131 : 0 132 : 0 G-1VAR-0H 133 : 0 numstr : G-1STRING-0H; 134 : 1 G-1BEGIN-0H 135 : 1 | G-1STR-0H(number,numstr); 136 : 1 | NumToStr := numstr; 137 : 0 G-1END-0H; 138 : 0 139 : 0 140 : 0 G-1PROCEDURE-0H Beepr; 141 : 0 142 : 0 {This is a fancy lawyer telephone beeper sound 143 : 0 The sound you hear is money} 144 : 0 145 : 0 G-1CONST-0H 146 : 0 itration = 3; 147 : 0 G-1VAR-0H 148 : 0 countr : G-1INTEGER-0H; 149 : 0 150 : 1 G-1BEGIN-0H 151 : 1 | G-1FOR-0H countr := 1 G-1TO-0H itration G-1DO-0H 152 : 2 | G-1BEGIN-0H 153 : 2 | | G-1SOUND-0H(949); {925..999} 154 : 2 | | G-1DELAY-0H(50); 155 : 2 | | G-1SOUND-0H(499); {450..600} 156 : 2 | | G-1DELAY-0H(50); 157 : 1 | G-1END-0H; 158 : 1 | G-1NOSOUND-0H; 159 : 0 G-1END-0H; { Beep } 160 : 0 161 : 0 G-1FUNCTION-0H Printer_on : G-1BOOLEAN-0H; 162 : 0 163 : 0 {This is a printer screen that is easy to use} 164 : 0 165 : 0 G-1VAR-0H 166 : 0 line,col,end_lin, 167 : 0 end_col,box_knd : G-1INTEGER-0H; D-Xref 6.3 12-21-1989 at 10 : 04 - - Listing for : c:\turbo-5\bulletin\printr2.pas Page 4 Line : D Statement 168 : 0 Regs : registers; 169 : 0 answr : G-1CHAR-0H; 170 : 0 message : G-1STRING-0H; 171 : 0 textf,boxf,G-1BACK-0H : G-1BYTE-0H; 172 : 0 173 : 1 G-1BEGIN-0H 174 : 1 | answr := ' '; 175 : 1 | G-1CLRSCR-0H; 176 : 1 | col := 10; 177 : 1 | line := 10; 178 : 1 | end_col := 70; 179 : 1 | end_lin := 20; 180 : 1 | box_knd := 0; {0..4,5..9 choose another box type to suit your style} 181 : 1 | Printer_on := G-1FALSE-0H; 182 : 1 | savescreen(1); 183 : 1 | boxf := white; 184 : 1 | G-1BACK-0H := lightgray; 185 : 1 | check_color(boxf,G-1BACK-0H); 186 : 1 | Fbox(col,line,end_col,end_lin,boxf,G-1BACK-0H,box_knd); 187 : 1 | boxf := yellow; 188 : 1 | G-1BACK-0H := red; 189 : 1 | check_color(boxf,G-1BACK-0H); 190 : 1 | Fbox(col + 1 ,line + 1,end_col - 1,end_lin - 1,boxf,G-1BACK-0H,box_knd); 191 : 1 | G-1BACK-0H := black; 192 : 1 | check_color(boxf,G-1BACK-0H); 193 : 1 | Fbox(col + 2,line + 2,end_col - 2,end_lin - 2,boxf,G-1BACK-0H,box_knd); 194 : 1 | textf := yellow; 195 : 1 | check_color(textf,G-1BACK-0H); 196 : 1 | Writebetween(col,end_col,line + (end_lin - line) G-1DIV-0H 2 - 1,textf,G-1BACK-0H,'CHECK THE PRINTER FOR PAPER'); 197 : 1 | message := 'THE PRINTER IS READY, HIT RETURN TO START'; 198 : 1 | 199 : 1 | Offcursor; 200 : 1 | G-1WITH-0H regs G-1DO-0H 201 : 2 | G-1BEGIN-0H 202 : 2 | | ah := 2; 203 : 2 | | dx := 0; 204 : 2 | | G-1INTR-0H($17,regs); 205 : 2 | | printer_on := (ah = 144); 206 : 1 | G-1END-0H; 207 : 2 | G-1REPEAT-0H 208 : 2 | | G-1IF-0H (regs.ah <> 144) G-1THEN-0H 209 : 2 | | message := 'PRINTER OFF LINE, ESC TO ABORT OR RETURN TO CONTINUE'; 210 : 2 | | beepr; 211 : 2 | | Writebetween(col,end_col,line + (end_lin - line) G-1DIV-0H 2 + 1,textf,G-1BACK-0H, message); 212 : 2 | | answr := getkey; 213 : 2 | | G-1WITH-0H regs G-1DO-0H 214 : 3 | | G-1BEGIN-0H 215 : 3 | | | ah := 2; 216 : 3 | | | dx := 0; 217 : 3 | | | G-1INTR-0H($17,regs); 218 : 3 | | | printer_on := (ah = 144); 219 : 2 | | G-1END-0H; 220 : 1 | G-1UNTIL-0H ((regs.ah = 144) G-1OR-0H (answr = #27)); 221 : 1 | G-1IF-0H (answr = #27) G-1THEN-0H 222 : 1 | Printer_on := G-1FALSE-0H; 223 : 1 | restorescreen(1); D-Xref 6.3 12-21-1989 at 10 : 04 - - Listing for : c:\turbo-5\bulletin\printr2.pas Page 5 Line : D Statement 224 : 1 | disposescreen(1); 225 : 0 G-1END-0H; {Function Printer_on_line} 226 : 0 227 : 0 228 : 0 229 : 0 230 : 0 231 : 0 232 : 0 233 : 0 G-1FUNCTION-0H IO_NOT_OK(num : word) : G-1BOOLEAN-0H; 234 : 0 235 : 0 {This is an error manager that will enable you to escape most runtime 236 : 0 errors. In some cases you will add recovery code after this routine 237 : 0 to your program} 238 : 0 239 : 0 G-1VAR-0H 240 : 0 msg,Drive_a, 241 : 0 Drive_b : G-1STRING-0H; 242 : 0 243 : 1 G-1BEGIN-0H 244 : 1 | Drive_a := 'A:'; 245 : 1 | Drive_b := 'B:'; 246 : 1 | Flushkeybuffer; 247 : 1 | msg := ''; 248 : 1 | IO_Not_ok := (num <> 0); 249 : 1 | G-1IF-0H (num <> 0) G-1THEN-0H 250 : 2 | G-1BEGIN-0H 251 : 3 | | G-1CASE-0H num G-1OF-0H 252 : 3 | | | 002 : msg := 'File not found'; 253 : 3 | | | 003 : msg := 'Path not found'; 254 : 3 | | | 004 : msg := 'Too many open files, Check Files = in config.sys'; 255 : 3 | | | 005 : msg := 'File access denied or Drive/Directory exists'; 256 : 3 | | | 006 : msg := 'Invalid file handle'; 257 : 3 | | | 012 : msg := 'Invalid file access code'; 258 : 3 | | | 015 : msg := 'Invalid drive number'; 259 : 3 | | | 016 : msg := 'Cannot remove current directory'; 260 : 3 | | | 017 : msg := 'Cannot rename across drives'; 261 : 3 | | | 100 : msg := 'Disk read error, is file open ?'; 262 : 3 | | | 101 : msg := 'Disk write error, is disk full ?'; 263 : 3 | | | 102 : msg := 'File not assigned, File name not assigned?'; 264 : 3 | | | 103 : msg := 'File not open'; 265 : 3 | | | 104 : msg := 'File not open for input'; 266 : 3 | | | 105 : msg := 'File not open for output'; 267 : 3 | | | 106 : msg := 'Invalid numeric format'; 268 : 3 | | | 150 : msg := 'Disk is write-protected, Remove tab?'; 269 : 3 | | | 151 : msg := 'Unknown unit'; 270 : 3 | | | 152 : msg := 'Drive not ready, close drive door, Thank you'; 271 : 3 | | | 153 : msg := 'Unknown command'; 272 : 3 | | | 154 : msg := 'CRC error in data'; 273 : 3 | | | 155 : msg := 'Bad drive request structure length'; 274 : 3 | | | 156 : msg := 'Disk seek error'; 275 : 3 | | | {I use error 157 to sense an unformatted floppy.} 276 : 3 | | | 157 : msg := 'Unknown media type. We will format Floppy.'; 277 : 3 | | | 158 : msg := 'Sector not found'; 278 : 3 | | | 159 : msg := 'Printer out of paper, so put some in'; 279 : 3 | | | 160 : msg := 'Device write fault. Usually printer is off'; D-Xref 6.3 12-21-1989 at 10 : 04 - - Listing for : c:\turbo-5\bulletin\printr2.pas Page 6 Line : D Statement 280 : 3 | | | 161 : msg := 'Device read fault'; 281 : 3 | | | 162 : msg := 'Hardware failure'; 282 : 3 | | | 200 : msg := 'Division by zero'; 283 : 3 | | | 201 : msg := 'Range check error'; 284 : 3 | | | 202 : msg := 'Stack overflow'; 285 : 3 | | | 203 : msg := 'Insufficient memory'; 286 : 3 | | | 204 : msg := 'Invalid pointer operation'; 287 : 3 | | | 205 : msg := 'Floating point overflow, number too big'; 288 : 3 | | | 206 : msg := 'Floating point underflow'; 289 : 3 | | | 207 : msg := 'Invalid floating point operation'; 290 : 3 | | | 208 : msg := 'Overlay manager not installed'; 291 : 3 | | | 209 : msg := 'Overlay file read error'; 292 : 3 | | | G-1ELSE-0H 293 : 3 | | | msg := 'Turbo runtime error '+ NumToStr(num); 294 : 2 | | G-1END-0H; 295 : 2 | | savescreen(5); 296 : 2 | | {These colors are for ega/vga, monochrome is not supported 297 : 2 | | Here is a hint for good window/message formatting. 298 : 2 | | Choose an odd number of lines for the window and 299 : 2 | | an odd number of messages to display 300 : 2 | | or an even number of lines for the window and 301 : 2 | | an even number of messages to display. 302 : 2 | | Display your message centered in the window or box and the 303 : 2 | | screen will look superb. Makes happy satisfied users} 304 : 2 | | 305 : 2 | | Mkwin(10,8,70,17,yellow, lightgray,4); 306 : 2 | | Writebetween(11,69,13,black,lightgray,upper(msg)); 307 : 2 | | Writebetween(11,69,14,black,lightgray,'HIT RETURN TO CONTINUE'); 308 : 2 | | G-1READLN-0H; 309 : 2 | | restorescreen(5); 310 : 2 | | disposescreen(5); 311 : 2 | | G-1IF-0H ((num = 157) G-1OR-0H (num = 3)) G-1THEN-0H 312 : 3 | | G-1BEGIN-0H 313 : 3 | | | G-1CLRSCR-0H; 314 : 3 | | | SwapVectors; 315 : 3 | | | Exec(GetEnv('COMSPEC'), '/C Format ' + Drive_a); 316 : 3 | | | SwapVectors; 317 : 3 | | | G-1IF-0H DosError <> 0 G-1THEN-0H 318 : 4 | | | G-1BEGIN-0H 319 : 4 | | | | Writebetween(11,69,13,black,lightgray,upper('Could not execute COMMAND.COM')); 320 : 4 | | | | G-1READLN-0H; 321 : 3 | | | G-1END-0H 322 : 3 | | | G-1ELSE-0H 323 : 4 | | | G-1BEGIN-0H 324 : 4 | | | | Writebetween(11,69,13,black,lightgray,upper('Disk ' + Drive_a + ' is Formatted')); 325 : 4 | | | | G-1READLN-0H; 326 : 3 | | | G-1END-0H; 327 : 2 | | G-1END-0H; 328 : 1 | G-1END-0H; 329 : 0 G-1END-0H; 330 : 0 331 : 0 332 : 0 (**************************************************************************) 333 : 0 (* *) 334 : 0 (* *) 335 : 0 (* Mesa Software *) D-Xref 6.3 12-21-1989 at 10 : 04 - - Listing for : c:\turbo-5\bulletin\printr2.pas Page 7 Line : D Statement 336 : 0 (* 3302 Fourth Ave, Suite 101 *) 337 : 0 (* San Diego, Ca. 92103 *) 338 : 0 (* *) 339 : 0 (* *) 340 : 0 (* Procedure : Banner File Name : Printr2.pas *) 341 : 0 (* *) 342 : 0 (* Release : Version 1.0 Date : Dec 15, 1989 *) 343 : 0 (* *) 344 : 0 (* *) 345 : 0 (* *) 346 : 0 (**************************************************************************) 347 : 0 348 : 0 349 : 0 G-1PROCEDURE-0H banner(co_nam,addrs,city,st,zip,phone,rpt_title : G-1STRING-0H); 350 : 0 351 : 0 (* this is a procedure with the following call: 352 : 0 banner(co_nam,addrs,City,st,zip,rpt_title); 353 : 0 354 : 0 co_nam := 'MESA SOFTWARE'; 355 : 0 addrs := '3302 FOURTH AVENUE, SUITE 101'; 356 : 0 city := 'SAN DIEGO'; {If necessary,A routine will add the comma} 357 : 0 st := 'CALIFORNIA'; 358 : 0 zip := '92103'; 359 : 0 phone := '1(555)555-5555'; 360 : 0 rpt_title := 'ACCOUNTS RECEIVABLE AGING REPORT'; 361 : 0 dte := Date; this date routine is in Technojocks.miscttt unit. 362 : 0 363 : 0 We have Tested it using a Panasonic 1592. The routine is flexible enough to 364 : 0 take most any size strings within reason. Watch the report titles as they 365 : 0 are expanded, centered and added to. Check the code for comma addition. 366 : 0 367 : 0 *) 368 : 0 369 : 0 G-1VAR-0H 370 : 0 i,j,k,pag_lnth, 371 : 0 lin_lnth,lin_counter,char_count, 372 : 0 Top_headr,bottom_headr,title_lines : G-1INTEGER-0H; 373 : 0 page : G-1STRING-0H; 374 : 0 375 : 0 376 : 0 377 : 0 G-1PROCEDURE-0H Banner_Top; 378 : 0 379 : 0 G-1VAR-0H 380 : 0 countr,i : G-1INTEGER-0H; 381 : 0 382 : 1 G-1BEGIN-0H 383 : 1 | G-1FOR-0H countr := 1 G-1TO-0H top_headr G-1DO-0H 384 : 2 | G-1BEGIN-0H 385 : 2 | | G-1FOR-0H i := 1 G-1TO-0H lin_lnth G-1DO-0H 386 : 2 | | G-1WRITE-0H(G-1LST-0H,char_byte); 387 : 2 | | G-1WRITELN-0H(G-1LST-0H); 388 : 2 | | char_count := 0; 389 : 2 | | inc(lin_counter); 390 : 1 | G-1END-0H; 391 : 0 G-1END-0H; D-Xref 6.3 12-21-1989 at 10 : 04 - - Listing for : c:\turbo-5\bulletin\printr2.pas Page 8 Line : D Statement 392 : 0 393 : 0 G-1PROCEDURE-0H Banner_Bottom; 394 : 0 395 : 0 G-1VAR-0H 396 : 0 countr,i : G-1INTEGER-0H; 397 : 0 398 : 1 G-1BEGIN-0H 399 : 1 | G-1FOR-0H countr := 1 G-1TO-0H bottom_headr G-1DO-0H 400 : 2 | G-1BEGIN-0H 401 : 2 | | G-1FOR-0H i := 1 G-1TO-0H lin_lnth - 1 G-1DO-0H 402 : 2 | | G-1WRITE-0H(G-1LST-0H,char_byte); 403 : 2 | | G-1WRITELN-0H(G-1LST-0H,char_byte); 404 : 1 | G-1END-0H; 405 : 1 | G-1FOR-0H countr := 1 G-1TO-0H 5 G-1DO-0H 406 : 1 | G-1WRITELN-0H(G-1LST-0H); 407 : 1 | {After this routine, the form length, etc, should be set 408 : 1 | for your report paging to follow} 409 : 0 G-1END-0H; 410 : 0 411 : 0 412 : 0 G-1PROCEDURE-0H Banner_left; 413 : 0 414 : 1 G-1BEGIN-0H 415 : 1 | 416 : 1 | {You can use most any replicating code to write the 417 : 1 | following. The sample below will give you an option for most 418 : 1 | of banner routines. You probably know the argument. My code is 419 : 1 | perfect, yours is not so perfect. So Help Yourself. 420 : 1 | You must be careful with the TJocks.Fastttt5.Replicate Function. 421 : 1 | There is a LIMIT of 80 characters. The function is primarily for 422 : 1 | screen writes, so be careful in using it for printer lengths over 423 : 1 | 80 characters, it returns a value of 1.} 424 : 1 | 425 : 1 | G-1WRITE-0H(G-1LST-0H,#27 + 'a' + #0); 426 : 1 | G-1WRITE-0H(G-1LST-0H,replicate(10,char_byte)); 427 : 1 | G-1WRITE-0H(G-1LST-0H,#27 + 'j' + #0); 428 : 0 G-1END-0H; 429 : 0 430 : 0 G-1PROCEDURE-0H Banner_right; 431 : 0 432 : 1 G-1BEGIN-0H 433 : 1 | G-1WRITE-0H(G-1LST-0H,#27 + 'a' + #2); 434 : 1 | G-1WRITE-0H(G-1LST-0H,#27 + 'Q' + #132); 435 : 1 | G-1WRITELN-0H(G-1LST-0H,replicate(10,char_byte)); 436 : 0 G-1END-0H; 437 : 0 438 : 0 G-1PROCEDURE-0H Filler_Line; 439 : 0 440 : 1 G-1BEGIN-0H 441 : 1 | Banner_Left; 442 : 1 | Banner_Right; 443 : 0 G-1END-0H; 444 : 0 445 : 0 446 : 0 G-1PROCEDURE-0H Filler(num : G-1INTEGER-0H); 447 : 0 D-Xref 6.3 12-21-1989 at 10 : 04 - - Listing for : c:\turbo-5\bulletin\printr2.pas Page 9 Line : D Statement 448 : 0 G-1VAR-0H 449 : 0 countr : G-1INTEGER-0H; 450 : 0 451 : 1 G-1BEGIN-0H 452 : 1 | G-1FOR-0H countr := 1 G-1TO-0H num G-1DO-0H 453 : 2 | G-1BEGIN-0H 454 : 2 | | Filler_Line; 455 : 1 | G-1END-0H; 456 : 0 G-1END-0H; 457 : 0 458 : 0 G-1PROCEDURE-0H Names; 459 : 0 460 : 1 G-1BEGIN-0H 461 : 1 | G-1IF-0H G-1COPY-0H(city,G-1LENGTH-0H(city),1) <> ',' G-1THEN-0H {We add a comma if necessary} 462 : 1 | city := city + ', ' + st + ' ' + zip 463 : 1 | G-1ELSE-0H 464 : 1 | city := city + ' ' + st + ' ' + zip; 465 : 0 G-1END-0H; 466 : 0 467 : 0 G-1PROCEDURE-0H Report_Title(str1 : G-1STRING-0H); 468 : 0 469 : 1 G-1BEGIN-0H 470 : 1 | banner_left; 471 : 1 | G-1WRITE-0H(G-1LST-0H,#27 + 'a' + #1); {Auto Centering} 472 : 1 | G-1WRITE-0H(G-1LST-0H,#27 + '!' + #48); {Double width/double strike printing} 473 : 1 | G-1WRITE-0H(G-1LST-0H,str1); 474 : 1 | G-1WRITE-0H(G-1LST-0H,#27 + 'W' + #0); 475 : 1 | G-1WRITE-0H(G-1LST-0H,#27 + 'H'); 476 : 1 | G-1WRITE-0H(G-1LST-0H,#27 + '!' + #0); 477 : 1 | G-1WRITE-0H(G-1LST-0H,#27 + 'j' + #0); 478 : 1 | banner_right; 479 : 0 G-1END-0H; 480 : 0 481 : 0 482 : 0 G-1PROCEDURE-0H Title(sub_title : G-1STRING-0H); 483 : 0 484 : 1 G-1BEGIN-0H 485 : 1 | Banner_left; 486 : 1 | G-1WRITE-0H(G-1LST-0H,#27 + 'a' + #1); 487 : 1 | G-1WRITE-0H(G-1LST-0H,upper(sub_title)); 488 : 1 | G-1WRITE-0H(G-1LST-0H,#27 + 'j' + #0); 489 : 1 | Banner_Right; 490 : 0 G-1END-0H; 491 : 0 492 : 1 G-1BEGIN-0H 493 : 1 | G-1WRITE-0H(G-1LST-0H,#27,'@'); {Initializes the printer} 494 : 1 | G-1WRITE-0H(G-1LST-0H,#27+'C'+#62); {Sets the page length to 62 lines} 495 : 1 | top_headr := 6; {This is the top lines to fill} 496 : 1 | pag_lnth := 60; {This is the page length 50..66} 497 : 1 | Bottom_headr := 6; {Same as top_headr} 498 : 1 | lin_lnth := 132; {This was written using wide carriage. Try 80} 499 : 1 | lin_counter := 1; 500 : 1 | title_lines := 5; {We need this to calculate top and bottom filler space} 501 : 1 | char_count := 0; 502 : 1 | Names; 503 : 1 | banner_top; D-Xref 6.3 12-21-1989 at 10 : 04 - - Listing for : c:\turbo-5\bulletin\printr2.pas Page 10 Line : D Statement 504 : 1 | num := ((pag_lnth - 20) G-1DIV-0H 2 - 1); 505 : 1 | Filler(num); 506 : 1 | rpt_title := upper(rpt_title); 507 : 1 | report_title(rpt_title); 508 : 1 | num := 2; 509 : 1 | Filler(num); 510 : 1 | title(date); 511 : 1 | num := 11; 512 : 1 | Filler(num); 513 : 1 | title(co_nam); 514 : 1 | title(addrs); 515 : 1 | title(city); 516 : 1 | title(phone); 517 : 1 | num := 12; 518 : 1 | Filler(num); 519 : 1 | Banner_bottom; 520 : 0 G-1END-0H; 521 : 0 522 : 0 523 : 0 (***************************************************************************) 524 : 0 (* *) 525 : 0 (* Mesa Software *) 526 : 0 (* 3302 Fourth Ave, Suite 101 *) 527 : 0 (* San Diego, Ca. 92103 *) 528 : 0 (* *) 529 : 0 (* *) 530 : 0 (* Procedure : Report-hdr; File Name : PRINTR2.PAS *) 531 : 0 (* *) 532 : 0 (* Release : Version 1.0 Date : Dec 15,1989 *) 533 : 0 (* *) 534 : 0 (* *) 535 : 0 (* *) 536 : 0 (***************************************************************************) 537 : 0 538 : 0 G-1PROCEDURE-0H Report_hdr(Rpt_Title,co_nam,addrs,city,st,zip,page : G-1STRING-0H); 539 : 0 540 : 0 541 : 0 542 : 0 (* This is a procedure with the following call: 543 : 0 Report_Hdr(Rpt_Title,co_nam,addrs,City,st,zip,rpt_title,page); 544 : 0 545 : 0 co_nam := 'MESA SOFTWARE'; 546 : 0 addrs := '3302 FOURTH AVENUE, SUITE 101'; 547 : 0 city := 'SAN DIEGO'; 548 : 0 st := 'CALIFORNIA'; 549 : 0 zip := '92103'; 550 : 0 phone := '1(555)555-5555'; 551 : 0 dte := Date; this date routine is in Technojocks, sub your own 552 : 0 Rpt_Title := 'ACCOUNTS RECEIVABLE AGING REPORT'; 553 : 0 554 : 0 The code here is different from Banner. Choose your own style. 555 : 0 *) 556 : 0 G-1VAR-0H 557 : 0 i,j,k,lnth,pag_num : G-1INTEGER-0H; 558 : 0 pag : G-1STRING-0H; 559 : 0 D-Xref 6.3 12-21-1989 at 10 : 04 - - Listing for : c:\turbo-5\bulletin\printr2.pas Page 11 Line : D Statement 560 : 0 561 : 0 G-1PROCEDURE-0H Title(rpt_title : G-1STRING-0H); 562 : 0 563 : 0 G-1VAR-0H i : G-1INTEGER-0H; 564 : 1 G-1BEGIN-0H 565 : 1 | G-1FOR-0H i := 1 G-1TO-0H (lnth G-1DIV-0H 2) G-1DO-0H G-1WRITE-0H(G-1LST-0H,' '); 566 : 1 | j := i; 567 : 1 | G-1WRITE-0H(G-1LST-0H,expanded); 568 : 1 | G-1WRITE-0H(G-1LST-0H,Emphaszd); 569 : 1 | i := G-1LENGTH-0H(rpt_title); 570 : 1 | G-1IF-0H G-1ODD-0H(i) G-1THEN-0H rpt_title := rpt_title + ' '; 571 : 1 | G-1FOR-0H i:= 1 G-1TO-0H G-1LENGTH-0H(rpt_title) G-1DIV-0H 2 G-1DO-0H 572 : 1 | G-1WRITE-0H(G-1LST-0H,#8); 573 : 1 | G-1WRITE-0H(G-1LST-0H,rpt_title); 574 : 1 | G-1WRITE-0H(G-1LST-0H,unexpand); 575 : 1 | j := i + G-1LENGTH-0H(rpt_title) G-1DIV-0H 2; 576 : 1 | j := j + (lnth G-1DIV-0H 2); 577 : 0 G-1END-0H; 578 : 0 579 : 0 580 : 0 G-1PROCEDURE-0H Wrt_Address; 581 : 0 582 : 0 G-1VAR-0H 583 : 0 k : G-1INTEGER-0H; 584 : 0 585 : 1 G-1BEGIN-0H 586 : 1 | addrs := ''; 587 : 1 | addrs := co_nam + ' ' + addrs + ' ' + city + ' ' + st + ' ' + zip; 588 : 1 | G-1IF-0H G-1ODD-0H(G-1LENGTH-0H(addrs)) G-1THEN-0H addrs := addrs + ' '; 589 : 1 | G-1FOR-0H k := 1 G-1TO-0H lnth G-1DIV-0H 2 - (G-1LENGTH-0H(addrs) G-1DIV-0H 2) G-1DO-0H 590 : 1 | G-1WRITE-0H(G-1LST-0H,#32); 591 : 1 | G-1WRITE-0H(G-1LST-0H,Emphaszd,addrs); 592 : 1 | j := lnth G-1DIV-0H 2 + G-1LENGTH-0H(addrs) G-1DIV-0H 2; 593 : 0 G-1END-0H; 594 : 0 595 : 0 G-1PROCEDURE-0H Wrt_Date; 596 : 0 G-1VAR-0H 597 : 0 i : G-1INTEGER-0H; 598 : 1 G-1BEGIN-0H 599 : 1 | G-1FOR-0H i := 1 G-1TO-0H lnth - (j + G-1LENGTH-0H(date) - 1) G-1DO-0H 600 : 1 | G-1WRITE-0H(G-1LST-0H,#32); 601 : 1 | G-1WRITELN-0H(G-1LST-0H,date); 602 : 0 G-1END-0H; 603 : 0 604 : 0 G-1PROCEDURE-0H Wrt_city; 605 : 0 G-1VAR-0H 606 : 0 i : G-1INTEGER-0H; 607 : 1 G-1BEGIN-0H 608 : 1 | city := city + ' ' + st + ' ' + zip; 609 : 1 | k := G-1LENGTH-0H(city); 610 : 1 | G-1FOR-0H i := 1 G-1TO-0H lnth G-1DIV-0H 2 - (k G-1DIV-0H 2) G-1DO-0H 611 : 1 | G-1WRITE-0H(G-1LST-0H,#32); 612 : 1 | G-1WRITE-0H(G-1LST-0H,city); 613 : 1 | j := lnth G-1DIV-0H 2 + (G-1LENGTH-0H(city) G-1DIV-0H 2); 614 : 0 G-1END-0H; 615 : 0 D-Xref 6.3 12-21-1989 at 10 : 04 - - Listing for : c:\turbo-5\bulletin\printr2.pas Page 12 Line : D Statement 616 : 0 G-1PROCEDURE-0H Wrt_page; 617 : 0 G-1VAR-0H 618 : 0 i : G-1INTEGER-0H; 619 : 1 G-1BEGIN-0H 620 : 1 | inc(pag_num); 621 : 1 | G-1STR-0H(pag_num,pag); 622 : 1 | page := page + pag; 623 : 1 | G-1FOR-0H i := 1 G-1TO-0H lnth - (j + G-1LENGTH-0H(page)) G-1DO-0H 624 : 1 | G-1WRITE-0H(G-1LST-0H,#32); 625 : 1 | G-1WRITELN-0H(G-1LST-0H,page); 626 : 1 | j := 0; 627 : 0 G-1END-0H; 628 : 0 629 : 1 G-1BEGIN-0H 630 : 1 | page := 'Page No. '; 631 : 1 | pag_num := 0; 632 : 1 | lnth := 132; 633 : 1 | G-1WRITE-0H(G-1LST-0H,#27 + '@'); 634 : 1 | G-1WRITE-0H(G-1LST-0H,#27 + 'P'); 635 : 1 | Title(rpt_title); 636 : 1 | wrt_page; 637 : 1 | Wrt_address; 638 : 1 | Wrt_Date; 639 : 1 | G-1FOR-0H i := 1 G-1TO-0H lnth G-1DO-0H 640 : 2 | G-1BEGIN-0H 641 : 2 | | G-1WRITE-0H(G-1LST-0H,char_byte); 642 : 2 | | G-1IF-0H (i = lnth G-1DIV-0H 2) G-1THEN-0H G-1WRITE-0H(G-1LST-0H,'!'); 643 : 1 | G-1END-0H; 644 : 1 | G-1FOR-0H i := 1 G-1TO-0H 2 G-1DO-0H G-1WRITELN-0H(G-1LST-0H); 645 : 1 | G-1WRITE-0H(G-1LST-0H,#27 + '<'); {Home the print head} 646 : 0 G-1END-0H; 647 : 0 648 : 1 G-1BEGIN-0H 649 : 1 | G-1ASSIGN-0H(G-1LST-0H,'LPT1'); 650 : 1 | G-1REWRITE-0H(G-1LST-0H); 651 : 0 G-1END-0H. D-Xref 6.3 12-21-1989 at 10 : 04 - - Cross Reference for : c:\turbo-5\bulletin\printr2.pas Page 13 Cross Reference Page 1 A 114 ADDRS 77 78 349 514 538 586 587 587 588 588 588 589 591 592 AH 114 202 205 208 215 218 220 ANSWR 169 174 212 220 221 AUTHOR 65 B800 97 BACKSPACE 59 BACKSPC 52 BANNER 77 349 BANNER_BOTTOM 393 519 BANNER_LEFT 412 441 470 485 BANNER_RIGHT 430 442 478 489 BANNER_TOP 377 503 BASEOFSCREEN 97 BEEPR 76 140 210 BLACK 191 306 307 319 324 BOTTOM_HEADR 372 399 497 BOXF 171 183 185 186 187 189 190 192 193 BOX_KND 167 180 186 190 193 CARIG_RTN 64 CENTERED 60 CHAR_BYTE 53 386 402 403 426 435 641 CHAR_COUNT 371 388 501 CHECK_COLOR 82 91 185 189 192 195 CITY 77 78 349 461 461 462 462 464 464 515 538 587 608 608 609 612 613 COL 166 176 186 190 193 196 211 COMPRSD 34 COUNTR 148 151 380 383 396 399 405 449 452 CO_NAM 77 78 349 513 538 587 CRT 24 CX 118 DATE 510 599 601 DATESTR 68 80 104 DBL_PRTNG 38 DBL_WID 41 DH 119 DISPOSESCREEN 224 310 DL 120 DOS 24 DOSERROR 317 DRIVE_A 240 244 315 324 DRIVE_B 241 245 DX 203 216 EMPHASZD 36 568 591 END_COL 167 178 186 190 193 196 211 END_LIN 166 179 186 190 193 196 211 ESC 27 29 30 31 32 33 34 35 36 37 38 39 41 42 46 47 50 51 EXEC 315 EXPANDED 46 567 FASTTTT5 24 FBOX 186 190 193 FILLER 446 505 509 512 518 FILLER_LINE 438 454 FLUSHKEYBUFFER 246 FORM_FEED 63 GETENV 315 D-Xref 6.3 12-21-1989 at 10 : 04 - - Cross Reference for : c:\turbo-5\bulletin\printr2.pas Page 14 Cross Reference Page 2 GETKEY 212 GETSYSTEMDATE 80 104 124 I 370 380 385 396 401 557 563 565 566 569 570 571 575 597 599 606 610 618 623 639 642 644 IMPLEMENTATION 86 INC 389 620 INTERFACE 18 IO_NOT_OK 79 233 248 ITRATION 146 151 J 370 557 566 575 576 576 592 599 613 623 626 K 370 557 583 589 609 610 KEYTTT5 24 LEFT_MARGIN 61 LIGHTGRAY 184 305 306 307 319 324 LINE 166 177 186 190 193 196 196 211 211 LINE_FEED 62 LIN_COUNTER 371 389 499 LIN_LNTH 371 385 401 498 LNTH 557 565 576 589 592 599 610 613 623 632 639 642 LONGINT 81 128 MESSAGE 170 197 209 211 MISCTTT5 24 MKWIN 305 MSG 240 247 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 270 271 272 273 274 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 293 291 293 306 NAMES 458 502 NLQ 29 NLQ_OFF 30 NUM 73 79 233 248 249 251 293 311 311 446 452 504 505 508 509 511 512 517 518 NUMBER 81 128 135 NUMSTR 133 135 136 NUMTOSTR 81 128 136 293 OFF 28 42 47 51 61 OFFCURSOR 199 PAG 558 621 622 PAGE 72 78 373 538 622 622 623 625 630 PAG_LNTH 370 496 504 PAG_NUM 557 620 621 631 PHONE 77 349 516 PRINTER_ON 75 161 181 205 218 222 PRINTR2 17 RED 188 REGISTERS 109 168 REGS 109 113 113 114 115 116 168 200 204 208 213 217 220 REPLICATE 426 435 REPORT_HDR 78 538 REPORT_TITLE 467 507 RESTORESCREEN 223 309 RPT_TITLE 77 78 349 506 506 507 538 561 569 570 570 571 573 575 635 SAVESCREEN 182 295 SCRP_OFF 33 ST 77 78 349 462 464 538 587 608 ST2 110 118 124 ST3 110 119 122 122 122 124 ST4 110 120 123 123 123 124 STR1 467 473 D-Xref 6.3 12-21-1989 at 10 : 04 - - Cross Reference for : c:\turbo-5\bulletin\printr2.pas Page 15 Cross Reference Page 3 STRNTTT5 24 SUBSCRPT 32 SUB_TITLE 482 487 SUPERCRPT 31 SWAPVECTORS 314 316 TEXTF 82 91 99 171 194 195 196 211 THIRTEEN 58 TITLE 482 510 513 514 515 516 561 635 TITLE_LINES 372 500 TOP_HEADR 372 383 495 UNCOMPRSD 35 UNDR_LIN 50 UNDR_LIN_OFF 51 UNEMPHSZD 37 UNEXPAND 47 574 UNIT 17 UN_DBL 39 UN_WID 42 UPPER 306 319 324 487 506 USES 24 WHITE 183 WINTTT5 24 WORD 79 233 WRITEBETWEEN 196 211 306 307 319 324 WRT_ADDRESS 580 637 WRT_CITY 604 WRT_DATE 595 638 WRT_PAGE 616 636 YELLOW 187 194 305 ZIP 77 78 349 462 464 538 587 608 D-Xref 6.3 12-21-1989 at 10 : 04 - - Functions and Procedures for : c:\turbo-5\bulletin\printr2.pas Page 16 Cross Reference Page 4 Alphabetic Sort of Functions Begin Line End Line Function Name Listing File 80 ForWd GetSystemDate c:\turbo-5\bulletin\printr2.pas 104 125 GetSystemDate c:\turbo-5\bulletin\printr2.pas 233 329 IO_NOT_OK c:\turbo-5\bulletin\printr2.pas 79 ForWd IO_Not_OK c:\turbo-5\bulletin\printr2.pas 128 137 NumToStr c:\turbo-5\bulletin\printr2.pas 81 ForWd NumToStr c:\turbo-5\bulletin\printr2.pas 161 225 Printer_on c:\turbo-5\bulletin\printr2.pas 75 ForWd Printer_on c:\turbo-5\bulletin\printr2.pas Alphabetic Sort of Procedures Begin Line End Line Procedure Name Listing File 77 ForWd Banner c:\turbo-5\bulletin\printr2.pas 349 520 Banner c:\turbo-5\bulletin\printr2.pas 393 409 Banner_Bottom c:\turbo-5\bulletin\printr2.pas 377 391 Banner_Top c:\turbo-5\bulletin\printr2.pas 412 428 Banner_left c:\turbo-5\bulletin\printr2.pas 430 436 Banner_right c:\turbo-5\bulletin\printr2.pas 140 159 Beepr c:\turbo-5\bulletin\printr2.pas 76 ForWd Beepr c:\turbo-5\bulletin\printr2.pas 82 651 Check_color c:\turbo-5\bulletin\printr2.pas 91 102 Check_color c:\turbo-5\bulletin\printr2.pas 446 456 Filler c:\turbo-5\bulletin\printr2.pas 438 443 Filler_Line c:\turbo-5\bulletin\printr2.pas 458 465 Names c:\turbo-5\bulletin\printr2.pas 467 479 Report_Title c:\turbo-5\bulletin\printr2.pas 78 ForWd Report_hdr c:\turbo-5\bulletin\printr2.pas 538 646 Report_hdr c:\turbo-5\bulletin\printr2.pas 482 490 Title c:\turbo-5\bulletin\printr2.pas 561 577 Title c:\turbo-5\bulletin\printr2.pas 580 593 Wrt_Address c:\turbo-5\bulletin\printr2.pas 595 602 Wrt_Date c:\turbo-5\bulletin\printr2.pas 604 614 Wrt_city c:\turbo-5\bulletin\printr2.pas 616 627 Wrt_page c:\turbo-5\bulletin\printr2.pas Number Include Files : 0 Total Number Functions : 8 Total Number Procedures : 22 Total Different Variables : 140 Total Variables Used : 552 Total Lines Processed : 652