uses Crt,Dos;
var R:registers; i,j,k :integer;
begin
ClrScr;
GotoXY(20,10);
R.AH:=10; R.BH:=0;
R.CL:=255; R.CH:=0;
R.AL:=ord('A');
Intr(16,R);
readln
end.
procedure PutTxtImege(x1,y1,x2,y2:integer; var p:pointer);
var R:registers; i,j,k :integer; pr:^byte;
begin
GetMem(p,(x2-x1+1)*(y2-y1+1)*2);
k := 0;
for i:=x1 to x2 do
for j:=y1 to y2 do
begin
GotoXY(i,j);
R.AH:=8; R.BH:=0;
Intr(16,R);
pr:=ptr(seg(p^),ofs(p^) + k);
pr^:=R.AL;
pr:=ptr(seg(p^),ofs(pr^)+1);
pr^:=R.AH;
k := k + 2;
end;
end;
procedure GetTxtImege(x1,y1,x2,y2:integer;
var p:pointer);
var R:registers; i,j,k :integer; pr:^byte;
begin
k := 0;
for i:=x1 to x2 do
for j:=y1 to y2 do
begin
GotoXY(i,j);
R.AH:=9; R.BH:=0;
R.CL:=1; R.CH:=0;
pr:=ptr(seg(p^),ofs(p^) + k);
R.AL:=pr^;
pr:=ptr(seg(p^),ofs(pr^)+1);
R.BL:=pr^;
Intr(16,R);
k := k + 2;
end;
FreeMem(p,(x2-x1+1)*(y2-y1+1)*2);
end;