home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / mbug / mbug043.arc / SCREEN.PAS < prev    next >
Pascal/Delphi Source File  |  1979-12-31  |  2KB  |  74 lines
  1. Program Screen;
  2. {$C-}
  3. Const
  4.      PrinterInit : String[6] = #27'2'#27'A'#8#15;
  5.      PrinterReset : String[2] = #27'@';
  6.      GrInit      : String[4] = #27'K'#$80#$02;
  7.      Space       = ' ';
  8. Var
  9.    x,y,n : integer;
  10.    Resp : Char;
  11.    Char2 : Char;
  12.  
  13. Procedure WriteNulls;
  14. Var i : Integer;
  15. Begin
  16.      For i:=1 to 640 do Write(Lst,#$0);
  17. End;
  18. Begin
  19.      ClrScr;
  20.      Write ('Hit any key to start print, or <ESC> to abort');
  21.      REad(Kbd,Resp);
  22.      If REsp=#27 then Exit;
  23.      Writeln;
  24.      WriteNulls;
  25.      Writeln(Lst,PrinterReset,PrinterInit);
  26.      x:=0;
  27.      Write(Lst,'  ');
  28.      Repeat
  29.            Write(Lst,'       ');
  30.            x:=x+5;
  31.            if x=45 then Write(Lst,^H);
  32.            Write(Lst,x:2);
  33.      Until x>70;
  34.      Writeln(Lst);
  35.      For y:=1 to 24 do
  36.          For n:=0 to 1 do
  37.            Begin
  38.              If n=1 then Write(Lst,y:2) else Write(Lst,'  ');
  39.              Write(Lst,GRInit);
  40.               For x:=1 to 80 do
  41.                Begin
  42.                   If Round(20*x)/100=Round(0.2*x) then Char2:=Char($FF)
  43.                   Else Char2:=Char(($01 and n));
  44.                   If n=0 then Write(Lst,#$FF,Char2,#$00,#$00,#$00,#$00,#$00,#$00)
  45.                   Else Write(Lst,#$FF,Char2,#$01,#$01,#$01,#$01,#$01,#$01);
  46.                   If KeyPressed then
  47.                      Begin
  48.                           Write ('Abort print (Y/N)');
  49.                           REpeat
  50.                                 Read(Kbd,Resp);
  51.                                 Resp:=UpCase(Resp);
  52.                           Until Resp in ['Y','N'];
  53.                           If Resp='Y' then
  54.                              Begin
  55.                                   WriteNulls;
  56.                                   Writeln(Lst,PrinterReset);
  57.                                   Exit;
  58.                              End;
  59.                           Writeln;
  60.                      End;
  61.                 End;
  62.            Writeln(Lst);
  63.          End;
  64.      x:=0;
  65.      Write(Lst,'  ');
  66.      Repeat
  67.            Write(Lst,'       ');
  68.            x:=x+5;
  69.            if x=45 then Write(Lst,^H);
  70.            Write(Lst,x:2);
  71.      Until x>70;
  72.      Write(Lst,PrinterReset);
  73. End.
  74.