Text Mode Screen Capture 
Author Message
 Text Mode Screen Capture

Hi i think this will do the job !
It works very fast too !

Sorry about inline but i did it long ago before asm
even exist in TP !

{ GetWindow and PutWindow example }
uses crt;
var
 { buffer can handle all text screen }
 oldvideo : array[1..4000] of byte;
 i,j : integer;

procedure getwindow(x1,y1,x2,y2:integer;var dest);FAR;
begin
 inline(
 $1E/                 {   PUSH  DS           }
 $57/                 {   PUSH  DI           }
 $56/                 {   PUSH  SI           }
 $8B/$56/$0C/         {  MOV    DX,[BP+0C]   }
 $2B/$56/$10/         {  SUB    DX,[BP+10]   }
 $42/                 {  INC    DX           }
 $8B/$5E/$0A/         {  MOV    BX,[BP+0A]   }
 $2B/$5E/$0E/         {  SUB    BX,[BP+0E]   }
 $31/$C0/             {   XOR   AX,AX        }
 $8E/$D8/             {   MOV   DS,AX        }
 $B8/$00/$B8/         {   MOV   AX,B800      }
 $80/$3E/$49/$04/$07/ {   CMP   BYTE PTR [0449],07   }
 $75/$03/             {   JNZ   0121         }
 $B8/$00/$B0/         {   MOV   AX,B000      }
 $8E/$D8/             {   MOV   DS,AX        }
 $8A/$46/$0E/         {   MOV   AL,[BP+0E]   }
 $B1/$A0/             {   MOV   CL,A0        }
 $F6/$E1/             {   MUL   CL           }
 $D1/$66/$10/         {   SHL   WORD PTR [BP+10],1   }
 $03/$46/$10/         {   ADD    AX,[BP+10]  }
 $2D/$A2/$00/         {   SUB   AX,00A2      }
 $89/$C6/             {   MOV   SI,AX        }
 $B8/$50/$00/         {   MOV   AX,0050      }
 $29/$D0/             {   SUB   AX,DX        }
 $D1/$E0/             {   SHL   AX,1         }
 $C4/$7E/$06/         {   LES   DI,[BP+06]   }
 $FC/                 {   CLD                }
 $89/$D1/             {   MOV   CX,DX        }
 $F3/                 {   REPZ               }
 $A5/                 {   MOVSW              }
 $01/$C6/             {   ADD   SI,AX        }
 $4B/                 {   DEC   BX           }
 $7D/$F7/             {   JGE   013D         }
 $5E/                 {   POP   SI           }
 $5F/                 {   POP   DI           }
 $1F);                {   POP   DS           }
end;

procedure putwindow(x1,y1,x2,y2:integer;var orig);FAR;
begin
 inline(
 $1E/                 {   PUSH  DS           }
 $57/                 {   PUSH  DI           }
 $56/                 {   PUSH  SI           }
 $8B/$56/$0C/         {   MOV   DX,[BP+0C]   }
 $2B/$56/$10/         {   SUB   DX,[BP+10]   }
 $42/                 {   INC    DX          }
 $8B/$5E/$0A/         {   MOV   BX,[BP+0A]   }
 $2B/$5E/$0E/         {   SUB   BX,[BP+0E]   }
 $31/$C0/             {   XOR   AX,AX        }
 $8E/$D8/             {   MOV   DS,AX        }
 $B8/$00/$B8/         {   MOV   AX,B800      }
 $80/$3E/$49/$04/$07/ {   CMP   BYTE PTR [0449],07   }
 $75/$03/             {   JNZ   0121         }
 $B8/$00/$B0/         {   MOV   AX,B000      }
 $8E/$C0/             {   MOV   ES,AX        }
 $8A/$46/$0E/         {   MOV   AL,[BP+0E]   }
 $B1/$A0/             {   MOV   CL,A0        }
 $F6/$E1/             {   MUL   CL           }
 $D1/$66/$10/         {   SHL   WORD PTR [BP+10],1   }
 $03/$46/$10/         {   ADD    AX,[BP+10]  }
 $2D/$A2/$00/         {   SUB   AX,00A2      }
 $89/$C7/             {   MOV   DI,AX        }
 $B8/$50/$00/         {   MOV   AX,0050      }
 $29/$D0/             {   SUB   AX,DX        }
 $D1/$E0/             {   SHL   AX,1         }
 $C5/$76/$06/         {   LDS   SI,[BP+06]   }
 $FC/                 {   CLD                }
 $89/$D1/             {   MOV   CX,DX        }
 $F3/                 {   REPZ               }
 $A5/                 {   MOVSW              }
 $01/$C7/             {   ADD   DI,AX        }
 $4B/                 {   DEC   BX           }
 $7D/$F7/             {   JGE   013D         }
 $5E/                 {   POP   SI           }
 $5F/                 {   POP   DI           }
 $1F);                {   POP   DS           }
end;

begin
 clrscr;
 for i :=1 to 23 do
  for j :=1 to 80 do
   write('.');
 { save a window }
 getwindow(20,6,60,14,oldvideo);
 write('Press enter');
 readln;
 clrscr;
 for i :=1 to 23 do
  for j :=1 to 80 do
   write('X');
 write('Press enter to restore saved window');
 readln;
 putwindow(20,6,60,14,oldvideo);
 readln;
end.



Tue, 23 Jun 1998 03:00:00 GMT  
 Text Mode Screen Capture
                           +------------------+
                           | Turbo Pascal 7.0 |
                           +------------------+

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;

begin                
 cls; color(14,9);
 for count := 1 to 24 do
 begin
  writeln('Line ',count,' <-');
 end;
 savescreen(1,10,1,20,buffer); { Copy first ten lines and 20 columns over }
 cls;
 restorescreen(1,10,1,20,buffer); { Now put copied text back to screen }
