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

    Unit Screens;
    Interface

    Uses Dos, Crt;

    {
     Copyright Material by Mark Bloss exists in this file.

     Copyright 1995, all rights reserved.  Submitted to the
     public domain for use with TP or BP 7.0+
     No guarantees.  Use at your own risk, etc etc.

     Uses: This unit will save as many screens as you can fit
     into your heap-space.  I normally setup a constant section
     like this in my program
      const
         DOSscreen = 1;
         MainMenu  = 2;
         HelpScreen= 3;
      or similar, so I may use the names as identifiers rather than
      trying to remember all the numbers.

      Use in the program is simple.  At the beginning of my program
      I can save the screen at DOS (etc) by saving my screen immediately
      like this

      "savescreen(screen, DOSscreen);"

      and as part of my exit proc...
      "restorescreen(screen, DOSscreen);"
      and
      "losescreens(screen);"

      This will not only save the screen, but also the cursor position
      and restore the cursor to its original location when the screen
      was initially saved.

      GetCurWindow and GetCurColors are included and may be used
      independently.

      This unit is NOT a screen-saver, but may be used WITH a screen-
      saver if desired.

      To use this unit, compile and include "SCREENS" in your program's
      "Uses" statement.

    }

    const
          screenissaved :  boolean  =  false;
          newscreen     :  boolean  =  true;

    type
          ScreenBuff= array [0..3999] of byte;
          ScreenPtr = ^ScreenRec ;
          ScreenRec = Record
                       Id          :  Byte;
                       HoldScreen  :  ScreenBuff;
                       xp,yp       :  Byte;
                       Next        :  ScreenPtr;
                      End;

     var
           CGA_buffer           :  ScreenBuff  ABSOLUTE $B800 : 0 ;
           Mono_buffer          :  ScreenBuff  ABSOLUTE $B000 : 0 ;
           identifier           :  byte;
           Screen               :  ScreenPtr;

    function Monochrome : boolean;
        { if used on a monochrome monitor will return true }

    Procedure LoseScreens ( var root : screenptr );
        { disposes of saved screens from heap }

    Procedure SaveScreen (var  root : screenptr ; identifier : byte );
        { save a screen to heapspace, identified with a byte }

    Procedure RestoreScreen ( root : screenptr ; identifier : byte );
        { restores a saved screen to the crt }

    Procedure GetCurWindow(var x1, y1, x2, y2 : integer);
        { Use to save the window-size }

    Procedure GetCurColors(var v1, v2 : integer);
        { Use to save colors/attributes of the screen }

    {=-=-=-=-=--=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}
    Implementation
    {=-=-=-=-=--=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}
    Function MonoChrome: boolean;
    var
      Regs : Registers;
    Begin
     INTR(17,Regs);
     Monochrome := ( (Regs.AX and $0030) = $30 );
    End;

    Procedure LoseScreens( var root : screenptr );
    var  holder : screenptr;

    begin
       if root <> nil then
        repeat
         holder := root^.next;
         dispose(root);
         root := holder;
        until root = nil;
    end;

    Procedure SaveScreen( var root : screenptr ; identifier : byte);
     var workrec  :  screenrec;
         current,
         holder   :  screenptr;
         replaced :  boolean;

    Begin
       replaced := false;
       if Monochrome then      { savescreen }
         move ( mono_buffer, workrec.holdscreen, 4000 ) else
         move ( cga_buffer , workrec.holdscreen, 4000 );

       workrec.id := identifier ;         { a byte "label" }
       workrec.xp := wherex;              { current xloc   }
       workrec.yp := wherey;              { current yloc   }

      if root = nil then
      begin
       new(root);
       workrec.next := nil;
       root^ := workrec;
      end else
      begin
       current := root;
       holder  := root;
       repeat
        if current^.id = identifier then { replace screen already in list }
         begin
           move ( workrec.holdscreen, current^.holdscreen, 4000 );
           replaced := true;
         end;
        current := current^.next;
       until (current=nil) or replaced ;

       if not replaced then
        begin
          new(root);
          workrec.next := holder;      { adds record to "start" of list }
          root^  := workrec;
        end;
      end
    End;

    Procedure RestoreScreen ( root : screenptr ; identifier : byte );
    var current : screenptr ;

    Begin
      if root = nil then exit;
      current := root;
      while current <> nil do
       begin
         if current^.id = identifier then
         begin
          if monochrome then
            move ( current^.holdscreen, mono_buffer , 4000) else
            move ( current^.holdscreen, cga_buffer , 4000);
            gotoxy( current^.xp, current^.yp );       { put cursor back }
         end;
         current := current^.next;
       end;
      newscreen := true;
    End;

    Procedure GetCurWindow( var x1, y1, x2, y2 : integer );
    Begin
      x1 := lo(WindMin)+1;
      y1 := hi(WindMin)+1;
      x2 := lo(WindMax)+1;
      y2 := hi(WindMax)+1;
    End;

    Procedure GetCurColors(var v1, v2 : integer );
    Begin
     v1 := lo(textattr);
     v2 := hi(textattr);
    End;

    Begin
    Screen := Nil;
    End.

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