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

[max12]

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

[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;