Никто не поможет составить прогу?, Бегущая строка Опции

[max12]

Составить программу вывода на экран двух окон, обрамленных рамкой. В первое окно ввести строку текста. При нажатии клавиши "Ввод" во втором окне появится ее копия в виде непрерывно "бегущей" справа налево строки.

[volvo]

max12

В каком режиме, текст или графика?

[Jahnerus]

Ну в общем если реализовывать ЭТО в текстовом режиме то получиться может примерно следующее ... А вообще если чесно то это не задача а один большой ГЕМОРОЙ.

Код

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.

Сообщение отредактировано: Jahnerus - 11.11.2004 23:48

[volvo]

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.

[max12]

Спасибо, ребята. :D

[APAL]

вот, когда-то развлекался подобным...
Здесь 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;