Движущийся текст ... :? Опции

[SMART]

    Народ, срочно нужна помощь.....
 Подскажите сылку где мона достать текст проги в которой напечатоное слово передвигалось бы по экрану С КАКИМИНИБУДЬ ЭФЕКТАМИ. У меня ето слово только по кругу ездиет и УСЕ .
Если у когонибудь есть чтонибудь похожее, ПЛИЗ подскажите текст проги  :-/ .
                    ??? ??? ???

[Shadow]

:D
---
а какие эффекты нужны

[AlaRic]

Кидай свой текст сюда - народ посмотрит!

[GLuk]

Правильно! Кидай сырец доработаем...

[SMART]

Tut u4ilka na menja vase naehala skazala eta rabota na edinitsu ne tjanet >:(... Nado stob v proge vse ezdilo, prigalo, migalo i krsivo bilo bi. Ja v Paskale ese zelenii i ne znaju 4e dobavit' stob hot' kak-to rabotala bi.

Pomogite kto mozet, v zaranee blagodarju!
Vot tekst progi:

Код

Program xXx;
Uses crt;
const
  a:array[1..8] of char=('H','E','L','P',' ','M','E','!');
var
   i,j,x,y:integer;
procedure vlevo;
begin

   window(x,y,x+8,y);
  for i:=1 to 8 do
  begin
      text color(i);
      Write(a[i]);
  end;
   Window(x+8,y+2,x+9,y+2);
  for i:=1 to 8 do
   begin
      write(' ');
   end;
   delay(3000);
end;

procedure vpravo;
begin
  window(x-1,y,x,y);
  for i:=1 to 8 do
   write(' ');
   Window(x,y,x+8,y);
  for i:=1 to 8 do
   begin
      text color(i);
      Write(a[i]);
   end;
   delay(3000);
end;

procedure vverh;
begin
  window(x,y,x+8,y);
  for i:=1 to 8 do
  begin
      text color(i);
      Write(a[i]);
  end;
   Window(x,y+1,x+8,y+1);
    write('        ');  {8 probelov}  
   delay(3000);
   end;

procedure vniz;
begin
  window(x,y,x+8,y);
  for i:=1 to 8 do
  begin
      text color(i);
      Write(a[i]);
  end;
  window(x-1,y,x,y);
  for i:=1 to 8 do
   write(' ');
  delay(3000);
end;

begin
  randomize;
  clrscr;
  x:=37;
  for i:=1 to 8 do
  begin
     textcolor(i);
     If (i mod 2)=1 then
     for y:=1 to 15 do
     begin
       window(x+i,y,x+i,y);
       write(a[i]);
       window(x+1,y-1,x+1,y-1);
       write(' ');
       delay(3000);
     end;
     else
     begin
       for y:=30 down to 15 do
       begin
       window(x+i, y,x+i,y);
       write(a[i]);
       window(x+i,y+1,x+i,y+1);
       Write(' ');
       delay(3000);
       end;
      end;
      writeln;
   end;
   y:=15;
   for x:=37 down to 1 do vlevo;
   for y:=15 down to 1 do vverh;
   for x:=1 to 72 do vpravo;
   for y:=1 to 25 do vniz;
   for x:=72 down to 1 do vlevo;
   for y:=25 down to 15 do vverh;
   repeat
   textcolor(random(10)+1);
   window(x+10,y.x+24,y);
   write('help !!!');
   until keypressed;
   readln
end.

Ispolzovat' mozno vse sto ugodno. Ja nemnogo razobralsa v tekste, no stob krasivo tekst po ekranu ezdil ne polu4aetsa (On ezdit kak-to haoti4no).
P.S. Glavnoe stob bukvi ili uzor na ekrane ezdil, polzal ili migal ili sto ugodno v etom rode. (mne po4emu-to ni4e ne pridumat', navernoe menja obdelili s voobrazeniem :-/).

Сообщение отредактировано: volvo - 8.11.2006 23:00

[GLuk]

Получай, эксперементируй... (минимум асма!)

Код

{$R-,Q-,S-,Q-}
uses Crt;

{-$i pal_rad.src}
procedure SetPalette;
var   N:Integer;
begin
 Port[$3C8] := 0;
 for N := 0 to 2 do
   Port[$3C9] := 0;
 for N := 3 to 256*3-1 do
   Port[$3C9] := Round(Abs(Sin(N*21167.0))*63);
end; {of SetPalette}

var BIOSTicks: Longint absolute $0040:$006C;

procedure VIDMode(Mode : Byte);assembler;
 asm mov ah,$00;  mov al,mode; int 10h; end;

var Scr: array[0..199,0..319] of Byte absolute $A000:$0000;

type TFont=array[0..32767] of Byte;
var  Font:^TFont absolute 0:$10C;
const FontHeight:Byte=8;
const FontScale:Byte=2;

procedure DrawLetter(L:Char; X,Y:Word; Color:Byte);
var I,J:Word;
begin
 for I:=0 to 7 do
   for J:=0 to 7 do
     if X-J*FontScale*(Y-80) div 50<320 then begin
      Inc(Scr[Y+I*FontScale,X-J*FontScale]
            ,((Font^[Ord(L)*8+I] shr J) and 1)*Color);
      Inc(Scr[Y+I*FontScale,X-J*FontScale+1]
            ,((Font^[Ord(L)*8+I] shr J) and 1)*Color);
      Inc(Scr[Y+I*FontScale+1,X-J*FontScale]
            ,((Font^[Ord(L)*8+I] shr J) and 1)*Color);
      Inc(Scr[Y+I*FontScale+1,X-J*FontScale+1]
            ,((Font^[Ord(L)*8+I] shr J) and 1)*Color);
     end;
end;

procedure Letter(L:Char; X:Word; Color:Byte);
begin
 X:=340-(640-X) mod 400;
 DrawLetter(L,X,160-Abs(Round(50*Cos((200-X)/256*2*PI))),Color);
end;

{---------------------------MAIN PROGRAM-------------------------}

var
 I : Longint;
 J,K,L: Word;
 X:Word;
const S:string='Test string';
begin
 Randomize;

 VIDMode($13);                       { 320x200x256 graphics mode }
 SetPalette;

 I:=0;
 repeat

   for K:=1 to Length(S) do begin
     if I<>0 then
       Letter(S[K],320-(I-1)+K*8*FontScale,-K*16);
       Letter(S[K],320-I+K*8*FontScale,K*16);
     {for L:=0 to 7 do
       for J:=0 to 7 do begin
         Dec(Scr[80+L*FontScale+Round(-32*Abs(Sin(((-(I-1)/8+K)*8)*2*PI/64)))
            ,50+(-(I-1)-J+K*8)*FontScale]
            ,((Font^[Ord(S[K])*8+L] shr J) and 1)*(K)*16);
         Inc(Scr[80+L*FontScale+Round(-32*Abs(Sin(((-I/8+K)*8)*2*PI/64)))
            ,50+(-I-J+K*8)*FontScale]
            ,((Font^[Ord(S[K])*8+L] shr J) and 1)*(K)*16);
         end;}
   end;
   if KeyPressed then case ReadKey of
     ' ': ReadKey;
     #27: Break;
   end;
   Inc(I);
 until False;

 vidMode($03);                       { return to 80x25 textmode }
end.

[SMART]

 GLUUUK!, spasibo za pomos, ona mne kakraz k stati  :) .
Sas poidu protestiruju ee. Thank YOU sto udelil vremja !

[GLuk]

Работает?

[SMART]

   Bojus sto eta proga mne ne podoidet, v nei sliskom mneogo tem kotorie mi ne prohodili (ja ese na pervom kurse). Da... zal', no vseravno spasibo. Mne prosto nado 4enit' poprosse, kak u menja v tekste programmi. Ja ne ozidal sto tak bistro ktonit' mne pomozet, a sait okazivaetsa gramotnii. prijatno sto est' ljudi kotorie mogut i hotjat pomo4'.   Ja izvinajus esli vdrug zada4ka pokazitsa glupoi ili neserjoznoi, no u menja nikak ona ne idet.
    GLUK, ese raz spasibo za pomos  :)

