1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
Народ, срочно нужна помощь..... Подскажите сылку где мона достать текст проги в которой напечатоное слово передвигалось бы по экрану С КАКИМИНИБУДЬ ЭФЕКТАМИ. У меня ето слово только по кругу ездиет и УСЕ . Если у когонибудь есть чтонибудь похожее, ПЛИЗ подскажите текст проги :-/ . ??? ??? ???
--------------------
Умная мысль может пpийти и к дуpаку. Hо с ее стоpоны это будет глупостью.
Программа делает то что вы ей приказали а не то что бы ВАМ хотелось бы. МЕРФИ --------------------- RTFM - Read the fucking manual --------------------- http://www.livejournal.com/users/lonley_raven/
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оны это будет глупостью.
{-$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 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;
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;
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оны это будет глупостью.
Mozet ktonit' mozet podskazat' adresok s saitikom gde mona nadibat' gotovih tekstov programm, mozet tam pod4erpnu 4egonibud' poleznoe i podhodjasee????
--------------------
Умная мысль может пpийти и к дуpаку. Hо с ее стоpоны это будет глупостью.
Людииииииииииии, срочно нужна помощь с дороботкой моей программы. Мне её на предстоящей неделе сдавать, а у меня ничего толкогово НИКАК НЕ ВЫХОДИТ :( . ПоМоГиТе! Правдо я понимаю, конец учебного года, у многих экзамены, сесии и все такое, НО ВДРУГ у кого-то время есть => то помогите! :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/
--------------------
Умная мысль может пpийти и к дуpаку. Hо с ее стоpоны это будет глупостью.
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;