home *** CD-ROM | disk | FTP | other *** search
/ Compy Shop Magazin 1988 August / Compy_Shop_Magazin_1988_08___de_Side_A.atr / proprint.pas < prev   
Pascal/Delphi Source File  |  2023-02-26  |  2KB  |  1 lines

  1. PROGRAM proprint (input,output);¢             (* druckt Programmfiles *)¢¢¢TYPE¢    String15 = ARRAY[1..15] OF Char;¢VAR¢  Z1,z2,n,x: Integer;¢  e,c: Char;¢    f,printer: Text;¢    s: String15;¢¢PROCEDURE cls; (* loescht den Bild- *)¢               (* schirm, Aufruf "cls"*)¢¢BEGIN¢writeln(chr(125));¢writeln;writeln¢END;¢¢¢PROCEDURE zeichensatz(x,y:integer);¢¢BEGIN¢ Write(printer,(chr(27)),'R',(chr(x)));¢ Write(printer,(chr(27)),'!',(chr(y)));¢END;¢¢¢PROCEDURE druckereinstellung;¢BEGIN¢ Writeln(printer,(chr(27)),'l',(chr(10)));¢   (* linker Rand auf Grad 10       *)¢¢ Writeln(printer,(chr(27)),'N',(chr(10)))¢   (* die letzten 10 Zeilen einer   *)¢   (* Seite werden vorgeschoben     *)¢END;¢¢BEGIN     (* Hauptprogramm *)¢e:='J';   (* e wird zum Durchlaufen  *)¢          (* der Schleife vorbesetzt *)¢REPEAT¢IF(e='J') OR (e='j') THEN¢BEGIN¢ x:=0; (* kennzeichnet EOLN          *)¢ n:=1; (* Zeilennummer               *)¢ cls;  (* Aufruf Bildschirm loeschen *)¢ Write('FILENAME? ':15); Readln(s);¢ writeln;¢ Write('Zeilen nummerieren(J/N)? ':30); Readln(c);¢Rewrite(Printer,'P:');¢   (* oeffnet Kanal fuer den Drucker *)¢ Reset(f,s);¢   (* setzt die Files f und s auf    *)¢   (* Anfang.                        *)¢¢z1:=0; (* amerikanischer Zeichensatz *)¢z2:=1; (* Schriftart Elite           *)¢¢zeichensatz(z1,z2);¢¢druckereinstellung;¢¢WHILE NOT EOF(f) DO¢ BEGIN¢  IF ((c='J') OR (c='j')) AND (x=0) THEN¢   BEGIN¢    x:=1; (* Kein Zeilenende   *)¢    IF n<10 THEN Write(printer,'000',n,'  '); (* fuehrende Nullen einsteuern *) ¢    IF (n>9) AND (n<100) THEN Write(printer,'00',n,'  ');¢    IF (n>99) AND (n<1000) THEN Write(printer,'0',n,'  ');¢    IF n>999 THEN Write(printer,n,'  ')¢ END;¢ IF EOLn(f) THEN  (* Zeile drucken  *)¢            BEGIN¢             x:=0;¢             n:=n+1;¢             Writeln(printer)¢            END¢    ELSE Write(printer,f^);¢ Get(f); (* Zeile aufbereiten  *)¢END;¢¢z1:=2; (* deutscher Zeichensatz     *)¢z2:=0; (* Loeschen Schriftart Elite *)¢zeichensatz(z1,z2);¢ writeln(printer,(chr(12)));¢  (* Blattvorschub *)¢Writeln;¢¢ Write('Noch ein Ausdruck? (J/N) ':29);¢ readln(e)¢END;¢UNTIL (e<>'J') AND (e<>'j')¢END.