[GLuk]

Нет проблем, перепишу на текстовый... но после того как посплю  :-X

[SMART]

   Mozet ktonit' mozet podskazat' adresok s saitikom gde mona nadibat' gotovih tekstov programm, mozet tam pod4erpnu 4egonibud' poleznoe i podhodjasee????

[SMART]

   Bilo bi zdorovo!  ;D  Ja toze spat' svalivaju, ato 4e-to segodnja zapaskaliksa. :D

[SMART]

 Людииииииииииии, срочно нужна помощь с дороботкой моей программы. Мне её на предстоящей неделе сдавать, а у меня ничего толкогово НИКАК НЕ ВЫХОДИТ  :( . ПоМоГиТе! Правдо я понимаю, конец учебного года, у многих экзамены, сесии и все такое, НО ВДРУГ у кого-то время есть => то помогите!
:-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/

[GLuk]

Вот, посмотри, потести, покспереминтируй со значениями...

И самое главное: Не волнуйся...

Код

Uses
   Crt, DOS;
Const
    S:String = 'XX:XX:XX';        {‚лў®¤Ё¬ п бва®Є }
    X:Byte = 1;
    Y:Byte = 1;
    XOld:Byte = 1;
    YOld:Byte = 1;
    Direction:Byte = 1;           {’ЁЇ ­ Їа ў«Ґ­Ёп}
    NeedTime:Boolean = True;      {ЏаЁ§­ Є ўлў®¤  вҐЄг饣® ўаҐ¬Ґ­Ё}
    Pause:Word = 2000;            {Џ г§  ¬Ґ¦¤г ®Ў­®ў«Ґ­Ёп¬Ё}
    ChangeDelay = 4;              {Џ®б«Ґ бЄ®«мЄЁ и Ј®ў ¬Ґ­пвм ­ Їа ў«Ґ­ЁҐ}
Var
  Hour, Minute, Second, Sec100 : Word;
  St:String;
  i:Byte;

Procedure GenerateTimeString;
begin
    GetTime(Hour, Minute, Second, Sec100);
    Str(Hour,St);
    If St[0]=#1 then Insert('0',St,1);
    S[1]:=St[1];
    S[2]:=St[2];
    Str(Minute,St);
    If St[0]=#1 then Insert('0',St,1);
    S[4]:=St[1];
    S[5]:=St[2];
    Str(Second,St);
    If St[0]=#1 then Insert('0',St,1);
    S[7]:=St[1];
    S[8]:=St[2];
end;

Procedure Warning;
begin
    i:=ChangeDelay;
    Sound(300);
    Delay(100);
    NoSound;
end;

Begin
    Randomize;
    ClrScr;
    i:=1;
    Repeat
    If i=ChangeDelay then
    begin
         Direction:=Random(4)+1; {‚лЎ®а ­ Їа ў«Ґ­Ёп}
         i:=1;
    end;
    Inc(i);
    {…б«Ё ўл нв®Ј® ҐйҐ ­Ґ Їа®е®¤Ё«Ё, Їа®бв® гЎҐаЁ}
    If NeedTime then GenerateTimeString;
    Case Direction of
    1:If X<80 then Inc(x)   {‚Їа ў®}
      else Warning;
    2:If X>1 then Dec(x)    {‚«Ґў®}
      else Warning;
    3:If Y>1 then Dec(y)    {‚ўҐае}
      else Warning;
    4:If Y<25 then Inc(y)   {‚­Ё§}
      else Warning;
    end;
    {‡ вЁа Ґ¬ бв ал© ўлў®¤}
    GotoXY(XOld,YOld); TextColor(Black); TextBackGround(Black); Write(S);
    {ЋЎ­®ў«пҐ¬ §­ зҐ­Ёп бв але Є®®а¤Ё­ в}
    XOld:=X; YOld:=Y;
    {‚лў®¤Ё¬ ®Ў­®ў«Ґ­­го Ё­дг}
    GotoXY(XOld,YOld); TextColor(Random(14)+1); TextBackGround(Black); Write(S);
    Delay(Pause);
    Until KeyPressed;
End.

[SMART]

 SPASIBOOOOOOOOOOOOOOOOOOOOOOOO!!!!!
:D :D :D :D :D :D :D :D :D :D :D :D :D :D :D :D :D :D
sas protestiruju   ;D