home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / interpre / p_pascal / samples / printlpt.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-05-16  |  2.6 KB  |  89 lines
  1. {$c+}
  2. { Program for copying a file with a `doc' suffix to }
  3. { the line printer `lpt1' (or subsititute `prn' or }
  4. { `com1' for `lpt1' in the PROGRAM line.) }
  5. PROGRAM printer(lpt1,doc);
  6. Const    ESC = #27;
  7.     TAB = #9;
  8.     PageSize = 50;
  9. Var    Copies, index, PageNum, LineNum : integer;
  10.     ch : char;
  11.     doc, lpt1 : text;
  12.     print_pnum : boolean;
  13. FUNCTION ToLower(ch : char) : char;
  14. Var    local : integer;
  15. BEGIN
  16.  local := Ord(ch) - Ord('A');
  17.  IF local in [0 .. 25] THEN ToLower := Chr(local + Ord('a'))
  18.  ELSE ToLower := ch
  19. END;
  20. FUNCTION ToOrd(ch : char) : integer;
  21. BEGIN
  22.  ToOrd := Ord(ToLower(ch)) - Ord('a') + 1
  23. END;
  24. BEGIN
  25.  { UTILITY PROGRAM FOR COPYING A TEXT FILE TO THE LINE PRINTER, }
  26.  { HERE DESIGNATED AS lpt1; YOUR PRINTER MAY BE lpt2 OR com1: }
  27.  Rewrite(lpt1);
  28.  Write(lpt1,ESC,'@');        { Initialize the printer. }
  29.  Write('Select proportional spacing (y/n)? '); Readln(ch);
  30.  IF ToLower(ch) = 'y' THEN Write(lpt1,ESC,'p',CHR(1));
  31.  Write('Use NLQ Printing? (y/n) ');  Readln(ch);
  32.  IF ToLower(ch) = 'y' THEN
  33.   BEGIN
  34.    Write(lpt1,ESC,'x',CHR(1));
  35.    Write('Automatic NLQ Justification? (y/n) '); Readln(ch);
  36.    IF ToLower(ch) = 'y' THEN Write(lpt1,ESC,'a',CHR(3))
  37.                  { NLQ Automatic Justification: }
  38.                 { 0 = Normal; 1 = Centered; }
  39.                 { 2 = Right Aligned; }
  40.                 { 3 = Left and right justified. }
  41.   END
  42.  ELSE
  43.   BEGIN
  44.    Write(
  45. 'Select Elite, Pica, Italic, Compressed, Expanded type: (e/p/i/c/x) '
  46.    ); Readln(ch);
  47.    IF ToOrd(ch) in [5{`e'},16{`p'},9{`i'},3{`c'},24{`x'}] THEN
  48.     case ch of
  49.      'e': Write(lpt1,ESC,'M');
  50.      'p': Write(lpt1,ESC,'P');
  51.      'i': Write(lpt1,ESC,'4');
  52.      'c': Write(lpt1,ESC,CHR(15));
  53.      'x': Write(lpt1,ESC,'E',CHR(14))
  54.     END
  55.   END;
  56.  Write('Print Page numbers on Top of the Page (y/n)? '); Readln(ch);
  57.  print_pnum := (ToLower(ch) = 'y');
  58.  Write('Number of copies to print (1..9): '); Readln(Copies);
  59.  Write(lpt1,ESC,'l',CHR(6));     { Left Margin Set to Column 10 = 6+4. }
  60.  WHILE Copies > 0 DO
  61.   BEGIN
  62.    PageNum := 2; LineNum := 1; Reset(doc);
  63.    WHILE NOT Eof(doc) DO
  64.     BEGIN
  65.      WHILE NOT Eoln(doc) DO
  66.       BEGIN
  67.        Read(doc,ch); Write(lpt1,ch)
  68.       END;
  69.      LineNum := Succ(LineNum);
  70.      Readln(doc);
  71.      IF LineNum <= PageSize THEN Writeln(lpt1)
  72.      ELSE
  73.       BEGIN
  74.        Page(lpt1);
  75.        IF print_pnum THEN
  76.         BEGIN
  77.          FOR LineNum := 1 TO 5 DO Write(lpt1, TAB);
  78.          Write(lpt1, '-', PageNum : 1, '-')
  79.         END;
  80.        Writeln(lpt1); Writeln(lpt1);
  81.        LineNum := 1; PageNum := Succ(PageNum)
  82.       END
  83.    END;
  84.    Copies := Pred(Copies)
  85.  END;
  86.  IF (LineNum > 1) AND (LineNum < PageSize) THEN Page(lpt1);
  87.  Write(lpt1,ESC,'@')        { Reset the printer. }
  88. END.
  89.