home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / UTILITY / PRINTER / LIST.ZIP / LIST.PAS next >
Encoding:
Pascal/Delphi Source File  |  1992-01-02  |  4.0 KB  |  127 lines
  1. program list(input,output,address_file);
  2. { this program formats the printing of labels on an epson FX-80
  3.   printer.  The source addresses are in a file that will be prompted
  4.   for if not supplied on the command line.  The addresses are in the
  5.   file with a max. of 4 lines and ONE blank line between them }
  6. const
  7.     numlablesacross = 3;    { the number of label col. on a sheet }
  8.     firsttab = 2;        { offset to start first one }
  9.     tabspace = 27;  { 80 div 3 }
  10.     verttab = 6;    { number of lines from one label to an other }
  11.     characross = 80; { width of printer in chars }
  12.     maxinline = 24;      { 80 div 3 - 5 }
  13.     maxlinespage = 7;  { the number of label rows on a sheet }
  14.                 { I had to waste the first row to load the sheet }
  15. type
  16.     lineacross = string(characross);  { the line to print }
  17.     inline = string(maxinline);    { a line of the address }
  18.  
  19. var    line1,line2,line3,line4: lineacross; { buffers for the printer }
  20.     address_file,printer: text;      { the input and output files }
  21.     linecount: integer;        { used to count the numbers on a page}
  22.  
  23. procedure blank(var aline: lineacross);
  24. { clear the buffer line }
  25. var    i: integer;
  26. begin
  27.   for i := 1 to characross do aline[i] := ' ';
  28. end;
  29.  
  30. procedure asignline(var inl: inline; var aline: lineacross;
  31.                     size,index: integer);
  32. { load the buffer line }
  33. var    i: integer;
  34. begin
  35.   for i := 0 to (size-1) do
  36.     if (index+i) <= characross then aline[index+i] := inl[i+1]
  37. end;
  38.  
  39. procedure printline(var aline: lineacross);
  40. { write out a print buffer to the printer }
  41. var    i: integer;
  42. begin
  43.   for i := 1 to    characross do write(printer,aline[i]);
  44.   writeln(printer);
  45. end;
  46.  
  47. function getline(var line: inline; var size:integer): boolean;
  48. { read in a source line from the file }
  49. var    i: integer;
  50. begin
  51.   if (not eof(address_file)) and (not eoln(address_file)) then begin
  52.     if address_file^ <> ';' then begin    {address commented out }
  53.       for i := 1 to maxinline do line[i] := ' ';
  54.       getline := true;    i := 1;
  55.       while (not eof(address_file)) and (not eoln(address_file))
  56.        and(i <= maxinline) do begin
  57.         read(address_file,line[i]);
  58.         i := i + 1
  59.       end;
  60.       size := i - 1;
  61.     end else getline := false;
  62.   end else begin
  63.     getline := false;
  64.   end;
  65.   if (not eof(address_file)) then readln(address_file);
  66. end;
  67. procedure skipone;
  68. var    i: integer;
  69. begin
  70.   if not eof(address_file) then
  71.     if address_file^ = ';' then readln(address_file);
  72.   if not eof(address_file) then
  73.     if address_file^ = ';' then readln(address_file);
  74.   if not eof(address_file) then
  75.     if address_file^ = ';' then readln(address_file);
  76.   if not eof(address_file) then
  77.     if address_file^ = ';' then readln(address_file);
  78. end;
  79.  
  80. procedure dosome;
  81. { load and print one row of labels across the sheet }
  82. var    i,size: integer;
  83.     ainline: inline;
  84.     outline: lineacross;
  85. begin
  86.   blank(line1);  blank(line2);  blank(line3);  blank(line4);
  87.   for i := 0 to (numlablesacross-1) do begin
  88.     if not eof(address_file) then begin
  89.       while address_file^ = ';' do skipone;
  90.       if eoln(address_file) then readln(address_file); {skip the blank}
  91.       if getline(ainline,size) then begin
  92.         asignline(ainline,line1,size,(firsttab+i*tabspace));
  93.         if getline(ainline,size) then begin
  94.           asignline(ainline,line2,size,(firsttab+i*tabspace));
  95.           if getline(ainline,size) then begin
  96.             asignline(ainline,line3,size,(firsttab+i*tabspace));
  97.             if getline(ainline,size) then begin
  98.               asignline(ainline,line4,size,(firsttab+i*tabspace));
  99.         end
  100.       end
  101.     end
  102.       end;
  103.     end
  104.   end;
  105.   printline(line1);
  106.   printline(line2);
  107.   printline(line3);
  108.   printline(line4);
  109.   for i := 5 to verttab do writeln(printer);
  110. end;
  111.  
  112. begin
  113.   reset(address_file);        { set the input }
  114.   assign(printer,'PRN:');    {if not ibm-pc then could write to file}
  115.   rewrite(printer);
  116.   linecount := 0;
  117.   while not eof(address_file) do begin
  118.     linecount := linecount + 1;
  119.     dosome;
  120.     if linecount = maxlinespage then begin    { if end of a sheet }
  121.       writeln('Add new label sheet to printer');
  122.       write('Hit Return when ready');
  123.       readln;    linecount := 0;
  124.     end;
  125.   end;
  126. end.
  127.