I am trying to make this program copy a section of the screen and go back to
normal operation. The program would then putback the copied text and end the
program.  The problem is the friggin' RESTORESCREEN procedure is slow as mo-
lasses in the winter time...HELP!

uses Crt,Strings,Dos;

type
 char_rec = record
      c : byte;
 attrib : byte;
end;

save_buffer = array[1..4000] of char_rec;
var inregs : registers;

procedure gettext( x, y: byte; var c, attrib: byte );
{ gets the character and attribute at a given position on the text screen }
begin
 inregs.ah := $02;
 inregs.bh := $00;
 inregs.dh := x;
 inregs.dl := y;
 intr($10,inregs); { this positions the cursor }
 inregs.ah := $08;
 inregs.bh := $00;
 intr($10,inregs); { this gets the character and attribute there }
 c := inregs.al;
 attrib := inregs.ah;
end;

procedure puttext( x, y, c, attrib: byte );
{ writes a character and attribute at a given position on the text screen }
begin
 inregs.ah := $02;
 inregs.bh := $00;
 inregs.dh := x;
 inregs.dl := y;
 intr($10,inregs); { position the cursor again }
 inregs.ah := $09;
 inregs.bh := $00;
 inregs.al := c;
 inregs.bl := attrib;
 inregs.cx := 1;
 intr($10,inregs); { and write the given character there }
 c := inregs.al;
 attrib := inregs.ah;
end;

procedure savescreen( x1, x2, y1, y2: byte; var save: save_buffer );
{ save an area of the screen in a buffer }
var x,y,c,attrib: byte; i: integer;
begin
 i := 1;
 for x := x1-1 to x2-1 do
 begin
  for y := y1-1 to y2 do
   begin
    gettext(x,y,c,attrib);
    save[i].c := c; save[i].attrib := attrib;
    inc(i);
   end;
 end;
end;

procedure restorescreen( x1, x2, y1, y2: byte; var save: save_buffer );
{ restore the saved screen data in the buffer back to the screen }
var x,y : byte; i : integer;
begin
 i := 1;
 for x := x1-1 to x2 do
 begin
  for y := y1-1 to y2 do
  begin
   puttext(x,y,save[i].c,save[i].attrib);
   inc(i);
  end;
 end;
end;

procedure color(fore,back : integer);
begin
 textcolor(fore); textbackground(back);
end;

procedure cls;
begin
 color(7,0); clrscr;
end;

var
 buffer : save_buffer;
  count : integer;

Here's what I would do in a situation like that:

Just do a direct memory write from the screen to you buffer and record
the cursor position.  When you need to restore it, just copy it back, and
presto.  Much faster than using BIOS calls.

Uses crt;

Const
  vidseg:Word=$b800;    {$b800 = color, $b000 = mono}

Type
  PTextmode_type=^Textmode_type;
  Textmode_type=record
                x,
                y      :   byte;    {screen pos}

                {only the first 25 lines used for 80x25 mode}
                buf    :   array [1..50,1..80] of record
                                                ch:char;  {char at [x,y]}
                                                at:byte;  {attr at [x,y]}
                                        end;
             end;

Var
  screen:PTextmode_type;
  buffer:PTextmode_type;

procedure save_screen(screen:PTextmode_type;lines:byte);
  begin
    with screen^ do
      begin
        x:=wherex;
        y:=wherey;
        move(mem[vidseg:0],screen^.buf,80*lines);
      end;
  end;

procedure restore_screen(screen:PTextmode_type;lines:byte);    
  begin
    with screen^ do
      begin
        gotoxy(x,y);
        move(screen^.buf,mem[vidseg:0],80*lines);
      end;
  end;

begin
  screen:=ptr(vidseg, 0);
  new(buffer);
  while not keypressed do
    write(chr(random(256));
  readkey;
  save_screen(buffer, 25);
  while not keypressed do
    write(chr(random(256));
  restore_screen(buffer, 25);
  dispose(buffer);
end.