Правила форума
Прочтите прежде чем задавать вопрос!
вот примерный текст:
uses crt,dos,objects;
type ps=^string;arr=array[1..3]of ps;
var regs:Registers;l:ptrrec;
procedure clrscr;
begin regs.ax:=3;intr($10,regs) end;
procedure write(p:ps);
begin l:=ptrrec(p);with regs do begin
ah:=9;ds:=l.seg;dx:=l.ofs+1;
msdos(regs) end;end;
procedure vvod(var ascii,scan:integer);
begin regs.ah:=0;
intr($16,regs);
ascii:=regs.al;scan:=regs.ah end;
procedure read(var p:ps;var len:integer);
begin l:=ptrrec(p);
with regs do begin
ah:=$3F;ds:=l.seg;dx:=l.ofs+1;bx:=0;cx:=80;
msdos(regs);
len:=ax-2;
end;end;
procedure window(f,scroll,color,x1,y1,x2,y2:integer);
begin with regs do begin
ah:=f;al:=scroll;bh:=color;
ch:=y1;cl:=x1;dh:=y2;dl:=x2;
intr($10,regs);end;
end;
procedure cwrite(p:ps;len,color,x,y:integer);
begin
begin l:=ptrrec(p);
with regs do begin
ah:=$13;al:=1;bh:=0;bl:=color;
cx:=len;es:=l.seg;bp:=l.ofs+1;
dh:=y;dl:=x;
intr($10,regs);
y:=y+1;end;
end end;
procedure readkey;
begin regs.ah:=8;
msdos(regs);end;
label again,ende;
var p,q:ps;len,al,ah,x,y,i:integer;my,qq,s:arr;
c:char;
begin clrscr;new(p);new(q);x:=20;y:=5;
p^:='Enter String:$ ';
q^:='GameIsOver';
for i:=1 to 3 do
begin write(p);
new(s[i]);s[i]^[0]:='+';
read(s[i],len);end;
window(6,0,$1F,20,5,60,15);
for i:=1 to 3 do begin
cwrite(s[i],len,$1f,x,y);
y:=y+1; end;
again:vvod(al,ah);
if al=$1B then goto ende;
if ah=72 then if y>5 then begin
y:=y-1;window(6,1,$1F,20,5,60,15);end;
if ah=80 then if y<15 then begin
y:=y+1;window(7,1,$1F,20,5,60,15);end;
goto again;
ende:cwrite(q,10,4,12,16);
readkey
end.
| М | Используй, пожалуйста, теги (выделить текст проги, выбрать нужный код в выпадающем меню с CODE) Lapp |
