[Back to SAVESCRN SWAG index]  [Back to Main SWAG index]  [Original]

{
> Basically all I'm asking For are SaveScreen and RestoreScreen Procedures.
> Procedures capable of just partial screen saves and restores would be
> even better, but anything will do!  :-)
}

Unit ScrUnit;

Interface

Const
  MaxPages  = 20;
Type
  PageType  = Array [1..50,1..80] Of Word;
  PageArray = Array [1..MaxPages] Of ^PageType;
Var
  Screen    : ^PageType;
  ScrPages  : PageArray;
  PageInMem : Array [1..MaxPages] Of Boolean;
  VideoMode : ^Byte;
  UseDisk   : Boolean;

Procedure InitPages(Pages : Byte);
Procedure DeInitPages;
Procedure StoreScreen(Page : Byte);
Procedure RestoreScreen(Page : Byte);

Implementation
{$IFNDEF VER70}
Const Seg0040      = $0040;
      SegB000      = $B000;
      SegB800      = $B800;
{$endIF}

Var
  MPages       : Byte;
  SaveExitProc : Pointer;

Function FStr(Num : LongInt) : String;
Var Dummy : String;
begin
  Str(Num,Dummy);
  FStr := Dummy;
end;

Procedure InitPages;
Var
  Loop : Byte;
begin
  If Pages>MaxPages Then
    Pages := MaxPages;
  For Loop:=1 To Pages Do
  If (MaxAvail>=SizeOf(PageType)) And (Not UseDisk) Then
  begin
    PageInMem[Loop] := True;
    GetMem(ScrPages[Loop],SizeOf(PageType));
  end
  Else
  begin
    PageInMem[Loop] := False;
    ScrPages[Loop]  := NIL;
  end;
  MPages := Pages;
end;

Procedure DeInitPages;
Var Loop : Byte;
begin
  If MPages>0 Then
    For Loop:=MPages DownTo 1 Do
      If PageInMem[Loop] Then
      begin
        Release(ScrPages[Loop]);
        PageInMem[Loop] := False;
      end;
  MPages := 0;
end;

Procedure StoreScreen;
Var
  F : File Of PageType;
begin
  If Page<=MPages Then
  begin
    If PageInMem[Page] Then
      Move(Screen^,ScrPages[Page]^,SizeOf(PageType))
    Else
    begin
      Assign(F,'SCR'+FStr(Page)+'.$$$');
      ReWrite(F);
      If IOResult=0 Then
      begin
        Write(F,Screen^);
        Close(F);
      end;
    end;
  end;
end;

Procedure RestoreScreen;
Var
  F : File Of PageType;
begin
  If Page<=MPages Then
  begin
    If PageInMem[Page] Then
      Move(ScrPages[Page]^,Screen^,SizeOf(PageType))
    Else
    begin
      Assign(F,'SCR'+FStr(Page)+'.$$$');
      Reset(F);
      If IOResult=0 Then
      begin
        Read(F,Screen^);
        Close(F);
      end;
    end;
  end;
end;

{$F+}
Procedure ScreenExitProc;
Var
  Loop : Byte;
  F    : File;
begin
  ExitProc := SaveExitProc;
  If MPages>0 Then
    For Loop:=1 To MPages Do
    begin
      Assign(F,'SCR'+FStr(Loop)+'.$$$');
      Erase(F);
      If IOResult<>0 Then;
    end;
end;
{$F-}

begin
  VideoMode := Ptr(Seg0040,$0049);
  If VideoMode^=7 Then
    Screen := Ptr(SegB000,$0000)
  Else
    Screen := Ptr(SegB800,$0000);
  MPages := 0;
  UseDisk := False;
  SaveExitProc := ExitProc;
  ExitProc := @ScreenExitProc;
end.

(*
This simple Unit is able to store up to 20 screens. If there is enough free
heap all screens are stored to heap which is Really fast. If there is not
enough free heap or UseDisk=True all screens are stored virtually to disk. This
method isn't very fast, of course, but it helps you to save heap.

Use this Unit as follows:

Program ThisIsMyProgram;
Uses Screen;
begin
  InitPages(5);        { initialize 5 pages }
  {...}                { this is on you }
end.
*)

[Back to SAVESCRN SWAG index]  [Back to Main SWAG index]  [Original]