uses dos, crt;
var
regs: Registers;
label again,ende;
procedure clrscr; { Очистка экрана}
begin
regs.ax:=3;intr($10,regs)
end;
procedure clock; { Запрос показаний системных часиков}
begin
regs.AH :=$2C;
Intr($21, regs);
with regs do
begin
Write (CH, ':');
Write (CL, ':');
Write (DH);
end;
end;
begin
regs.ax:=3;
intr($10,regs);
with regs do
begin
again: clock; delay(60000); delay(65000); ClrScr;
ah:=1; intr($16,regs);
asm jz again end;
ah:=0;
intr($16,regs);
if ah=1 then goto ende; { Выход - по нажатию Esc}
goto again;
ende: writeLn ('End');
ah:=8;msdos(regs);
end
end.
Pascal. Использование прерываний. Часы.
Условие:
Вывести в середину экрана красное окно.
1) По нажатию F4 начать выводить в нем (белыми символами) счетчик секунд (1, 2, 3, ….58, 59, 0, 1, …) и минут (1, 2, 3, …). Сброс счетчика – Esc, выход из программы – Ctrl/C.
Вывести в середину экрана красное окно.
1) По нажатию F4 начать выводить в нем (белыми символами) счетчик секунд (1, 2, 3, ….58, 59, 0, 1, …) и минут (1, 2, 3, …). Сброс счетчика – Esc, выход из программы – Ctrl/C.
И это обязательно на Паскале? Бог в помощь)
Я бы на асме писал.
Могу поискать, где-то было на асме вывод часиков в правом верхнем углу экрана и "типа гаярчии клавиши в ДОС", т.е. например нажимая СTRL+D выполняется команда dir. Может помочь.
Я бы на асме писал.
Могу поискать, где-то было на асме вывод часиков в правом верхнем углу экрана и "типа гаярчии клавиши в ДОС", т.е. например нажимая СTRL+D выполняется команда dir. Может помочь.
Да, только паскаль =(
Было бы неплохо - горячие клавиши и их скен и ascii код.
Основные проблемы:
- Не могу запихнуть часы в ДОСовское окно.
- Не могу избавиться от мерцания при обновлении.
Вот сам текст.
Было бы неплохо - горячие клавиши и их скен и ascii код.
Основные проблемы:
- Не могу запихнуть часы в ДОСовское окно.
- Не могу избавиться от мерцания при обновлении.
Вот сам текст.
Код:
в 3 часа ночи, код читать не хочу.
Насчет мерцания. указатели пользывать умееш? Выводи не врителном. а через видеобуффер, пример использывания. Программ выводит символ в самый правый нижний угол экрана.
видеобуффер находится по адрессу b800:0000 в качестве смещения -позиция на экране. Один символ 2 байта в таком поярдке аски-код, младший атрибут
2аски-коды... набей маленькую программку. считываеш символ. выводиш через орд() его аски-код, это 5 строчек. да учти .что например F3 сначала вернет в качестве аски-кода 0, а припоследуйшщем вызове функции чтения символа расширеный аски-код
Насчет мерцания. указатели пользывать умееш? Выводи не врителном. а через видеобуффер, пример использывания. Программ выводит символ в самый правый нижний угол экрана.
видеобуффер находится по адрессу b800:0000 в качестве смещения -позиция на экране. Один символ 2 байта в таком поярдке аски-код, младший атрибут
Код:
type
symbol=record
symb:byte;
color:byte;
end;
var
posit:^symbol;
s:symbol;
begin
posit:=ptr($b800,2*(24*80+79));
s.symb:=$61;
s.color:=$e;
posit^:=s;
readln;
end.
symbol=record
symb:byte;
color:byte;
end;
var
posit:^symbol;
s:symbol;
begin
posit:=ptr($b800,2*(24*80+79));
s.symb:=$61;
s.color:=$e;
posit^:=s;
readln;
end.
2аски-коды... набей маленькую программку. считываеш символ. выводиш через орд() его аски-код, это 5 строчек. да учти .что например F3 сначала вернет в качестве аски-кода 0, а припоследуйшщем вызове функции чтения символа расширеный аски-код
Или я балбес :confused: или еще что-то, но у меня программа печатает вместо цифр символы.
Вот процедура
Вот процедура
Код:
uses dos,crt,objects;
type ps=^string;
numbers=record
numb:byte;
color:byte;
end;
var
regs: Registers;
Procedure qclock;
var posit:^numbers;
Hour,Min,Sec:numbers;
begin
regs.AH :=$2C;
Intr($21, regs);
with regs do
begin
posit:=ptr($b800,2*(10*80+35));
Hour.numb:=CH;
Hour.color:=$e;
posit^:=Hour;
posit:=ptr($b800,2*(10*80+37));
Min.numb:=CL;
Min.color:=$e;
posit^:=Min;
posit:=ptr($b800,2*(10*80+39));
Sec.numb:=DH;
Sec.color:=$e;
posit^:=Sec;
end;
end;
type ps=^string;
numbers=record
numb:byte;
color:byte;
end;
var
regs: Registers;
Procedure qclock;
var posit:^numbers;
Hour,Min,Sec:numbers;
begin
regs.AH :=$2C;
Intr($21, regs);
with regs do
begin
posit:=ptr($b800,2*(10*80+35));
Hour.numb:=CH;
Hour.color:=$e;
posit^:=Hour;
posit:=ptr($b800,2*(10*80+37));
Min.numb:=CL;
Min.color:=$e;
posit^:=Min;
posit:=ptr($b800,2*(10*80+39));
Sec.numb:=DH;
Sec.color:=$e;
posit^:=Sec;
end;
end;
И так, ты неучел следуйщие факторы:
1. Таким образом ты можеш вывести, только 1 символ за раз, а не число. например для вывода 23, нужно отдельно вывести 2 и отдельно 3.
2. АСКИ-код цифры, это сама цифра+$30. Поэтому выводить нужно не 0, а $30 для вывода 0.
Пересмотри реалитзацию кода. Очень много повторяющегся участков, что есть не красиво.
1. Таким образом ты можеш вывести, только 1 символ за раз, а не число. например для вывода 23, нужно отдельно вывести 2 и отдельно 3.
2. АСКИ-код цифры, это сама цифра+$30. Поэтому выводить нужно не 0, а $30 для вывода 0.
Код:
uses dos,crt,objects;
type ps=^string;
numbers=record
numb:byte;
color:byte;
end;
var
regs: Registers;
Procedure qclock;
var posit:^numbers;
Hour,Min,Sec:numbers;
Hr,Mn,Sc,temp:byte;
begin
regs.AH :=$2C;
Intr($21, regs);
with regs do
begin
hr:=CH; {Сохраняем на всякий случай}
mn:=CL; {ведь любая операция изменяет значения регистров и после обычного присваивнивания}
sc:=DH; {например, в СH может быть уже совсем другое значение}
temp:=hr div 10; {выделяем старшую цифру}
posit:=ptr($b800,2*(10*80+35));
Hour.numb:=temp+$30; {преобразуем цифру в символ этой цифры}
Hour.color:=$e;
posit^:=Hour;
temp:=hr mod 10; {выделяем младшую}
posit:=ptr($b800,2*(10*80+36));
Hour.numb:=temp+$30;
Hour.color:=$e;
posit^:=Hour;
temp:=mn div 10;
posit:=ptr($b800,2*(10*80+38));
Min.numb:=temp+$30;
Min.color:=$e;
posit^:=Min;
temp:=mn mod 10;
posit:=ptr($b800,2*(10*80+39));
Min.numb:=temp+$30;
Min.color:=$e;
posit^:=Min;
temp:=sc div 10;
posit:=ptr($b800,2*(10*80+41));
Sec.numb:=temp+$30;
Sec.color:=$e;
posit^:=Sec;
temp:=sc mod 10;
posit:=ptr($b800,2*(10*80+42));
Sec.numb:=temp+$30;
Sec.color:=$e;
posit^:=Sec;
end;
end;
type ps=^string;
numbers=record
numb:byte;
color:byte;
end;
var
regs: Registers;
Procedure qclock;
var posit:^numbers;
Hour,Min,Sec:numbers;
Hr,Mn,Sc,temp:byte;
begin
regs.AH :=$2C;
Intr($21, regs);
with regs do
begin
hr:=CH; {Сохраняем на всякий случай}
mn:=CL; {ведь любая операция изменяет значения регистров и после обычного присваивнивания}
sc:=DH; {например, в СH может быть уже совсем другое значение}
temp:=hr div 10; {выделяем старшую цифру}
posit:=ptr($b800,2*(10*80+35));
Hour.numb:=temp+$30; {преобразуем цифру в символ этой цифры}
Hour.color:=$e;
posit^:=Hour;
temp:=hr mod 10; {выделяем младшую}
posit:=ptr($b800,2*(10*80+36));
Hour.numb:=temp+$30;
Hour.color:=$e;
posit^:=Hour;
temp:=mn div 10;
posit:=ptr($b800,2*(10*80+38));
Min.numb:=temp+$30;
Min.color:=$e;
posit^:=Min;
temp:=mn mod 10;
posit:=ptr($b800,2*(10*80+39));
Min.numb:=temp+$30;
Min.color:=$e;
posit^:=Min;
temp:=sc div 10;
posit:=ptr($b800,2*(10*80+41));
Sec.numb:=temp+$30;
Sec.color:=$e;
posit^:=Sec;
temp:=sc mod 10;
posit:=ptr($b800,2*(10*80+42));
Sec.numb:=temp+$30;
Sec.color:=$e;
posit^:=Sec;
end;
end;
Пересмотри реалитзацию кода. Очень много повторяющегся участков, что есть не красиво.
ты аски-коды спрашивал. вот прога которая выводит аски-код нажатой клавиши. Если нажата клавиша с расширеным аскикодом, то выводится сперва 0, а потом значение расширеного. Он получается повторным вызовом readkey. Выход нажатие ESC
Код:
var c:longint;
begin
clrscr;
c:=ord(readkey);
while c<>27 do
begin
writeln(c);
if c=0 then
begin
c:=ord(readkey);
writeln('Extra ',c)
end;
c:=ord(readkey)
end
end.
begin
clrscr;
c:=ord(readkey);
while c<>27 do
begin
writeln(c);
if c=0 then
begin
c:=ord(readkey);
writeln('Extra ',c)
end;
c:=ord(readkey)
end
end.
Хоть убейте, не получается в окно запихнуть этот таймер.
З.Ы. Код минимизирую после, когда программа будетполностью завершена.
Вот эта процедура вызывает окно:
И как мне их совместить бы...
Код:
uses dos,crt,objects;
type ps=^string;
numbers=record
numb:byte;
color:byte;
end;
var
regs: Registers;
p,s,q:ps;
l:ptrrec;
label again,ende,start;
{вывод}
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 qclrscr;
begin
regs.ax:=3;intr($10,regs)
end;
{ Repeat until key pressed}
procedure qreadkey;
begin
regs.ah:=8;
msdos(regs);
end;
Procedure qclock;
var posit:^numbers;
Hour,Min,Sec:numbers;
Hr,Mn,Sc,temp:byte;
begin
regs.AH :=$2C;
Intr($21, regs);
with regs do
begin
hr:=CH; {Сохраняем на всякий случай}
mn:=CL; {ведь любая операция изменяет значения регистров и после обычного присваивнивания}
sc:=DH; {например, в СH может быть уже совсем другое значение}
temp:=hr div 10; {выделяем старшую цифру}
posit:=ptr($b800,2*(10*80+35));
Hour.numb:=temp+$30; {преобразуем цифру в символ этой цифры}
Hour.color:=$e;
posit^:=Hour;
temp:=hr mod 10; {выделяем младшую}
posit:=ptr($b800,2*(10*80+36));
Hour.numb:=temp+$30;
Hour.color:=$e;
posit^:=Hour;
temp:=mn div 10;
posit:=ptr($b800,2*(10*80+38));
Min.numb:=temp+$30;
Min.color:=$e;
posit^:=Min;
temp:=mn mod 10;
posit:=ptr($b800,2*(10*80+39));
Min.numb:=temp+$30;
Min.color:=$e;
posit^:=Min;
temp:=sc div 10;
posit:=ptr($b800,2*(10*80+41));
Sec.numb:=temp+$30;
Sec.color:=$e;
posit^:=Sec;
temp:=sc mod 10;
posit:=ptr($b800,2*(10*80+42));
Sec.numb:=temp+$30;
Sec.color:=$e;
posit^:=Sec;
end;
end;
BEGIN
qClrScr;
regs.ax:=3;
intr($10,regs);
with regs do
begin
qClrScr;
new(p);new(s);new(q);
p^:='Press F4 to start and Esc to exit$';
s^:='Unknown key is pressed. Pleas try again!$';
q^:='Spasibo. Poka!$';
start: write(p);
WriteLn(' ');
ah:=0;
intr($16,regs);
if ah=62 then goto again;
if ah=1 then goto ende;
if ah<>62 then
begin
write(s);
goto start;
end;
again: qclock;
ah:=1; intr($16,regs);
asm jz again end;
ah:=0;
intr($16,regs);
if ah=1 then goto ende;
goto again;
ende: qclrscr; write (q);
ah:=8;msdos(regs);
qreadkey;
end;
end.
type ps=^string;
numbers=record
numb:byte;
color:byte;
end;
var
regs: Registers;
p,s,q:ps;
l:ptrrec;
label again,ende,start;
{вывод}
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 qclrscr;
begin
regs.ax:=3;intr($10,regs)
end;
{ Repeat until key pressed}
procedure qreadkey;
begin
regs.ah:=8;
msdos(regs);
end;
Procedure qclock;
var posit:^numbers;
Hour,Min,Sec:numbers;
Hr,Mn,Sc,temp:byte;
begin
regs.AH :=$2C;
Intr($21, regs);
with regs do
begin
hr:=CH; {Сохраняем на всякий случай}
mn:=CL; {ведь любая операция изменяет значения регистров и после обычного присваивнивания}
sc:=DH; {например, в СH может быть уже совсем другое значение}
temp:=hr div 10; {выделяем старшую цифру}
posit:=ptr($b800,2*(10*80+35));
Hour.numb:=temp+$30; {преобразуем цифру в символ этой цифры}
Hour.color:=$e;
posit^:=Hour;
temp:=hr mod 10; {выделяем младшую}
posit:=ptr($b800,2*(10*80+36));
Hour.numb:=temp+$30;
Hour.color:=$e;
posit^:=Hour;
temp:=mn div 10;
posit:=ptr($b800,2*(10*80+38));
Min.numb:=temp+$30;
Min.color:=$e;
posit^:=Min;
temp:=mn mod 10;
posit:=ptr($b800,2*(10*80+39));
Min.numb:=temp+$30;
Min.color:=$e;
posit^:=Min;
temp:=sc div 10;
posit:=ptr($b800,2*(10*80+41));
Sec.numb:=temp+$30;
Sec.color:=$e;
posit^:=Sec;
temp:=sc mod 10;
posit:=ptr($b800,2*(10*80+42));
Sec.numb:=temp+$30;
Sec.color:=$e;
posit^:=Sec;
end;
end;
BEGIN
qClrScr;
regs.ax:=3;
intr($10,regs);
with regs do
begin
qClrScr;
new(p);new(s);new(q);
p^:='Press F4 to start and Esc to exit$';
s^:='Unknown key is pressed. Pleas try again!$';
q^:='Spasibo. Poka!$';
start: write(p);
WriteLn(' ');
ah:=0;
intr($16,regs);
if ah=62 then goto again;
if ah=1 then goto ende;
if ah<>62 then
begin
write(s);
goto start;
end;
again: qclock;
ah:=1; intr($16,regs);
asm jz again end;
ah:=0;
intr($16,regs);
if ah=1 then goto ende;
goto again;
ende: qclrscr; write (q);
ah:=8;msdos(regs);
qreadkey;
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;
begin with regs do begin
ah:=f;al:=scroll;bh:=color;
ch:=y1;cl:=x1;dh:=y2;dl:=x2;
intr($10,regs);end;
end;
И как мне их совместить бы...
с какими параметрами вызывается процедура создания окна?
хм - по поводу основного вопроса автора - мерцания
вот я реализовал часть задания без всякого мерцания
[COLOR="Red"]//комментарии добавил [/COLOR]- но это конечно не вся программа а рекомендации как делать и в ней нет вашей проблемы с мерцанием
проблема была в том - зачем вы каждый раз очищали весь экран
ps я использовал модуль crt1
просто мне так удобнее - найти вы его вряд ли найдете поэтому прикрепляю
вот я реализовал часть задания без всякого мерцания
Код:
uses crt,crt1; {подключаю свой модуль crt1}
const enter=#13;
esk=#27;
var sek,min:word; s1:string;
procedure putfield(x,y,n:byte; s:string);{процедура записывает n символов строки s в позиции начиная с x y }
var i:integer;
begin
for i:=1 to n do
if i<=length(s) then putch(x+i-1,y,s) else putch(x+i-1,y,' ')
end;
procedure paintfield(x,y,n,a:byte);{аналогично putfield только закрашивает}
var i:integer;
begin
for i:=0 to n-1 do putattr(x+i,y,a)
end;
begin sek:=0; min:=0; {секуныды минуты}
textmode(3); {текстовый режим 25*80 строк*столбцов)}
crsoff;{убираем курсор (ф-я из crt1) }
repeat
str(sek,s1); putfield(45,10,3,s1); {выводим текущие секунды}
str(min,s1); putfield(35,10,3,s1); {минуты}
inc(sek);
if sek=60 then begin inc(min); sek:=0 end;
delay(65000);
if keypressed then halt {выходим по нажатию}
until min=60;
end.
const enter=#13;
esk=#27;
var sek,min:word; s1:string;
procedure putfield(x,y,n:byte; s:string);{процедура записывает n символов строки s в позиции начиная с x y }
var i:integer;
begin
for i:=1 to n do
if i<=length(s) then putch(x+i-1,y,s) else putch(x+i-1,y,' ')
end;
procedure paintfield(x,y,n,a:byte);{аналогично putfield только закрашивает}
var i:integer;
begin
for i:=0 to n-1 do putattr(x+i,y,a)
end;
begin sek:=0; min:=0; {секуныды минуты}
textmode(3); {текстовый режим 25*80 строк*столбцов)}
crsoff;{убираем курсор (ф-я из crt1) }
repeat
str(sek,s1); putfield(45,10,3,s1); {выводим текущие секунды}
str(min,s1); putfield(35,10,3,s1); {минуты}
inc(sek);
if sek=60 then begin inc(min); sek:=0 end;
delay(65000);
if keypressed then halt {выходим по нажатию}
until min=60;
end.
[COLOR="Red"]//комментарии добавил [/COLOR]- но это конечно не вся программа а рекомендации как делать и в ней нет вашей проблемы с мерцанием
проблема была в том - зачем вы каждый раз очищали весь экран
ps я использовал модуль crt1
просто мне так удобнее - найти вы его вряд ли найдете поэтому прикрепляю
Процедура создания окна:
window(f,scroll,color,x1,y1,x2,y2:integer);
f - тоже связанно с прокруткой ( значение либо 6, либо 7)
scroll - на сколько прокручивать в окне
color - цвет окна и букв,
x1,y1 - координаты левого верхнего угла,
x2,y2 - координаты правого нижнего,
2nilbog
Можете поставить комментарии в своём коде? Разобраться поподробней хочется.
Код:
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;
begin with regs do begin
ah:=f;al:=scroll;bh:=color;
ch:=y1;cl:=x1;dh:=y2;dl:=x2;
intr($10,regs);end;
end;
window(f,scroll,color,x1,y1,x2,y2:integer);
f - тоже связанно с прокруткой ( значение либо 6, либо 7)
scroll - на сколько прокручивать в окне
color - цвет окна и букв,
x1,y1 - координаты левого верхнего угла,
x2,y2 - координаты правого нижнего,
2nilbog
Можете поставить комментарии в своём коде? Разобраться поподробней хочется.
Хм.. даже не знаю. выложите код, бум смотреть.
2nilbog
я код особо не расматривал, вывод на экран производится с помощью стандартных процедур, т.е. курсор бегает? Это часто составляет проблему, когда помимо часов нужен вывод еще чего-то
2nilbog
я код особо не расматривал, вывод на экран производится с помощью стандартных процедур, т.е. курсор бегает? Это часто составляет проблему, когда помимо часов нужен вывод еще чего-то
Цитата: Lone Wolf
2nilbog
я код особо не расматривал, вывод на экран производится с помощью стандартных процедур, т.е. курсор бегает? Это часто составляет проблему, когда помимо часов нужен вывод еще чего-то
нет курсор не бегает
описана процедура которая выводит в заданное место строку
Нашел в конспектах такую вот программу:
Вводишь строку, и после нажатия на ентер - в окне появляется эта же строка, плюс - её можно двигать стрелками.
Код:
uses crt,dos,objects;
type ps=^string;
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;
{Процедура вывода в окно}
{Если не ошибаюсь:}
{ p - строка с которой работаем }
{ len - длинна }
{ color - цвет для вывода }
{ х,у - положение в окне}
procedure cwrite(p:ps;len,color,x,y:integer);
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);
end
end;
{ Стандартный Repeat until keypresed }
procedure readkey;
begin regs.ah:=8;
msdos(regs);end;
label again,ende;
var p,s,q:ps;len,al,ah,x,y:integer;
begin
clrscr;
new(p); new(s); new(q); x:=20; y:=5;
p^:='Enter String:$ ';
q^:='GameIsOver';
write(p);
read(s,len); window(6,0,$1F,20,5,60,15);
cwrite(s,len,$1f,x,y);
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.
type ps=^string;
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;
{Процедура вывода в окно}
{Если не ошибаюсь:}
{ p - строка с которой работаем }
{ len - длинна }
{ color - цвет для вывода }
{ х,у - положение в окне}
procedure cwrite(p:ps;len,color,x,y:integer);
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);
end
end;
{ Стандартный Repeat until keypresed }
procedure readkey;
begin regs.ah:=8;
msdos(regs);end;
label again,ende;
var p,s,q:ps;len,al,ah,x,y:integer;
begin
clrscr;
new(p); new(s); new(q); x:=20; y:=5;
p^:='Enter String:$ ';
q^:='GameIsOver';
write(p);
read(s,len); window(6,0,$1F,20,5,60,15);
cwrite(s,len,$1f,x,y);
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.
Вводишь строку, и после нажатия на ентер - в окне появляется эта же строка, плюс - её можно двигать стрелками.