end.



Tue, 23 Jun 1998 03:00:00 GMT  
 Text Mode Screen Capture
NO>I am trying to make this program copy a section of the screen and go back to
NO>normal operation. The program would then putback the copied text and end the
NO>program.  The problem is the friggin' RESTORESCREEN procedure is slow as mo-
NO>lasses in the winter time...HELP!

NO>uses Crt,Strings,Dos;

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

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

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

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

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

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

[snip the rest of the code]

I would do this like:

-------------- CUT ---------------
...
Type
  ScreenData : Array[1..80*25] of Word;

Var
  SavedScreen  : ScreenData;
  ActualScreen : ScreenData Absolute $B800:0000;

...
Procedure SaveScreen;
Begin
  SavedScreen := ActualScreen;
End;

Procedure RestoreScreen;
Begin
  ActualScreen := SavedScreen;
End;

Begin
  SaveScreen;
  ...
  {do whatever}
  ...
  RestoreScreen;
End.
-------------- CUT ---------------

This is untested, but I hope it still helps you.

Regards,

Jani

--
---------------------------------------------------------------------

Check out Help Editor 2.0 for Windows at:
ftp://ftp.mpoli.fi/metropoli/windows/utils/hlped20.zip

1996: Only four years to computer confusion!
What have you done to avoid it?
---------------------------------------------------------------------
---
 * SLMR 2.1a *



Thu, 25 Jun 1998 03:00:00 GMT  
 Text Mode Screen Capture


Note : the last two postings in this thread clearly refer to Borland's
Pascal, so c.l.p.borland would be better than c.l.p.misc

Jani : I would do this like:                         (compressed by JRS)

Quote:
}Type ScreenData : Array[1..80*25] of Word;
}
}Var
}  SavedScreen  : ScreenData;
}  ActualScreen : ScreenData Absolute $B800:0000;
}
}Procedure SaveScreen;
}Begin SavedScreen := ActualScreen; End;
}
}Procedure RestoreScreen;
}Begin ActualScreen := SavedScreen; End;
}
}Begin
}  SaveScreen;
}  {do whatever}
}  RestoreScreen;
}End.

That is of course far more efficient than the original; but
with rather little effort one can stop assuming that the
screen is colour 80*25.   AFAIR, it's unimportant here that TShower
is an object type.

type
TShower = object(TFiler)
  PSave, PShow : pointer ;
  ScreenSize : word ;
  Xcur, Ycur : byte ;
  procedure SaveScreen ; virtual ;
  procedure RestoreScr ; virtual ;
  end {TShower} ;

var ScrCols, ScrPage, ScrRows : byte ;

constructor TShower.Init ;
var Sg : word ;
begin inherited Init ;
  ScrCols := Succ(Lo(WindMax)) ; ScrRows := Succ(Hi(WindMax)) ;
  asm mov AH,0Fh ; int 10h ; mov ScrPage,BH end ;
  Inc(WindMax) { Prevents screen scroll after writing to bottom right corner:
    see The Pascal Magazine #4 p.28 col.2 by Bob Swart } ;
  ScreenSize := 2*ScrCols*ScrRows ;
  if LastMode=Mono then Sg := SegB000 else Sg := SegB800 ;
  PShow := Ptr(Sg, ScrPage*ScreenSize) ;
  end {TShower.Init} ;

procedure TShower.SaveScreen;
begin GetMem(PSave, ScreenSize) ; Move(PShow^, PSave^, ScreenSize) ;
  Xcur := WhereX ; Ycur := WhereY end {TShower.SaveScreen} ;

procedure TShower.RestoreScr ;
begin Move(PSave^, PShow^, ScreenSize) ; FreeMem(PSave, ScreenSize) ;
  GoToXY(Xcur, Ycur) end {TShower.RestoreScr} ;

This was tested in the original program, but not in all possible
screen modes.

--



Fri, 26 Jun 1998 03:00:00 GMT  
 Text Mode Screen Capture

Quote:
>Hi i think this will do the job !
>It works very fast too !
>Sorry about inline but i did it long ago before asm
>even exist in TP !
>{ GetWindow and PutWindow example }
>uses crt;
>var
> { buffer can handle all text screen }
> oldvideo : array[1..4000] of byte;
> i,j : integer;

There are two problems with these procedures.
1) They do not detect the type of textscreen used.
2) The predefined buffer for is not big enough for 80x50 modes

It is rather easy to detect the videotype. Futher I suggest the use of a variable
size memory block. In Turbo Pascal 7 all actions exept for the video detection
can be done fast enough with standard TP7 routines (like move).
If only copying of the entire screen is wanted. It is easiest to do a move from
or to an absolute variable located at the screenbase and a allocated mem block.

Greetings,
Richard van der Wal
________________



Fri, 26 Jun 1998 03:00:00 GMT  
 
 [ 7 post ] 

 Relevant Pages 

1. Text Mode Screen Capture

2. Help: MS-DOS Screen Capture (in Full-Screen Mode) Under Win 95/98/NT

3. writing text to screen while in graphics mode

4. Protected mode - text screen reading and writing

5. Saving/Restoring text mode screens - fulgore.txt [1/1]

6. Capture DOS Text screen then dump in Graphics screen under an Exec(prog,attrib);

7. Screen capture/Windows?

8. Screen capture for BP7???

9. Screen capture for BP7???

10. Capturing Screen Displays?

11. Can I capture the screen output (TP7.0)?

12. Screen Capturing in Windows

 

 
Powered by phpBB® Forum Software