home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / SAVE.ZIP / SAVE.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1988-09-13  |  4.2 KB  |  183 lines
  1. {$S+}
  2. {$V+}
  3. {$R+}
  4. {$I+}
  5. Program SampleScreenHandling;
  6. Uses Dos,
  7.      Crt;
  8.  
  9. Type
  10.   ScreenType = array[0..4006] of byte;
  11.  
  12.   (* 0..3999 is for the screen data           *)
  13.   (* 4000..40003 is the current window        *)
  14.   (* 4004 is the current drawing color        *)
  15.   (* 4005..4006 is the cursor X,Y coordinates *)
  16.  
  17.  
  18. (* The Two Procedures SaveScreen & RestoreScreen have already been
  19.    UpLoaded under the File Name SCREEN.ARC *)
  20.  
  21.  
  22. Procedure SaveScreen(Var Screen:ScreenType);
  23. Var
  24.   ColorScreen : ScreenType absolute $B800:$0000;
  25.   MonoScreen  : ScreenType absolute $B000:$0000;
  26. begin
  27.   Case LastMode of
  28.        BW40 : Move(ColorScreen,Screen,2000);
  29.        CO40 : Move(ColorScreen,Screen,2000);
  30.        BW80 : Move(ColorScreen,Screen,4000);
  31.        CO80 : Move(ColorScreen,Screen,4000);
  32.        Mono : Move(MonoScreen,Screen,4000);
  33.     Font8x8 : begin (* not used by our system *) end;
  34.   end;(*case*)
  35.   Screen[4000]:=lo(WindMin)+1;
  36.   Screen[4001]:=hi(WindMin)+1;
  37.   Screen[4002]:=lo(WindMax)+1;
  38.   Screen[4003]:=hi(WindMax)+1;
  39.   Screen[4004]:=TextAttr;
  40.   Screen[4005]:=WhereX;
  41.   Screen[4006]:=WhereY;
  42. end;
  43.  
  44.  
  45. Procedure RestoreScreen(Var Screen:ScreenType);
  46. Var
  47.   ColorScreen : ScreenType absolute $B800:$0000;
  48.   MonoScreen  : ScreenType absolute $B000:$0000;
  49. begin
  50.   Case LastMode of
  51.        BW40 : Move(Screen,ColorScreen,2000);
  52.        CO40 : Move(Screen,ColorScreen,2000);
  53.        BW80 : Move(Screen,ColorScreen,4000);
  54.        CO80 : Move(Screen,ColorScreen,4000);
  55.        Mono : Move(Screen,MonoScreen,4000);
  56.     Font8x8 : begin (* not used by our system *) end;
  57.   end;(*case*)
  58.   Window(Screen[4000],Screen[4001],Screen[4002],Screen[4003]);
  59.   TextAttr:=Screen[4004];
  60.   GoToXY(Screen[4005],Screen[4006]);
  61. end;
  62.  
  63.  
  64. Procedure SaveScreenBuffToDisk(Var Screen:ScreenType;FileName:string);
  65. Var
  66.   FilVar : file;
  67.   Result : integer;
  68. begin
  69.   Assign(FilVar,FileName);
  70.   ReWrite(FilVar);
  71.   FileRec(FilVar).RecSize:=SizeOf(Screen);  (* define 1 record as 4007 bytes *)
  72.   BlockWrite(FilVar,Screen,1,Result);
  73.   Close(FilVar);
  74.   Result:=IOResult;
  75. end;
  76.  
  77.  
  78. Procedure RestoreScreenBuffFromDisk(Var Screen:ScreenType;FileName:string);
  79. Var
  80.   FilVar : file;
  81.   Result : integer;
  82. begin
  83.   Assign(FilVar,FileName);
  84.   Reset(FilVar);
  85.   FileRec(FilVar).RecSize:=SizeOf(Screen);  (* define 1 record as 4007 bytes *)
  86.   BlockRead(FilVar,Screen,1,Result);
  87.   Close(FilVar);
  88.   Result:=IOResult;
  89. end;
  90.  
  91. Procedure DrawBox(X1,Y1,X2,Y2:integer);
  92. Var
  93.   X,Y : integer;
  94. begin
  95.   For X:=X1 to X2 do
  96.     begin
  97.       GoToXY(X,Y1); Write('-');
  98.       GoToXY(X,Y2); Write('-');
  99.     end;
  100.   For Y:=Y1 to Y2 do
  101.     begin
  102.       GoToXY(X1,Y); Write('|');
  103.       GoToXY(X2,Y); Write('|');
  104.     end;
  105. end;
  106.  
  107. Procedure PressKey(Title:string);
  108. Var
  109.   Key : char;
  110. begin
  111.   GotoXY(1,1); Write(Title,'.   Please Press A Key');
  112.   Key:=ReadKey;
  113. end;
  114.  
  115.  
  116. Var
  117.   Screen : ScreenType;
  118.  
  119. begin
  120.  
  121.   (* save the first screen to disk *)
  122.  
  123.  
  124.   TextBackGround(Black);
  125.   TextColor(Blue);
  126.   ClrScr;
  127.   DrawBox(10,1,30,10);
  128.   TextColor(White);
  129.   DrawBox(20,10,78,23);
  130.   SaveScreen(Screen);
  131.   SaveScreenBuffToDisk(Screen,'SAVE.P1X');
  132.   PressKey('Saved SAVE.P1X to Disk');
  133.  
  134.  
  135.   (* save the 2nd screen to disk *)
  136.  
  137.  
  138.   TextBackGround(Blue);
  139.   TextColor(White);
  140.   ClrScr;
  141.   DrawBox(10,1,15,5);
  142.   SaveScreen(Screen);
  143.   SaveScreenBuffToDisk(Screen,'SAVE.P2X');
  144.   PressKey('Saved SAVE.P2X to Disk');
  145.  
  146.  
  147.   (* restore the first screen from disk *)
  148.  
  149.   RestoreScreenBuffFromDisk(Screen,'SAVE.P1X');
  150.   RestoreScreen(Screen);
  151.   PressKey('Restored SAVE.P1X from Disk');
  152.  
  153.  
  154.   (* restore the 2nd screen from disk *)
  155.  
  156.   RestoreScreenBuffFromDisk(Screen,'SAVE.P2X');
  157.   RestoreScreen(Screen);
  158.   PressKey('Restored SAVE.P2X from Disk');
  159. end.
  160.  
  161.  
  162.   These routines will only work in the following textmodes
  163.     BW40, CO40, BW80, CO80, Mono.
  164.  
  165.  
  166.   The Two Routines I have added are:
  167.  
  168.     RestoreScreenBuffFromDisk(ScreenBuffer,FileName);
  169.     SaveScreenBuffToDisk(ScreenBuffer,FileName);
  170.  
  171.  
  172.   These routines work in conjunction with my earlier routines I
  173.     uploaded to compuserve.
  174.  
  175.     RestoreScreen(ScreenBuffer);
  176.     SaveScreen(ScreenBuffer);
  177.  
  178.  
  179.   The 2 new procedures allow you to save/load the text buffers to disk using
  180.     Turbos BlockRead/BlockWrite.
  181.  
  182.   Russell - 75170,47
  183.