home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / APPS / BUSINESS / TTYPRT36.ZIP / HFAOI.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-12-07  |  16.6 KB  |  423 lines
  1. {Header, Footer, And Output Information - all one (long!) procedure}
  2.  
  3. PROCEDURE get_hfaoi; {eorf : CHAR}
  4. (*****************************************************************************
  5. Asks for header, footer and output information
  6. argument: 'E' if file input with mini-editor, 'F' if input from ext file
  7. ******************************************************************************)
  8. VAR
  9.     c,scode : CHAR;
  10.     ans : STRING[2];
  11.     i,err,num_blk : INTEGER;
  12.     all_defaults,found : BOOLEAN;
  13.     yr,mon,dy,dow : WORD;
  14.     yr_temp : STRING[4];
  15. LABEL restart,default_loop,prt_loop,page_loop,disp_loop;
  16. BEGIN
  17.     TextBackground(Black);
  18.     tot_pages:=TRUNC((tot_tty_lines/Max_Lines_Page)+0.98);
  19.     If tot_pages <= 0 THEN BEGIN
  20.         beep;
  21.         WRITELN; TextColor(LightMagenta);
  22.         WRITELN('No text in message.  Nothing to do!');
  23.         TextColor(Yellow);
  24.         WRITELN; WRITE('Strike any key to return to DOS ... ');
  25.         c:=READKEY;
  26.         WRITELN;
  27.         halt
  28.     END;
  29.     Num_blk:=1;
  30.     WRITELN;
  31.     found:=FALSE;
  32.     ASSIGN(io_file,bfn);                  {open sign block file}
  33.     IF NOT open_fn(bfn) THEN BEGIN
  34.         clrscr; TextColor(LightMagenta);
  35.         WRITELN('Signature block file not found');
  36.         WRITELN
  37.     END ELSE BEGIN
  38.         {first line of file has print positions:}
  39.         READLN(io_file,hp_lm,hp_tm,hp_head,hp_no,hp_text,hp_sign,hp_cl);
  40.         {reading signature block file:}
  41.         WHILE NOT EOF(io_file) DO BEGIN   {read sign blocks}
  42.             READLN(io_file,sig_blk[Num_blk].code);
  43.             READLN(io_file,sig_blk[Num_blk].line1);
  44.             READLN(io_file,sig_blk[Num_blk].line2);
  45.             num_blk:=num_blk+1
  46.         END;
  47.         CLOSE(io_file)
  48.     END;
  49.     num_blk:=num_blk-1;
  50.  
  51. restart:
  52.     TextBackGround(Black);
  53.     IF num_blk<=0 THEN BEGIN
  54.         TextColor(LightMagenta);
  55.         WRITELN('No default signature blocks found');
  56.         WRITELN
  57.     END ELSE BEGIN                  {if any good sign blocks}
  58.         CLRSCR; TextColor(LightGreen);
  59.         WRITE('Code ',#26,' Signature Block');     {show 'em on screen}
  60.         GOTOXY(39,1);
  61.         WRITE('Code ',#26,' Signature Block');     {second column}
  62.         TextColor(Cyan);
  63.         FOR i:=1 TO num_blk DO
  64.             IF INT(i/2)<>(i/2) THEN BEGIN
  65.                 GOTOXY(2,i+2);
  66.                 TextColor(LightRed); WRITE(sig_blk[i].code);
  67.                 TextColor(Cyan); WRITE(#26,sig_blk[i].line1);
  68.                 GOTOXY(4,i+3);
  69.                 WRITE(sig_blk[i].line2)
  70.             END ELSE BEGIN
  71.                 GOTOXY(40,i+1);
  72.                 TextColor(LightRed); WRITE(sig_blk[i].code);
  73.                 TextColor(Cyan); WRITE(#26,sig_blk[i].line1);
  74.                 GOTOXY(42,i+2);
  75.                 WRITE(sig_blk[i].line2)
  76.             END;
  77.         {end}
  78.         WRITELN;                             {sign block code entry}
  79.         WRITELN;
  80.         TextColor(LightCyan);   WRITE('     Options:    ');
  81.         TextColor(LightRed);  WRITE('<enter> ');
  82.         TextColor(Cyan); WRITELN(#26,' For manual entry of signature block');
  83.         TextColor(LightRed);  WRITE('                  <esc>  ');
  84.         TextColor(Cyan); WRITELN(#26,' To abort and exit TTYPRT to DOS');
  85.         TextColor(LightRed);  WRITE('                    =    ');
  86.         TextColor(Cyan); WRITELN(#26,' To review message text');
  87.         TextColor(LightRed);  WRITE('                    !    ');
  88.         TextColor(Cyan); WRITELN(#26,' Return to mini-editor for more text entry');
  89.         TextColor(LightRed);  WRITE('                    ?    ');
  90.         TextColor(Cyan); WRITELN(#26,' Help!  Explain this to me');
  91.         TextColor(LightRed);  WRITE('                    _    ');
  92.         TextColor(Cyan); WRITELN(#26,' Signature block code as above');
  93.         WRITELN;
  94.         TextColor(Yellow); WRITE('            Enter signature block code (or other option) ',#26,' ');
  95.         TextColor(Cyan); c:=READKEY;
  96.         c:=UpCase(c);
  97.         WRITELN(c);
  98.         CASE c OF
  99.         '=' : BEGIN
  100.                   disp_msg;
  101.                   GOTO restart
  102.               END;
  103.         #27 : BEGIN
  104.                   WRITELN; WRITELN; TextColor(Yellow);
  105.                   WRITE('Do you wish to abort and exit TTYPRT? ');
  106.                   c:=READKEY; TextColor(Cyan); WRITELN;
  107.                   IF c IN ['Y','y'] THEN BEGIN
  108.                       WRITELN('Aborting to DOS');
  109.                       HALT
  110.                   END;
  111.                   GOTO restart
  112.               END;
  113.         '!' : BEGIN
  114.                   IF eorf='E' THEN
  115.                       mini_ed(TRUE)    {restart of mini_ed}
  116.                   ELSE BEGIN
  117.                       eorf:='E';
  118.                       rfn:=ifn;
  119.                       mini_ed(FALSE)   {first run of mini_ed}
  120.                   END;
  121.                   GOTO restart
  122.               END;
  123.         '?' : BEGIN
  124.                   help_msg('signblk');
  125.                   GOTO restart
  126.               END
  127.         END {case}
  128.     END;
  129.  
  130.     i:=1;
  131.     WHILE (c <> sig_blk[i].code) AND (i < num_blk) DO i:=i+1;
  132.     IF c=sig_blk[i].code THEN BEGIN          {assign values from memory}
  133.         sign1:=sig_blk[i].line1;
  134.         sign2:=sig_blk[i].line2
  135.     END ELSE BEGIN
  136.         WRITELN; TextColor(Cyan);            {enter 'em manually}
  137.         WRITELN('Manual entry of signature block');
  138.         WRITELN('                    | maximum length of sign lines=35 |');
  139.         TextBackGround(Black); TextColor(Yellow); WRITE(' Enter first line ',#26,' ');
  140.         TextBackGround(Blue); TextColor(LightGray); READLN(sign1);
  141.         TextBackGround(Black); TextColor(Yellow); clreol; WRITE('Enter second line ',#26,' ');
  142.         TextBackGround(Blue); TextColor(LightGray); READLN(sign2);
  143.         TextBackGround(Black); clreol;
  144.     END;
  145.     FOR i:=1 TO LENGTH(sign1) DO sign1[i]:=UpCase(sign1[i]); {force all}
  146.     FOR i:=1 TO LENGTH(sign2) DO sign2[i]:=UpCase(sign2[i]); {uppercase}
  147.     sign1:=COPY(sign1,1,Sign_Length);        {limit length}
  148.     sign2:=COPY(sign2,1,Sign_Length);
  149.     WRITELN;
  150.  
  151. default_loop:
  152.     TextColor(Yellow);
  153.     WRITE('Use all header default settings? (Y/N/?/<esc>) ',#26,' ');
  154.     c:=READKEY; TextBackGround(Blue); TextColor(LightGray);
  155.     CASE c OF
  156.     'Y','y',#13 : BEGIN             {use all default settings?}
  157.                  all_defaults:=true;
  158.                  WRITE('Yes')
  159.               END;
  160.     'N','n' : BEGIN
  161.                  all_defaults:=FALSE;
  162.                  WRITE('No')
  163.               END;
  164.     '?'     : BEGIN
  165.                  help_msg('prtdeflts');
  166.                  clrscr;
  167.                  GOTO default_loop
  168.               END;
  169.     #27     : BEGIN
  170.                   TextColor(Yellow); TextBackGround(Black); WRITELN; WRITELN;
  171.                   WRITE('Do you wish to abort and exit TTYPRT? ');
  172.                   c:=READKEY; TextColor(Cyan); WRITELN;
  173.                   IF c IN ['Y','y'] THEN BEGIN
  174.                       WRITELN;
  175.                       WRITELN('Aborting to DOS');
  176.                       HALT
  177.                   END;
  178.                   GOTO default_loop
  179.               END;
  180.     ELSE      BEGIN
  181.                   beep; WRITELN; WRITELN;
  182.                   GOTO default_loop
  183.               END
  184.     END; {case}
  185.     TextBackGround(Black);
  186.     WRITELN;
  187.     WRITELN;
  188.  
  189.     IF all_defaults THEN                     {classification}
  190.         class:='UNCLASSIFIED'
  191.     ELSE BEGIN
  192.         TextColor(Yellow); WRITE('Enter classification (U,F,C,S,T), <enter> for "Unclass" ',#26,' ');
  193.         c:=READKEY; TextBackGround(Blue); TextColor(LightGray);
  194.         CASE c OF
  195.                ^M  : class:='UNCLASSIFIED';
  196.            'u','U' : class:='UNCLASSIFIED';
  197.            'f','F' : class:='FOR OFFICIAL USE ONLY';
  198.            's','S' : class:='SECRET';
  199.            'c','C' : class:='CONFIDENTIAL';
  200.            't','T' : class:='TOP SECRET';
  201.               ELSE   class:='UNCLASSIFIED'
  202.         END; {case}
  203.         WRITE(class); TextBackGround(Black); WRITELN;
  204.         IF (class[1]<>'U') AND (class[1]<>'F') THEN BEGIN
  205.             TextColor(Yellow); WRITE('Enter "CLASSIFIED BY" ',#26,' ');
  206.             TextBackGround(Blue); TextColor(LightGray);
  207.             READLN(class_by); TextBackGround(Black); clreol;
  208.             FOR i:=1 TO LENGTH(class_by) DO class_by[i]:=UpCase(class_by[i]);
  209.             TextColor(Yellow); WRITE('Enter "DECLASSIFY ON" ',#26,' ');
  210.             TextBackGround(Blue); TextColor(LightGray);
  211.             READLN(declass); TextBackGround(Black); clreol;
  212.             FOR i:=1 TO LENGTH(declass) DO declass[i]:=UpCase(declass[i]);
  213.         END
  214.     END;
  215.     WRITELN;
  216.  
  217.     IF all_defaults THEN                     {action precedence}
  218.         act_pred:='RR'
  219.     ELSE BEGIN
  220.         TextColor(Yellow); WRITE('Enter action addressees precedence, <enter> for "R" ',#26,' ');
  221.         c:=READKEY; TextBackGround(Blue); TextColor(LightGray);
  222.         IF c=^M THEN
  223.             act_pred:='RR'
  224.         ELSE
  225.             act_pred:=UpCase(c)+UpCase(c);
  226.         WRITE(act_pred);
  227.         TextBackGround(Black); WRITELN;
  228.     END;
  229.     WRITELN;
  230.  
  231.     IF all_defaults THEN                     {info precedence}
  232.         info_pred:='RR'
  233.     ELSE BEGIN
  234.         TextColor(Yellow); WRITE('Enter info addressees precedence, <enter> for "R" ',#26,' ');
  235.         c:=READKEY; TextBackGround(Blue); TextColor(LightGray);
  236.         IF c=^M THEN
  237.             info_pred:='RR'
  238.         ELSE
  239.             info_pred:=UpCase(c)+UpCase(c);
  240.         WRITE(info_pred);
  241.         TextBackGround(Black); WRITELN;
  242.     END;
  243.     WRITELN;
  244.  
  245.     IF all_defaults THEN                     {day time group}
  246.         dtg:='       '
  247.     ELSE BEGIN
  248.         TextColor(Yellow); WRITE('Optional: Enter Day Time Group, <enter> for blank ',#26,' ');
  249.         TextBackGround(Blue); TextColor(LightGray);
  250.         READLN(dtg); TextBackGround(Black); clreol;
  251.         IF LENGTH(dtg)>7 THEN dtg:=COPY(dtg,1,7);  {dtg is 7 chars only!}
  252.         WHILE LENGTH(dtg)<7 DO dtg:=dtg+' '        {dtg -> ddhhmmZ}
  253.     END;
  254.     WRITELN;
  255.  
  256. page_loop:
  257.     TextColor(cyan);
  258.     WRITELN('Number of pages in message ',#26,' ',tot_pages:3);
  259.     IF all_defaults THEN                     {starting page}
  260.         start_page:=1
  261.     ELSE BEGIN
  262.         TextColor(Yellow); WRITE('Start at what page, <enter> for beginning ',#26,' ');
  263.         TextBackGround(Blue); TextColor(LightGray);
  264.         READLN(ans);
  265.         IF ans='' THEN BEGIN
  266.             start_page:=1;
  267.             WRITE('Beginning')
  268.         END ELSE
  269.             VAL(ans,start_page,err);
  270.         TextBackGround(Black); clreol; WRITELN;
  271.     END;
  272.     IF (start_page<1) OR (start_page>tot_pages+1) THEN BEGIN
  273.         beep; TextColor(LightMagenta);
  274.         WRITELN('Cannot start printing at that page number!');
  275.         goto page_loop
  276.     END;
  277.     WRITELN;
  278.  
  279.     IF all_defaults THEN                     {ending page}
  280.         end_page:=99
  281.     ELSE BEGIN
  282.         TextColor(Yellow); WRITE('Stop after what page, <enter> for end ',#26,' ');
  283.         TextBackGround(Blue); TextColor(LightGray);
  284.         READLN(ans);
  285.         IF ans='' THEN BEGIN
  286.             end_page:=99;
  287.             WRITE('End')
  288.         END ELSE
  289.             VAL(ans,end_page,err);
  290.         TextBackGround(Black); clreol; WRITELN;
  291.     END;
  292.     WRITELN;
  293.  
  294.     GetDate(yr,mon,dy,dow);                  {convert system date to}
  295.     Str(yr:4,yr_temp);                       {something usable}
  296.     yr_str:=Copy(yr_temp,3,2);
  297.     CASE mon OF
  298.        1 : mon_str:='JAN';
  299.        2 : mon_str:='FEB';
  300.        3 : mon_str:='MAR';
  301.        4 : mon_str:='APR';
  302.        5 : mon_str:='MAY';
  303.        6 : mon_str:='JUN';
  304.        7 : mon_str:='JUL';
  305.        8 : mon_str:='AUG';
  306.        9 : mon_str:='SEP';
  307.       10 : mon_str:='OCT';
  308.       11 : mon_str:='NOV';
  309.       12 : mon_str:='DEC';
  310.     END; {case}
  311. disp_loop:
  312.     TextBackGround(Black); clrscr;  {display header, footer & output info}
  313.     TextColor(Cyan); WRITE('     Message Classification ',#26,' ');
  314.     TextBackGround(Blue); TextColor(LightGray);WRITE(class);
  315.     TextBackGround(Black); WRITELN;
  316.     IF (class[1]<>'U') AND (class[1]<>'F') THEN BEGIN
  317.         TextBackGround(Black); TextColor(Cyan); WRITE('              Classified By ',#26,' ');
  318.         TextBackGround(Blue); TextColor(LightGray);WRITE(class_by); WRITELN;
  319.         TextBackGround(Black);TextColor(Cyan); WRITE('              Declassify On ',#26,' ');
  320.         TextBackGround(Blue); TextColor(LightGray);WRITE(declass); WRITELN;
  321.     END;
  322.     TextBackGround(Black);TextColor(Cyan); WRITE('                       Date ',#26,' ');
  323.     TextBackGround(Blue); TextColor(LightGray);WRITE(mon_str,' ',yr_str); WRITELN;
  324.     TextBackGround(Black);TextColor(Cyan); WRITE('    Action/Info Precedences ',#26,' ');
  325.     TextBackGround(Blue); TextColor(LightGray);WRITE(act_pred,'/',info_pred); WRITELN;
  326.     IF dtg<>'       ' THEN BEGIN
  327.         TextBackGround(Black);TextColor(Cyan); WRITE('     Optional DayTime Group ',#26,' ');
  328.         TextBackGround(Blue); TextColor(LightGray);WRITE(dtg); WRITELN;
  329.     END;
  330.     WRITELN;
  331.     TextBackGround(Black);TextColor(Cyan); WRITE('     Signature Block line 1 ',#26,' ');
  332.     TextBackGround(Blue); TextColor(LightGray);WRITE(sign1); WRITELN;
  333.     TextBackGround(Black);TextColor(Cyan); WRITE('     Signature Block line 2 ',#26,' ');
  334.     TextBackGround(Blue); TextColor(LightGray);WRITE(sign2); WRITELN;
  335.     WRITELN;
  336.     TextBackGround(Black);TextColor(Cyan); WRITE('     Total lines in Message ',#26,' ');
  337.     TextBackGround(Blue); TextColor(LightGray);WRITE(tot_tty_lines:3); WRITELN;
  338.     TextBackGround(Black);TextColor(Cyan); WRITE('            Number of pages ',#26,' ');
  339.     TextBackGround(Blue); TextColor(LightGray);WRITE(tot_pages:3); WRITELN;
  340.     IF tot_mfr_lines>0 THEN BEGIN
  341.         TextBackGround(Black);TextColor(Cyan); WRITE('        Number of MFR lines ',#26,' ');
  342.         TextBackGround(Blue); TextColor(LightGray);WRITE(tot_mfr_lines:3); WRITELN;
  343.     END;
  344.     WRITELN;
  345.     TextBackGround(Black);TextColor(Cyan); WRITE('     Print starting at page ',#26,' ');
  346.     TextBackGround(Blue); TextColor(LightGray);
  347.     IF start_page=1 THEN
  348.         WRITE('Beginning')
  349.     ELSE
  350.         WRITE(start_page:3);
  351.     WRITELN;
  352.     TextBackGround(Black);TextColor(Cyan); WRITE('             Ending on page ',#26,' ');
  353.     TextBackGround(Blue); TextColor(LightGray);
  354.     IF end_page=99 THEN
  355.         WRITE('End')
  356.     ELSE
  357.         WRITE(end_page:3);
  358.     IF tot_mfr_lines>0 THEN WRITE(' + MFR');
  359.     WRITELN;
  360. prt_loop:
  361.     TextBackGround(Black); TextColor(LightGreen);
  362.     WRITELN;                                 {final prompt before printing}
  363.     WRITELN('Please insert DD173/2 form and insure the printer is setup for OCR-A printing');
  364.     WRITELN; TextColor(LightCyan);
  365.     WRITE('Options:  ');
  366.     TextColor(LightRed);  WRITE('<enter> ');
  367.     TextColor(Cyan); WRITE(#26,' Start printing           ');
  368.     TextColor(LightRed);  WRITE('R ');
  369.     TextColor(Cyan); WRITELN(#26,' Re-enter header info');
  370.     TextColor(LightRed);  WRITE('           <esc>  ');
  371.     TextColor(Cyan); WRITE(#26,' Abort TTYPRT to DOS      ');
  372.     TextColor(LightRed);  WRITE('= ');
  373.     TextColor(Cyan); WRITELN(#26,' Review message text');
  374.     TextColor(LightRed);  WRITE('             !    ');
  375.     TextColor(Cyan); WRITE(#26,' Return to mini-editor    ');
  376.     TextColor(LightRed);  WRITE('? ');
  377.     TextColor(Cyan); WRITELN(#26,' Help!  Explain this to me');
  378.     WRITELN;
  379.     TextColor(Yellow); WRITE('Waiting '); TextColor(Cyan);
  380.     c:=READKEY;
  381.     WRITELN;
  382.     CASE c OF
  383.     '='     : BEGIN
  384.                  disp_msg;
  385.                  GOTO disp_loop
  386.               END;
  387.     '?'     : BEGIN
  388.                  help_msg('prtready');
  389.                  clrscr;
  390.                  GOTO disp_loop
  391.               END;
  392.     '!'     : BEGIN
  393.                   IF eorf='E' THEN
  394.                       mini_ed(TRUE)    {restart of mini_ed}
  395.                   ELSE BEGIN
  396.                       eorf:='E';
  397.                       rfn:=ifn;
  398.                       mini_ed(FALSE)   {first run of mini_ed}
  399.                   END;
  400.                   GOTO disp_loop
  401.               END;
  402.     'R','r' : BEGIN
  403.                  clrscr;
  404.                  GOTO restart
  405.               END;
  406.     #27     : BEGIN
  407.                   WRITELN; TextColor(Yellow);
  408.                   WRITE('Do you wish to abort and exit TTYPRT? ');
  409.                   c:=READKEY; TextColor(Cyan); WRITELN;
  410.                   IF c IN ['Y','y'] THEN BEGIN
  411.                       WRITELN('Aborting to DOS');
  412.                       HALT
  413.                   END;
  414.                   GOTO prt_loop
  415.               END;
  416.     ^M      : ;   {no action, everything's ok}
  417.     ELSE      BEGIN
  418.                   beep;
  419.                   GOTO prt_loop
  420.               END
  421.     END {case}
  422. END; {PROCEDURE get_hfaoi}
  423.