Автор: max12 12.11.2004 1:08
Составить программу вывода на экран двух окон, обрамленных рамкой. В первое окно ввести строку текста. При нажатии клавиши "Ввод" во втором окне появится ее копия в виде непрерывно "бегущей" справа налево строки.
Автор: volvo 12.11.2004 1:59
max12
В каком режиме, текст или графика?
Автор: Jahnerus 12.11.2004 3:46
Ну в общем если реализовывать ЭТО в текстовом режиме то получиться может примерно следующее ... А вообще если чесно то это не задача а один большой ГЕМОРОЙ.
Код
uses
crt;
var
i,j,l:byte;
ch:char;
s:array[1..255] of char;
procedure win(x,y,dx,dy:integer);
begin
for i:=x to x+dx do begin
gotoxy(i,y);
write('/');
gotoxy(i,y+dy);
write('/');
end;
for i:=y to y+dy do begin
gotoxy(x,i);
write('/');
gotoxy(x+dx,i);
write('/');
end;
end;
begin
clrscr;
win(5,5,30,15);
win(45,5,30,15);
gotoxy(6,12);
repeat
if keypressed then begin
l:=l+1;
gotoxy(l+5,12);
ch:=readkey;
s[l]:=ch;
write(ch);
end;
until (ord(ch)=13) or (l=29);
if l=29 then l:=l+1;
s[l]:=' ';
repeat
for i:=74 downto 46-l do begin
j:=1;
while (j<=75-i) and (j<=l) do begin
if (i+j)<47 then begin
j:=j+1;
continue;
end;
gotoxy(i+j-1,12);
write(s[j]);
gotoxy(1,1);
delay(1000);
j:=j+1;
if keypressed then exit;
end;
end;
until false;
end.
Автор: volvo 12.11.2004 4:37
Jahnerus
Небольшая модернизация:
Код
Uses Crt;
Procedure Win( xSt, ySt, xFn, yFn: Word);
Var i: Integer;
Begin
For i := Succ(xSt) To Pred(xFn) Do
Begin
GotoXY(i, ySt); Write(#205);
GotoXY(i, yFn); Write(#205);
End;
For i := Succ(ySt) To Pred(yFn) Do
Begin
GotoXY(xSt, i); Write(#186);
GotoXY(xFn, i); Write(#186);
End;
GotoXY(xSt, ySt); Write(#201);
GotoXY(xSt, yFn); Write(#200);
GotoXY(xFn, ySt); Write(#187);
GotoXY(xFn, yFn); Write(#188);
End;
Const
makeLen: Byte = 29;
Var
s: String;
Ch: Char;
Begin
ClrScr;
Win(5, 5, 35, 20);
Win(45, 5, 75, 20);
GotoXY(6, 12);
ReadLn(s);
While Length(s) < makeLen Do
s := #32 + s;
Repeat
GotoXY(46, 12); Write(s);
Ch := s[1];
move(s[2], s[1], Pred(makeLen));
s[makeLen] := Ch;
Delay(15000);
Until KeyPressed;
While KeyPressed Do
ReadKey;
End.
Автор: APAL 12.11.2004 22:12
вот, когда-то развлекался подобным...
Здесь 8 способов вывода строки на экран:
Код
Procedure beg1(aa,bb:integer;st:string);
var len,w:integer;
s1,s2:string;
begin
if odd(length(st)) then st:=st+' ';
len:=length(st) div 2;
s1:='';s2:='';
for w:=1 to len do
begin
delay(60);
s1:=s1+copy(st,w,1);
s2:=copy(st,2*len+1-w,1)+s2;
gotoxy(aa+len-w,bb);write(s1);
gotoxy(aa+len,bb);write(s2);
end;
end;
Procedure beg2(x,y:integer;st:string);
var s1,s2,s3,s4 :string;
l,i :integer;
begin
if length(st)<4 then
begin
repeat
st:=st+' ';
until length(st)>=4;
end;
if odd(length(st)) then st:=st+' ';
if length(st)/4-round(length(st)/4)<>0 then st:=st+' ';
l:=length(st);
s1:='';s2:='';s3:='';s4:='';l:=l div 4;
cursor(False);
for i:=1 to l do
begin
delay(60);
s1:=s1+copy(st,i,1);
s2:=copy(st,2*l+1-i,1)+s2;
s3:=s3+copy(st,i+l*2,1);
s4:=copy(st,4*l+1-i,1)+s4;
gotoxy(x+l-i,y); write(s1);
gotoxy(x+l,y); write(s2);
gotoxy(x+l*3-i,y); write(s3);
gotoxy(x+l*3,y); write(s4);
end;
cursor(True);
end;
Procedure beg3(x,y:integer;st:string);
var i:integer;
begin
cursor(False);
gotoxy(x,y);
for i:=1 to length(st) do
begin
delay(60);
write(st[i]);
end;
cursor(True);
end;
Procedure beg4(x,y:byte;st:string);
var
s : string[79];
n,i : byte;
begin
s:='';n:=0;
for i:=x+length(st)-1 downto x do
begin
n:=n+1;
s:=s+st[n];
gotoxy(i,y);write(s);
delay(70);
end
end;
Procedure beg5(x,y:byte;st:string);
var
i,k : byte;
begin
beg4(x,y,st);
delay(300);
k:=length(st);
for i:=1 to k do
begin
delete(st,1,1);
st:=st+' ';
gotoxy(x,y);write(st);
delay(70);
end
end;
Procedure beg6(x,y:byte;st:string);
Var i,j : Byte;
S1,S2 : String;
Begin
If Odd(Length(st)) then st:=st+' ';
s1:='';s2:='';
For i:=1 to Length(st) div 2 do
Begin
Delay(60);
s1:=st[(Length(st) div 2)-i+1]+s1;
s2:=s2+st[(Length(st) div 2)+i-1];
GoToXY(x,y);Write(s1);
GoToXY(x+Length(st)-i-1,y);Write(s2);
End;
End;
Procedure beg7(xx,yy:byte;sst:string);
Var ss,ss1,ss2 : String;
i : Byte;
Begin
If Odd(Length(sst)) then sst:=sst+' ';
ss2:=Copy(sst,(Length(sst) Div 2)+1,Length(sst) Div 2);
ss1:=Copy(sst,1,Length(sst) Div 2);
ss:=ss2+ss1;
Beg6(xx,yy,ss);
cursor(False);
For i:=Length(sst) Div 2 downto 1 do
Begin
GoToXY(xx+i-1,yy);
Write(ss1);
Delay(30);
Write(' ');
GoToXY((Length(sst) Div 2)-i+1+xx,yy);
Write(ss2);
Delay(30);
GoToXY((Length(sst) Div 2)-i+xx,yy);
Write(' ');
End;
GoToXY(xx,yy);Write(sst);
cursor(True);
End;
Procedure Beg8(a,b:Byte;St:String);
Var i,n : Byte;
Begin
cursor(False);
For n:=a to a+Length(st)-1 do
Begin
For i:=1 to 30 do
Begin
GotoXY(Round(Random(Length(st)+a-1-n)+n),b);
Write(chr(Round(Random(140)+32)));
Delay(4);
End;
GotoXY(n,b);Write(st[n-a+1]);
End;
cursor(True);
End;