home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PASDEMO2.ZIP / HYK-TEST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-11-20  |  2.4 KB  |  106 lines
  1. PROGRAM Print_Text_1;
  2. TYPE
  3.    Array80 = String[80];
  4. CONST
  5.    Title = ' ** Printing Text File Program **';
  6.    FormFeed = #12;
  7.    PathLength = 55;
  8.    VerticalTabLength = 3;
  9. VAR
  10.    OneRecord : Array80;
  11.    InFile, Printer : Text;
  12.    RecordLength : Integer;
  13.    LineCount : Integer;
  14. PROCEDURE PrintEmphChars;
  15. VAR
  16.    EmphSet, EmphRelease : String[2];
  17.    Esc : Char;
  18. BEGIN
  19.    Esc := chr(27);
  20.    EmphSet := Esc + 'E';
  21.    EmphRelease := Esc + 'F';
  22.    Write( Printer, chr(27) + 'G' );
  23.    Write( Printer, chr(27) + '-' + chr(1) );
  24.    Write( Printer, chr(27) + 'E' );
  25.    Write( Printer, OneRecord );
  26.    Write( Printer, chr(27) + 'F' );
  27.    Write( Printer, chr(27) + '-' + chr(0) );
  28.    Writeln( Printer, chr(27) + 'H' );
  29.    LineCount := LineCount + 1
  30. END; { PrintEmphChars }
  31.  
  32. Procedure VerticalTab;
  33. var i : Integer;
  34. begin
  35.    for i := 1 to VerticalTabLength do writeln( Printer, '' );
  36. end;
  37.  
  38. PROCEDURE Checking;
  39. CONST
  40.    Space = ' ';
  41. TYPE
  42.    Capital = SET OF Char;
  43. VAR
  44.    AllUpperCase : Boolean;
  45.    UpperCase : Capital;
  46.    i : Integer;
  47. BEGIN
  48.    UpperCase := [ 'A' .. 'Z' ];
  49.    AllUpperCase := True;
  50.    FOR i := 1 TO RecordLength DO
  51.    BEGIN
  52.       IF NOT ( OneRecord[i] IN UpperCase ) and ( OneRecord[i] <> Space )
  53.          THEN AllUpperCase := False
  54.    END; { for }
  55.    IF AllUpperCase
  56.       THEN PrintEmphChars
  57.       ELSE
  58.          BEGIN
  59.             Write( Printer, chr(27) + 'G' );
  60.             Write( Printer, OneRecord );
  61.             Writeln( Printer, chr(27) + 'H' );
  62.             Writeln( Printer, ' ' );
  63.             LineCount := LineCount + 2;
  64.             If LineCount > PathLength  then
  65.             begin
  66.                Writeln( Printer, FormFeed );
  67.                VerticalTab;
  68.                LineCount := 1;
  69.             end;
  70.          END; { else }
  71. END; { Checking }
  72.  
  73.  
  74. PROCEDURE OpenFile;
  75. VAR
  76.    FileName : String[11];
  77. BEGIN
  78.    Writeln( Title );
  79.    Writeln;
  80.    Write( 'Print what file ? ');
  81.    Readln( Filename );
  82.    Assign( InFile, FileName );
  83.    Reset( InFile );
  84.    Assign( Printer, 'LST:' );
  85.    Rewrite( Printer )
  86. END;
  87.  
  88. PROCEDURE ProcessPrinting;
  89. BEGIN
  90.    WHILE NOT Eof( InFile ) DO
  91.    BEGIN
  92.       Readln( InFile, OneRecord );
  93.       RecordLength := Length( OneRecord );
  94.       IF Length( OneRecord ) = 0
  95.          THEN Writeln( Printer, OneRecord )
  96.          ELSE Checking
  97.    END; { While }
  98. END; { ProcessPrinting }
  99.  
  100. BEGIN
  101.    ClrScr;
  102.    OpenFile;
  103.    ProcessPrinting;
  104.    Close( InFile );
  105.    Close( Printer )
  106. End.