home *** CD-ROM | disk | FTP | other *** search
/ Point Programming 1 / PPROG1.ISO / pascal / swag / savescrn.swg / 0002_SAVE2.PAS.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-28  |  2.0 KB  |  99 lines
  1. {
  2. > Does anyone know of an easy way to remember the current
  3. > screen and then put it back when a Program is finished?
  4.  
  5. Here's one way to do it:
  6. }
  7.  
  8. Program SaveScr;
  9.  
  10. Uses
  11.   Crt, Dos;
  12.  
  13. Const
  14.   vidseg : Word = $B800;
  15.   ismono : Boolean = False;
  16.  
  17. Type
  18.   Windowrec = Array [0..4003] of
  19.   Byte;
  20.  
  21. Var
  22.   NewWindow : Windowrec;
  23.   c : Char;
  24.  
  25. Procedure checkvidseg;
  26. begin
  27.   if (mem [$0000 : $0449] = 7) then
  28.      vidseg := $B000
  29.   else
  30.      vidseg := $B800;
  31.   ismono := (vidseg = $B000);
  32. end;
  33.  
  34. Procedure savescreen (Var wind : Windowrec;
  35.   TLX, TLY, BRX, BRY : Integer);
  36. Var x, y, i : Integer;
  37. begin
  38.   checkvidseg;
  39.   wind [4000] := TLX;
  40.   wind [4001] := TLY;
  41.   wind [4002] := BRX;
  42.   wind [4003] := BRY;
  43.   i := 0;
  44.   For y := TLY to BRY Do
  45.     For x := TLX to BRX Do
  46.     begin
  47.       InLine ($FA);
  48.       wind [i] := mem [vidseg : (160 * (y - 1) + 2 * (x - 1) ) ];
  49.       wind [i + 1] := mem [vidseg : (160 * (y - 1) + 2 * (x - 1) ) + 1];
  50.       InLine ($FB);
  51.       Inc (i, 2);
  52.     end;
  53. end;
  54.  
  55. Procedure setWindow (Var wind : Windowrec; TLX, TLY, BRX, BRY : Integer);
  56. Var
  57.   i : Integer;
  58. begin
  59.   savescreen (wind, TLX, TLY, BRX, BRY);
  60.   Window (TLX, TLY, BRX, BRY);
  61.   ClrScr;
  62. end;
  63.  
  64. Procedure removeWindow (wind : Windowrec);
  65. Var TLX, TLY, BRX, BRY, x, y, i : Integer;
  66. begin
  67.   checkvidseg;
  68.   Window (1, 1, 80, 25);
  69.   TLX := wind [4000];
  70.   TLY := wind [4001];
  71.   BRX := wind [4002];
  72.   BRY := wind [4003];
  73.   i := 0;
  74.   For y := TLY to BRY Do
  75.     For x := TLX to BRX Do
  76.     begin
  77.       InLine ($FA);
  78.       mem [vidseg : (160 * (y - 1) + 2 * (x - 1) ) ] := wind [i];
  79.       mem [vidseg : (160 * (y - 1) + 2 * (x - 1) ) + 1] := wind [i + 1];
  80.       InLine ($FB);
  81.       Inc (i, 2);
  82.     end;
  83. end;
  84.  
  85. begin
  86.   TextColor(Yellow);
  87.   GotoXY(1,24);
  88.   Write('Press A Key to Save and Clear Screen...');
  89.   ReadKey;
  90.   setWindow (NewWindow, 1, 1, 80, 25);
  91.   GotoXY(1, 12);
  92.   Write ('Press a key to restore original screen...');
  93.   ReadKey;
  94.   removeWindow (NewWindow);
  95.   GotoXY (1, 24);
  96.   Write('Restored!!!');
  97.   ReadKey;
  98. end.
  99.