home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / mailit.zip / MPRINT.INC < prev    next >
Text File  |  1986-03-08  |  15KB  |  468 lines
  1.   { File = MPRINT.INC -- Include file for Reliance Mailing List
  2.     Copyright (c) 1986 William Meacham, All Rights Reserved
  3.     Revised: 3/7/86 }
  4.  
  5. overlay procedure print (opt : option) ;
  6.   { print list or labels }
  7.  
  8. var
  9.     which_ones  : prt_criterion ;
  10.     how_to_sort : sort_criterion ;
  11.     stop        : boolean ;        { whether to stop before done }
  12.     prt_num     : num_str_typ ;    { for printing dollar amounts }
  13.     prt_date    : datestring ;
  14.     num_out     : integer ;
  15.  
  16. { ==================== }
  17.  
  18. procedure get_a_rec ;
  19.   { get the next record to print }
  20.   begin
  21.     if how_to_sort = name then
  22.       begin
  23.         nextkey (ix1_file,rec_num,key1) ;
  24.         if OK then
  25.             getrec (mf_file,rec_num,master)
  26.       end
  27.     else { how_to_sort := szip }
  28.       begin
  29.         nextkey (ix2_file,rec_num,key2) ;
  30.         if OK then
  31.             getrec (mf_file,rec_num,master)
  32.       end
  33.   end ; { proc get_a_rec }
  34.  
  35. { ==================== }
  36.  
  37. function is_blank (st:str132) : boolean ;
  38. var
  39.     i : integer ;
  40. begin
  41.     is_blank := true ;
  42.     if not (st = '') then
  43.         for i := 1 to length(st) do
  44.             if not(st[i] = ' ') then
  45.                 is_blank := false
  46. end ; { function is_blank }
  47.  
  48. { ==================== }
  49.  
  50. procedure print_list ;
  51.  
  52. var
  53.     i,
  54.     page_num,
  55.     line_cnt   : integer ;                { counters }
  56.     header1,
  57.     header2    : str132 ;                 { page headers }
  58.     line       : array[1..4] of str132 ;  { detail lines }
  59.     ch         : char ;
  60.  
  61.     { - - - - - - - - - - - - - - - - }
  62.  
  63.     procedure print_page_header ;
  64.     { prints header line at top of each page }
  65.       begin
  66.         page_num := succ(page_num) ;
  67.         if page_num > 1 then
  68.             page (lst) ;
  69.         writeln (lst) ;
  70.         writeln (lst) ;
  71.         write   (lst,header1) ;
  72.         writeln (lst,page_num:5) ;
  73.         writeln (lst,header2) ;
  74.         writeln (lst) ;
  75.         line_cnt := 5
  76.       end ;  { --- proc print_page_header --- }
  77.  
  78.     { - - - - - - - - - - - - - - - - }
  79.  
  80.     procedure print (line:str132 ; num_newlines : integer) ;
  81.     { prints a line and the number of newlines indicated }
  82.       var
  83.         i : integer ;
  84.       begin
  85.         if line_cnt > max_lines then
  86.             print_page_header ;
  87.         write (lst,line) ;
  88.         for i := 1 to num_newlines do
  89.             writeln (lst) ;
  90.         line_cnt := line_cnt + num_newlines
  91.       end ;  { --- proc print --- }
  92.  
  93.     { - - - - - - - - - - - - - - - - }
  94.  
  95.     procedure print_a_name ;
  96.       label  99 ;
  97.       var
  98.           i  : integer ;
  99.       begin
  100.         if keypressed then
  101.           begin
  102.             keyin (ch) ;
  103.             if ch = #$1B then
  104.               begin
  105.                 write_str ('STOP NOW? (Y/N)',9,7) ;
  106.                 beep ;
  107.                 read_yn (stop,25,7) ;
  108.                 OK := not stop ;
  109.                 if OK then clrline(9,7) ;
  110.               end
  111.           end ;
  112.         if not OK then goto 99 ;
  113.  
  114.         for i := 1 to 4 do
  115.             line[i] := '' ;
  116.         with master do
  117.           begin
  118.             line[1] := concat(title,' ',frst_name,' ',last_name) ;
  119.             line[1] := stripch (line[1],' ') ;
  120.             add_blanks (line[1],65 - length(line[1])) ;
  121.             line[1] := concat(line[1],'Salut: ',salutation) ;
  122.             add_blanks (line[1],86 - length(line[1])) ;
  123.             line[1] := concat(line[1],'Hm ph: ',home_phon) ;
  124.             add_blanks (line[1],110 - length(line[1])) ;
  125.             line[1] := concat(line[1],'Wk ph: ',work_phon) ;
  126.  
  127.             line[2] := concat('  ',addr1) ;
  128.             add_blanks (line[2],42 - length(line[2])) ;
  129.             line[2] := concat(line[2],'Precinct ',precinct) ;
  130.             add_blanks (line[2],65 - length(line[2])) ;
  131.             editnum (last_amt,wid,frac,prt_num) ;
  132.             prt_date := mk_dt_st (last_date) ;
  133.             line[2] := concat(line[2],'Last amt: $',prt_num,', ',prt_date) ;
  134.             add_blanks (line[2],110 - length(line[2])) ;
  135.             editnum (tot_amt,wid,frac,prt_num) ;
  136.             line[2] := concat(line[2],'Total: $',prt_num) ;
  137.  
  138.             line[3] := concat ('  ',addr2) ;
  139.  
  140.             line[4] := concat('  ',city,', ',state,'  ',copy(zip,1,5)) ;
  141.             if length(zip) > 5 then
  142.                 line[4] := concat(line[4],'-',copy(zip,6,4)) ;
  143.           end ;
  144.         for i := 1 to 4 do
  145.             if not (is_blank(line[i])) then
  146.                 print (line[i],1) ;
  147.         print ('',1) ;
  148.         num_out := succ(num_out) ;
  149. 99:
  150.       end ; { proc print_a_name }
  151.  
  152.     { - - - - - - - - - - - - - - - - }
  153.  
  154.   begin  { --- procedure print_list --- }
  155.     header1 := 'RELIANCE MAILING LIST' ;         { build header1 line }
  156.     add_blanks (header1,23) ;
  157.     prt_date := mk_dt_st (cur_proc_dt) ;
  158.     header1 := concat(header1,center(concat(scr.ID,'  ',prt_date),43)) ;
  159.     add_blanks (header1,36) ;
  160.     header1 := concat (header1,'PAGE') ;
  161.  
  162.     case which_ones of                           { build header2 line }
  163.       all  :   header2 := 'All the names' ;
  164.       pcat : begin
  165.                header2 := 'Categories: ' ;
  166.                for i := 0 to 7 do
  167.                    if tstbit(mask,i) then
  168.                        header2 := concat(header2,scr.cat_name[i+1],', ') ;
  169.                delete (header2,length(header2)-1,2)
  170.              end ; { pcat }
  171.       pct  :   header2 := concat('Precinct ',pcinct) ;
  172.       pzip :   header2 := concat('Zip code ',copy(zipcode,1,5)) ;
  173.       dt   :   header2 := concat('Contributions since ',mk_dt_st(lastdt)) ;
  174.       amt  : begin
  175.                str (contrib:wid:frac,prt_num) ;
  176.                prt_num := stripch(prt_num,' ') ;
  177.                header2 := concat('Contributions of at least ',prt_num)
  178.              end ;
  179.     end ; { case }
  180.  
  181.     clrscr ;
  182.     write_str ('Printing list of names . . .',9,3) ;
  183.     write_str ('Press ESC to stop ',9,5) ;
  184.  
  185.     open_database ;
  186.     if how_to_sort = name then
  187.         clearkey (ix1_file)
  188.     else  { how_to_sort = szip }
  189.         clearkey (ix2_file) ;
  190.     page_num := 0 ; 
  191.     line_cnt := 99 ; { force header on first page }
  192.     num_out := 0 ;
  193.  
  194.     write (lst,scr.prt_init) ;
  195.     repeat
  196.         get_a_rec ;
  197.         if OK then
  198.             case which_ones of
  199.               all  : print_a_name ;
  200.               pcat : if (master.flags and mask) > 0 then
  201.                         print_a_name ;
  202.               pct  : if master.precinct = pcinct then
  203.                         print_a_name ;
  204.               pzip : if copy(master.zip,1,5) = copy(zipcode,1,5) then
  205.                         print_a_name ;
  206.               dt   : if not (greater_date(lastdt,master.last_date) = 1) then
  207.                         print_a_name ;
  208.               amt  : if not (greater(contrib,master.tot_amt)) then
  209.                         print_a_name ;
  210.             end { case }
  211.     until not OK ;
  212.  
  213.     close_database ;
  214.     if page_num > 0 then
  215.       begin
  216.         print ('',1) ;
  217.         write (lst,num_out) ;
  218.         print (' NAMES PRINTED',1) ;
  219.         page (lst)
  220.       end ;
  221.     write (lst,scr.prt_rset) ;
  222.     gotoxy(9,9) ;
  223.     write(num_out,' names printed') ;
  224.     beep ;
  225.     hard_pause
  226.   end ; { proc print_list }
  227.  
  228. { ==================== }
  229.  
  230. procedure print_labels ;
  231.  
  232. label 99 ;
  233.  
  234. type
  235.     label_buffer  = array [1..4] of string[60] ;  { two-up labels }
  236.  
  237. var
  238.     left, right   : label_buffer ;
  239.     line          : array [1..4] of str132 ;       { print lines }
  240.     ch            : char ;
  241.     left_is_empty : boolean ;
  242.  
  243.     { - - - - - - - - - - - - - - - - }
  244.  
  245.   procedure print_label_array ;    { print two labels, then clear the arrays }
  246.     var
  247.       i : integer ;
  248.     begin
  249.       for i := 1 to 4 do
  250.         begin
  251.           line[i] := left[i] ;
  252.           add_blanks (line[i],71 - length(line[i])) ;
  253.           line[i] := concat(line[i],right[i]) ;
  254.           writeln (lst,line[i]) ;
  255.           left[i] := '' ;
  256.           right[i] := ''
  257.         end ;
  258.       writeln (lst) ;
  259.       writeln (lst) ;
  260.     end ; { proc print_label_array }
  261.  
  262.     { - - - - - - - - - - - - - - - - }
  263.  
  264.   procedure print_test_pattern ;
  265.     var
  266.       savefld,choice : integer ;
  267.  
  268.     procedure print_pattern ;       { fill with Xs and print }
  269.       var
  270.         i,j : integer ;
  271.       begin
  272.         write (lst,scr.prt_init) ;
  273.  
  274.         prt_date := mk_dt_st(cur_proc_dt) ;          { build left[1] line }
  275.         left[1] := concat(' ',scr.ID,' ',prt_date,' ') ;
  276.         for i := length(left[1])+1 to 60 do
  277.             left[1] := concat(left[1],'X') ;
  278.  
  279.         case which_ones of                           { build left[2] line }
  280.           all  :   left[2] := ' All the names' ;
  281.           pcat : begin
  282.                    left[2] := ' Categories:' ;
  283.                    for i := 0 to 7 do
  284.                        if tstbit(mask,i) then
  285.                          begin
  286.                            str (i+1:2,prt_num) ;
  287.                            left[2] := concat(left[2],prt_num)
  288.                          end
  289.                  end ; { pcat }
  290.           pct  :   left[2] := concat(' Precinct ',pcinct) ;
  291.           pzip :   left[2] := concat(' Zip code ',copy(zipcode,1,5)) ;
  292.           dt   :   left[2] := concat(' Contributions since ',mk_dt_st(lastdt)) ;
  293.           amt  : begin
  294.                    str (contrib:wid:frac,prt_num) ;
  295.                    prt_num := stripch(prt_num,' ') ;
  296.                    left[2] := concat(' Contributions of at least ',prt_num)
  297.                  end ;
  298.         end ; { case }
  299.         left[2] := concat(left[2],' ') ;
  300.         for i := length(left[2])+1 to 60 do
  301.             left[2] := concat(left[2],'X') ;
  302.  
  303.         for j := 3 to 4 do                           { build left 3 and 4 }
  304.           begin
  305.             left[j] := ' ' ;
  306.             for i := 2 to 60 do
  307.                 left[j] := concat(left[j],'X')
  308.           end ;
  309.  
  310.         for j := 1 to 4 do                           { build right array }
  311.           begin
  312.             right[j] := ' ' ;
  313.             for i := 2 to 60 do
  314.                 right[j] := concat(right[j],'X')
  315.           end ;
  316.  
  317.         print_label_array ;
  318.         write (lst,scr.prt_rset)
  319.       end ;
  320.  
  321.     begin
  322.       clrscr ;
  323.       write_str ('PRINTING TEST PATTERN',30,2) ;
  324.       write_str ('Use the test pattern to align your printer',20,4) ;
  325.       write_str ('Please select:',26,6) ;
  326.       write_str ('1   Print test pattern again',26,8) ;
  327.       write_str ('2   Print the labels',26,9) ;
  328.       write_str ('ESC Cancel and return to menu',26,10) ;
  329.       write_str ('==> ',26,12) ;
  330.       print_pattern ;
  331.       repeat
  332.           fld := 1 ;
  333.           choice := 0 ;
  334.           read_int (choice,1,30,12) ;
  335.           if choice = 1 then
  336.               print_pattern ;
  337.       until (choice = 2) or (fld = maxint)
  338.     end ; { proc print_test_pattern }
  339.  
  340.     { - - - - - - - - - - - - - - - - }
  341.  
  342.   procedure print_a_label ;
  343.   { put name & address in output buffer, print if buffer full }
  344.  
  345.     procedure fill (var buf : label_buffer) ;
  346.       var
  347.         i,j : integer ;
  348.       begin
  349.         with master do
  350.           begin
  351.             buf[1] := concat(title,' ',frst_name,' ',last_name) ;
  352.             buf[1] := stripch (buf[1],' ') ;
  353.             buf[1] := concat(' ',buf[1]) ;
  354.             buf[2] := concat(' ',addr1) ;
  355.             buf[3] := concat(' ',addr2) ;
  356.             buf[4] := concat(' ',city,', ',state) ;
  357.             add_blanks (buf[4],34 - length(buf[4])) ;
  358.             buf[4] := concat(buf[4],copy(zip,1,5)) ;
  359.             if length(zip) > 5 then
  360.                 buf[4] := concat(buf[4],'-',copy(zip,6,4)) ;
  361.             for i := 1 to 4 do                   { get rid of blank lines }
  362.               begin
  363.                 if is_blank (buf[i]) then
  364.                   begin
  365.                     for j := i to 3 do
  366.                         buf[j] := buf[j+1] ;
  367.                     buf[4] := ''
  368.                   end  { if }
  369.               end { for i ... }
  370.           end { with }
  371.       end ; { proc fill }
  372.  
  373.     begin  { proc print_a_label }
  374.       if keypressed then
  375.         begin
  376.           keyin (ch) ;
  377.           if ch = #$1B then
  378.             begin
  379.               write_str ('STOP NOW? (Y/N)',9,7) ;
  380.               beep ;
  381.               read_yn (stop,25,7) ;
  382.               OK := not stop ;
  383.               if OK then clrline(9,7) ;
  384.             end
  385.         end ;
  386.       if OK then
  387.         begin
  388.           if left_is_empty then
  389.             begin
  390.               fill(left) ;
  391.               left_is_empty := false
  392.             end
  393.           else
  394.             begin
  395.               fill(right) ;
  396.               print_label_array ;
  397.               left_is_empty := true
  398.             end ; { else }
  399.           num_out := succ(num_out)
  400.         end { if OK }
  401.     end ;  { proc print_a_label }
  402.  
  403.     { - - - - - - - - - - - - - - - - }
  404.  
  405.   begin { --- procedure print_labels --- }
  406.     fld := 1 ;
  407.     print_test_pattern ;
  408.     if fld = maxint then goto 99 ;
  409.  
  410.     clrscr ;
  411.     write_str ('Printing labels . . .',9,3) ;
  412.     write_str ('Press ESC to stop ',9,5) ;
  413.     open_database ;
  414.     if how_to_sort = name then
  415.         clearkey (ix1_file)
  416.     else  { how_to_sort = szip }
  417.         clearkey (ix2_file) ;
  418.     left_is_empty := true ;
  419.     num_out := 0 ;
  420.  
  421.     write (lst,scr.prt_init) ;
  422.     repeat
  423.         get_a_rec ;
  424.         if OK then
  425.             case which_ones of
  426.               all : print_a_label ;
  427.               pcat : if (master.flags and mask) > 0 then
  428.                         print_a_label ;
  429.               pct : if master.precinct = pcinct then
  430.                         print_a_label ;
  431.               pzip : if copy(master.zip,1,5) = copy(zipcode,1,5) then
  432.                         print_a_label ;
  433.               dt  : if not (greater_date(lastdt,master.last_date) = 1) then
  434.                         print_a_label ;
  435.               amt : if not (greater(contrib,master.tot_amt)) then
  436.                         print_a_label ;
  437.             end { case }
  438.     until not OK ;
  439.     if not (left_is_empty) then
  440.         print_label_array ;
  441.     write (lst,scr.prt_rset) ;
  442.  
  443.     close_database ;
  444.     gotoxy(9,9) ;
  445.     write(num_out,' names printed') ;
  446.     beep ;
  447.     hard_pause ;
  448.     fld := 3 ;
  449. 99:
  450.   end ; { proc print_labels }
  451.  
  452. { ==================== }
  453.  
  454. begin { --- procedure print --- }
  455.     fld := 1 ;
  456.     select (which_ones, how_to_sort, opt) ;
  457.     if not (fld = maxint) then
  458.         case opt of
  459.             list   : print_list ;
  460.             labels : print_labels
  461.         end ; { case }
  462.     fld := 1
  463. end ; { procedure print }
  464.  
  465. { ---- EOF FILE MPRINT.INC ---------------------------------- }
  466.               pzip : if copy(master.zip,1,5) = copy(zipcode,1,5) then
  467.                         print_a_label ;
  468.