globus_ussr
Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
{$M $1000, 0, 0}
Program Stroka;
uses Crt, Dos;
type video = array[1..25,1..80] of
record
symbol:char;
attr:byte;
end;
var
memory: video absolute $B800:$0000;
OldVector: Procedure;
OldKey: Procedure;
vkl:boolean;
time,time1,s:real;
str:string[80];
str1: array[1..25,1..80] of char;
i,j,code1,code2,n,k,dlin,p,m,x,y: integer;
Procedure SetCurSize(BegLine, EndLine: Byte);
Var Regs:Registers;
Begin
With Regs Do
Begin
AH:=$01; CH:=BegLine; CL:=EndLine;
End;
Intr($10,Regs);
End;
{$F+}
procedure NewProc; interrupt;
begin
time:=time+time1;
if(time>s) then
begin
time:=0;
if(vkl=true) then
begin
SetCurSize($20, $00);
j:=j-1;
if j=0 then j:=80;
p:=j;
k:=0;
for i:=1 to 80 do
begin
for m:=1 to 25 do
memory[m][i].symbol:=str1[m][i];
end;
for i:=1 to dlin do
begin
if (p+k=81) then
begin
p:=1;
k:=0;
end;
memory[n][p+k].symbol:=str[i];
k:=k+1;
if k=81 then k:=0;
end;
end
end;
Oldvector;
end;
{$F-}
{$F+}
procedure Key; interrupt;
begin
if (port[$60]=1) then
begin
vkl:=false;
for i:=1 to 80 do
begin
for m:=1 to 25 do
memory[m][i].symbol:=str1[m][i];
end;
SetCurSize($06, $07);
GoToXY(x,y);
end;
if vkl=true then
begin
SetCurSize($20, $00);
for i:=1 to 80 do
begin
for m:=1 to 25 do
memory[m][i].symbol:=str1[m][i];
end;
p:=j;
k:=0;
for i:=1 to dlin do
begin
if (p+k=81) then
begin
p:=1;
k:=0;
end;
memory[n][p+k].symbol:=str[i];
k:=k+1;
if k=81 then k:=0;
end;
end;
Inline($9C);
OldKey;
end;
{$F-}
BEGIN
TextMode(3);
if ParamCount>=3 then
begin
Val(ParamStr(1), s, Code1); {s-скорость перемещения текста в секундах}
Val(ParamStr(2), n, Code2); {n-номер строки где будет текст<=25}
for i:=3 to ParamCount do str:=str+ParamStr(i)+' '; {str-текст <=80 символов}
time:=0;
vkl:=true;
j:=2;
dlin:=length(str);
k:=0;
if (code1=0) and (s>0) then
begin
if (code2=0) and (n>0) and (n<=25) then
begin
if (dlin>0) and (dlin<82) then
begin
time1:=1/18.2;
dlin:=dlin-1;
writeln('Dla ostanovki stroki press <Esc>');
x:=wherex;
y:=wherey;
SetCurSize($20, $00);
for i:=1 to 80 do
begin
for m:=1 to 25 do
str1[m][i]:=memory[m][i].symbol;
end;
GetIntVec($8,@OldVector);
SetIntVec($8,Addr(NewProc));
GetIntVec($9,@OldKey);
SetIntVec($9,Addr(Key));
Keep(0);
end
else
writeln('Oshibka! Vvedite 3-i parametr pravilno, primer: 5.exe 0.2 5 This is a string');
end
else
writeln('Oshibka! Vvedite 2-i parametr pravilno, primer: 5.exe 0.2 5 This is a string');
end
else
writeln('Oshibka! Vvedite 1-i parametr pravilno, primer: 5.exe 0.2 5 This is a string');
end
else
begin
writeln('Oshibka! Vvedite 3 parametra, primer: 5.exe 0.2 5 This is a string');
writeln('1 parametr - skorost peremeshenia stroki');
writeln('2 parametr - nomer stroki gde budet tekst');
writeln('3 parametr - tekst stroki');
writeln('Dla ostanovki stroki press <Esc>');
end;
END.
|
Всего записей: 249 | Зарегистр. 06-04-2005 | Отправлено: 19:39 16-01-2012 | Исправлено: globus_ussr, 19:43 16-01-2012 |
|
