home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / APPS / BUSINESS / TTYPRT36.ZIP / OUT_PROC.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-01-16  |  10.1 KB  |  276 lines
  1. {these routines contain all the printer-specific output stuff}
  2.  
  3. PROCEDURE prt_msg; {ok : BOOLEAN}
  4. (*****************************************************************************
  5. main body to print the message
  6. ******************************************************************************)
  7. VAR
  8.     abort : BOOLEAN;
  9.     ch : CHAR;
  10. BEGIN
  11.     TextColor(Cyan);
  12.     cur_page:=start_page;
  13.     abort:=FALSE;
  14. {$ifdef HPLJ}
  15.     WRITE(lst,#27,'E');                 {reset LaserJet}
  16.     WRITE(lst,#27,'&l0O');              {portrait}
  17.     WRITE(lst,#27,'(0O',#27,'(s0p10h12v0s0b0T'); {select OCR-A font}
  18.     WRITE(lst,#27,'&l6D');              {6 lines/inch}
  19.     WRITE(lst,#27,'&l0E');              {no top margin}
  20. {$endif}
  21. {$ifdef NEC}
  22.     WRITE(lst,#27,']L');                {10 pitch}
  23.     WRITE(lst,#27,']W');                {6 lines/inch}
  24. {$endif}
  25. {$ifdef KISS}
  26.     WRITE(lst,#27,'A',#12);             {6 lines/inch (12/72 in/lf)}
  27.     WRITE(lst,#27,'P');                 {10 Pitch}
  28.     WRITE(lst,#27,'[512;0;s');          {OCR A font, portrait}
  29. {$endif}
  30. {$ifdef ALPS}
  31.     WRITE(lst,#27,'@');                 {reset printer}
  32.     WRITE(lst,#27,'2');                 {6 lines/inch}
  33.     WRITE(lst,#27,'P');                 {10 Pitch}
  34.     WRITE(lst,#27,'x1');                {LQ print quality}
  35.     WRITE(lst,#27,'k1');                {Font Cartridge 2, hopefully OCR A}
  36. {$endif}
  37.     WHILE (cur_page<=tot_pages) AND (cur_page<=end_page)
  38.             AND NOT abort DO BEGIN      {loop for all pages}
  39.         WRITELN('Printing page ',cur_page);
  40.         cur_line:=1;
  41.         prt_header;                     {print header}
  42.         prt_body;                       {print body}
  43.         IF cur_page=1 THEN
  44.             prt_sign;                   {print signature block, first page only}
  45.         IF (class[1]='U') OR (class[1]='F') THEN
  46.             prt_class;                  {ending classification line if unclass}
  47.         cur_page:=cur_page+1;
  48.         WRITE(lst,#12); {formfeed}
  49.         WRITELN;
  50.         IF (cur_page<=tot_pages) AND (cur_page<=end_page) THEN BEGIN
  51.             TextColor(Cyan);
  52.             WRITELN('Insert next DD173/2 for page ',cur_page:2); TextColor(Yellow);
  53.             WRITE('Type <enter> to continue or <esc> to abort ',#26,' ');
  54.             ch:=READKEY; TextColor(Cyan);
  55.             WRITELN;
  56.             IF ch = #27 THEN abort:=TRUE;
  57.         END;
  58.     END;
  59.     IF abort THEN                       {return values}
  60.         ok:=FALSE
  61.     ELSE
  62.         ok:=TRUE;
  63. END; {PROCEDURE prt_msg (ok : BOOLEAN)}
  64.  
  65. PROCEDURE prt_header;
  66. (*****************************************************************************
  67. header line information
  68. Note: column numbers do *NOT* agree between NEC and HPLJ as they start
  69.       at different positions on the page!  HPLJ left margin = .62"; NEC = 0.
  70. ******************************************************************************)
  71. BEGIN
  72. {$ifdef HPLJ}
  73.     WRITE(lst,#27,'&a',hp_tm:0:1,'R');       {top margin}
  74.     IF (class[1]='U') OR (class[1]='F') THEN
  75.        WRITE(lst,#27,'&a42C',class);         {indent for classification}
  76.     WRITE(lst,#27,'&a',hp_head:0:1,'R');     {move to header line}
  77.     IF cur_page < 10 THEN                    {page number}
  78.         WRITE(lst,#27,'&a',hp_lm:0:1,'C','0',cur_page:1)  {left margin, then page}
  79.     ELSE
  80.         WRITE(lst,#27,'&a',hp_lm:0:1,'C',cur_page:2);
  81.     {end}
  82.     IF tot_pages < 10 THEN                   {of how many pages?}
  83.         WRITE(lst,#27,'&a',3.8+hp_lm:0:1,'C','0',tot_pages:1)
  84.     ELSE
  85.         WRITE(lst,#27,'&a',3.8+hp_lm:0:1,'C',tot_pages:2);
  86.     {end}
  87.  
  88.     WRITE(lst,#27,'&a',7.8+hp_lm:0:1,'C',dtg);           {day time group}
  89.     WRITE(lst,#27,'&a',16.8+hp_lm:0:1,'C',mon_str);      {month}
  90.     WRITE(lst,#27,'&a',21.8+hp_lm:0:1,'C',yr_str);       {year}
  91.     WRITE(lst,#27,'&a',25.8+hp_lm:0:1,'C',act_pred);     {action predecence}
  92.     WRITE(lst,#27,'&a',29.8+hp_lm:0:1,'C',info_pred);    {info predecence}
  93.     CASE class[1] OF
  94.         'U' : WRITE(lst,#27,'&a',33.8+hp_lm:0:1,'C','UUUU');
  95.         'F' : WRITE(lst,#27,'&a',33.8+hp_lm:0:1,'C','FFFF');
  96.         'C' : WRITE(lst,#27,'&a',33.8+hp_lm:0:1,'C','CCCC');
  97.         'S' : WRITE(lst,#27,'&a',33.8+hp_lm:0:1,'C','SSSS');
  98.         'T' : WRITE(lst,#27,'&a',33.8+hp_lm:0:1,'C','TTTT');
  99.     END; {case}
  100.  
  101.     IF cur_page=1 THEN BEGIN
  102.         WRITE(lst,#27,'&a',46.5+hp_lm:0:1,'C','AT');  {standard garbage}
  103.         WRITE(lst,#27,'&a',50.5+hp_lm:0:1,'C','ZYUW');
  104.     END;
  105.  
  106.     WRITELN(lst);                                     {'no' on first page only}
  107.     WRITELN(lst);
  108.     IF cur_page=1 THEN BEGIN
  109.         WRITE(lst,#27,'&a',hp_no:0:1,'R');            {move to book line}
  110.         WRITE(lst,#27,'&a',hp_lm:0:1,'C','NO')
  111.     END;
  112. {$endif}
  113. {$ifndef HPLJ}                {equivalent to ifdef NEC or KISS or ALPS}
  114.     IF (class[1]='U') OR (class[1]='F') THEN
  115.         WRITE(lst,'                                        ',class); {col 40+}
  116.     WRITELN(lst);
  117.     WRITELN(lst);
  118.     WRITELN(lst);
  119.     IF cur_page < 10 THEN
  120.         WRITE(lst,'0',cur_page:1)            {col 1-2, 2 chars}
  121.     ELSE
  122.         WRITE(lst,cur_page:2);
  123.     {end}
  124.     IF tot_pages < 10 THEN
  125.         WRITE(lst,' ','0',tot_pages:1)       {col 4-5, 2 chars}
  126.     ELSE
  127.         WRITE(lst,' ',tot_pages:2);
  128.     {end}
  129.  
  130.     WRITE(lst,'   ',dtg);                    {col  9-15, 7 Chars}
  131.     WRITE(lst,'  ',mon_str);                 {col 18-20, 3 chars}
  132.     WRITE(lst,'  ',yr_str);                  {col 23-24, 2 chars}
  133.     WRITE(lst,'  ',act_pred);                {col 27-28, 2 chars}
  134.     WRITE(lst,'  ',info_pred);               {col 31-32, 2 chars}
  135.     CASE class[1] OF
  136.         'U' : WRITE(lst,'  ','UUUU');        {col 35-38, 4 chars}
  137.         'F' : WRITE(lst,'  ','FFFF');
  138.         'C' : WRITE(lst,'  ','CCCC');
  139.         'S' : WRITE(lst,'  ','SSSS');
  140.         'T' : WRITE(lst,'  ','TTTT');
  141.     END; {case}
  142.  
  143.     IF cur_page=1 THEN BEGIN
  144.         WRITE(lst,'         ','AT');         {col 48-49, 2 chars}
  145.         WRITE(lst,'  ','ZYUW');              {col 52-55, 4 chars}
  146.     END;
  147.  
  148.     WRITELN(lst);
  149.     WRITELN(lst);
  150.     IF cur_page=1 THEN WRITE(lst,' NO');
  151.     WRITEln(lst);
  152.     WRITEln(lst);
  153. {$endif}
  154.     cur_line:=cur_line+7;
  155. END; {PROCEDURE prt_header}
  156.  
  157. PROCEDURE prt_body;
  158. (*****************************************************************************
  159. cycles for each page of the msg, abort if requested
  160. ******************************************************************************)
  161. VAR
  162.     line_cnt : INTEGER;
  163.     i : INTEGER;
  164. BEGIN
  165.     line_cnt:=1;
  166. {$ifdef HPLJ}
  167.     WRITE(lst,#27,'&a',hp_text:0:1,'R'); {forward to first line of message body}
  168. {$endif}
  169. {$ifdef NEC}
  170.     WRITE(lst,#27,';');       {negative 1/2 line feed}
  171. {$endif}
  172. {$ifdef KISS}
  173.     WRITE(lst,#27,'j',#18);   {negative 1/2 line feed (-6/216 in) }
  174. {$endif}
  175. {$ifdef ALPS}
  176.     WRITE(lst,#27,'j',#6);   {negative 1/2 line feed (-6/216 in) }
  177. {$endif}
  178.  
  179.     WHILE (line_cnt <= Max_Lines_Page) AND
  180.             ((Max_Lines_Page * (cur_page-1)+line_cnt) <= Tot_tty_lines) DO BEGIN
  181. {$ifdef HPLJ}
  182.         WRITE(lst,#27,'&a',hp_lm:0:1,'C'); {left margin}
  183. {$endif}
  184. {$ifdef NEC}
  185.         {no left margin for NEC}
  186. {$endif}
  187. {$ifdef KISS}
  188.         WRITE(lst,'      ');      {left margin for NEC}
  189. {$endif}
  190. {$ifdef ALPS}
  191.         {no left margin for ALPS}
  192. {$endif}
  193.         WRITELN(lst,tty[Max_Lines_Page*(cur_page-1)+line_cnt]);
  194.         WRITELN(lst);
  195.         cur_line:=cur_line+2;
  196.         line_cnt:=line_cnt+1
  197.     END {while}
  198. END; {PROCEDURE prt_body}
  199.  
  200. PROCEDURE prt_sign;
  201. (*****************************************************************************
  202. prints the signature block on Sign_Line and classified by line (first page only!)
  203. ******************************************************************************)
  204. BEGIN
  205. {$ifdef HPLJ}
  206.     WRITE(lst,#27,'&a',hp_sign:0:1,'R');          {vertical position}
  207.     WRITELN(lst,#27,'&a',hp_lm:0:1,'C',sign1);    {hor pos + print}
  208.     WRITE(lst,#27,'&a',hp_lm:0:1,'C',sign2);
  209. {$endif}
  210. {$ifndef HPLJ}                {equivalent to ifdef NEC or KISS or ALPS}
  211.     WHILE cur_line < Sign_Line DO BEGIN
  212.         WRITELN(lst);
  213.         cur_line:=cur_line+1;
  214.     END;
  215.     WRITELN(lst,sign1);
  216.     cur_line:=cur_line+1;
  217.     WRITE(lst,sign2);
  218. {$endif}
  219.     IF (class[1]<>'U') AND (class[1]<>'F') THEN BEGIN
  220.        WRITE(lst,^M,'                                        '); {col 40+}
  221.        WRITELN(lst,'CLASSIFIED BY ',class_by);
  222.        cur_line:=cur_line+1;
  223.        WRITE(lst,'                                        ');
  224.        WRITE(lst,'DECLASSIFY ON ',declass)
  225.     END;
  226.     WRITELN(lst);
  227.     cur_line:=cur_line+1
  228. END; {PROCEDURE prt_sign}
  229.  
  230. PROCEDURE prt_class;
  231. (*****************************************************************************
  232. prints the trailing class line if UNCLASS or FOUO
  233. ******************************************************************************)
  234. BEGIN
  235. {$ifdef HPLJ}
  236.     WRITE(lst,#27,'&a',hp_cl:0:1,'R');
  237.     WRITELN(lst,#27,'&a42C',class)
  238. {$endif}
  239. {$ifndef HPLJ}                {equivalent to ifdef NEC or KISS or ALPS}
  240.     WHILE cur_line < Bot_Class_Line DO BEGIN
  241.         WRITELN(lst);
  242.         cur_line:=cur_line+1;
  243.     END;
  244.     WRITELN(lst,'                                      ',class); {col 38+}
  245. {$endif}
  246. END; {PROCEDURE prt_class}
  247.  
  248. PROCEDURE prt_mfr;
  249. (*****************************************************************************
  250. prints the mfr as entered
  251. ******************************************************************************)
  252. VAR
  253.     ln,temp : STRING[132];
  254.     c : CHAR;
  255.     cc,i : INTEGER;
  256. BEGIN
  257.     WRITELN; TextColor(Yellow);
  258.     WRITE('Set-up printer for MFR, <enter> to continue or <esc> to abort ',#26,' ');
  259.     c:=READKEY; TextColor(Cyan);
  260.     WRITELN;
  261.     IF c=#27 THEN
  262.         WRITELN('Skipping print of MFR by user request ...')
  263.     ELSE BEGIN
  264. {$ifdef HPLJ}
  265.         WRITE(lst,#27,'&a',hp_lm:0:1,'L');   {set left margin for HPLJ only}
  266. {$endif}
  267.         FOR i:=1 TO tot_mfr_lines DO BEGIN
  268.             WRITELN(lst,mfr[i]);
  269. {$ifdef KISS}
  270.             WRITE(lst,#27,'    ');   {left margin for KISS}
  271. {$endif}
  272.         END;
  273.         WRITE(lst,#12)                      {formfeed and end of job}
  274.     END {ok to print mfr?}
  275. END; {PROCEDURE prt_mfr}
  276.