IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Движущийся текст ... :?
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 11

Репутация: -  0  +


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


--------------------
Умная мысль может пpийти и к дуpаку. Hо с ее стоpоны это будет глупостью.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Lonely_Raven
****

Группа: Пользователи
Сообщений: 640
Пол: Мужской

Репутация: -  1  +


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


--------------------
Программа делает то что вы ей приказали а не то что бы ВАМ хотелось бы.
МЕРФИ
---------------------
RTFM - Read the fucking manual
---------------------
http://www.livejournal.com/users/lonley_raven/
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


...
*****

Группа: Пользователи
Сообщений: 1 347
Пол: Мужской

Репутация: -  3  +


Кидай свой текст сюда - народ посмотрит!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Профи
****

Группа: Пользователи
Сообщений: 775
Пол: Мужской

Репутация: -  0  +


Правильно! Кидай сырец доработаем...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Новичок
*

Группа: Пользователи
Сообщений: 11

Репутация: -  0  +


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 -


--------------------
Умная мысль может пpийти и к дуpаку. Hо с ее стоpоны это будет глупостью.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Профи
****

Группа: Пользователи
Сообщений: 775
Пол: Мужской

Репутация: -  0  +


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

Код
{$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.

 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Новичок
*

Группа: Пользователи
Сообщений: 11

Репутация: -  0  +


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


--------------------
Умная мысль может пpийти и к дуpаку. Hо с ее стоpоны это будет глупостью.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Профи
****

Группа: Пользователи
Сообщений: 775
Пол: Мужской

Репутация: -  0  +


Работает?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Новичок
*

Группа: Пользователи
Сообщений: 11

Репутация: -  0  +


   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  :)


--------------------
Умная мысль может пpийти и к дуpаку. Hо с ее стоpоны это будет глупостью.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Профи
****

Группа: Пользователи
Сообщений: 775
Пол: Мужской

Репутация: -  0  +


Нет проблем, перепишу на текстовый... но после того как посплю  :-X smile.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Новичок
*

Группа: Пользователи
Сообщений: 11

Репутация: -  0  +


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


--------------------
Умная мысль может пpийти и к дуpаку. Hо с ее стоpоны это будет глупостью.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #12


Новичок
*

Группа: Пользователи
Сообщений: 11

Репутация: -  0  +


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


--------------------
Умная мысль может пpийти и к дуpаку. Hо с ее стоpоны это будет глупостью.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #13


Новичок
*

Группа: Пользователи
Сообщений: 11

Репутация: -  0  +


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


--------------------
Умная мысль может пpийти и к дуpаку. Hо с ее стоpоны это будет глупостью.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #14


Профи
****

Группа: Пользователи
Сообщений: 775
Пол: Мужской

Репутация: -  0  +


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

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

Код

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.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #15


Новичок
*

Группа: Пользователи
Сообщений: 11

Репутация: -  0  +


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


--------------------
Умная мысль может пpийти и к дуpаку. Hо с ее стоpоны это будет глупостью.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 19.05.2021 0:37
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name