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

    {
    From: STEFAN XENOS
    Subj: ScreenBuffer Object

    Notes:
      - 0,0 is recognised as the top-left corner of the screen.
      - They seem to work perfectly when only popping one thing up at once.
    }

    Uses Crt;

    Type
     TScreenBuf = Object
      Constructor Init (NewX,NewY,NewHeight,NewWidth:Byte);
      Destructor Done;
      Procedure KillBuffer; Virtual;
      Procedure Clip;
      Procedure Paste;
      Private
       Buffer :Pointer;
       Size :Byte;
       x,
       y,
       Height,
       Width :Byte;
     end;

    Var
     MaxX,
     MaxY :Byte;
     ScreenSeg :Word;

    Procedure GoXY (x,y:Byte);
    Begin
     gotoXY (x+1,y+1);
    end;

    Procedure FillWith (aChar:Char);
    Var
     offset:Word;
    Begin
     ClrScr;
     For offset := 0 to maxx*maxy
      do move (aChar,Ptr (ScreenSeg,offset*2)^,1);
    End;

    {TScreenBuf}
    Constructor TScreenBuf.Init (NewX,NewY,NewHeight,NewWidth:Byte);
    Begin
     x := newx;
     y := newy;
     height := newheight;
     width := newwidth;
     Buffer := nil;
     KillBuffer;
    End;

    Destructor TScreenBuf.Done;
    Begin
     KillBuffer;
    End;

    Procedure TScreenBuf.KillBuffer;
    Begin
     If Buffer <> nil
      then FreeMem (Buffer,Size);
     Size := 0;
     Buffer := nil;
    End;

    Procedure TScreenBuf.Clip;
    Var
     ScanY :Byte;
    Begin
     KillBuffer;
     Size := Height*Width*2;
     GetMem (Buffer,Size);
     For ScanY := 0 to Height
      do begin
       Move (Ptr (ScreenSeg,(Y*MaxX+ScanY*MaxX+X)*2)^,
        Ptr (Seg (Buffer^),Ofs(Buffer^)+(ScanY*Width)*2)^,Width*2);
      end;
    End;

    Procedure TScreenBuf.Paste;
    Var
     ScanY :Byte;
    Begin
     For ScanY := 0 to Height
      do begin
       Move (Ptr (Seg (Buffer^),Ofs(Buffer^)+(ScanY*Width)*2)^,
        Ptr (ScreenSeg,(Y*MaxX+ScanY*MaxX+X)*2)^,Width*2);
      end;
    End;

    Var
     Clip :TScreenBuf;

    Begin
     if Lastmode = Mono
      then screenSeg := $B000          {Mono}
     else screenSeg := $B800;          {Colour}
     if Lastmode
      and font8x8 <> 0
      then MaxY := 50                  {25X80}
     else MaxY := 25;                  {50X80}
     MaxX := 80;

     textcolor (darkgray);
     textbackground (lightgray);
     FillWith (#178);
     textcolor (yellow);
     textbackground (blue);
     Clip.Init (10,10,1,21);
     Clip.Clip;
     goXY (10,10);
     Write ('Hit ENTER to continue');
     While Readkey <> #13 do;
     Clip.Paste;
     Clip.Done;
    End.

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