Версия для печати темы
Форум «Всё о Паскале» _ Задачи _ Движущийся текст ... :?
Автор: SMART 7.05.2003 2:46
Народ, срочно нужна помощь.....
Подскажите сылку где мона достать текст проги в которой напечатоное слово передвигалось бы по экрану С КАКИМИНИБУДЬ ЭФЕКТАМИ. У меня ето слово только по кругу ездиет и УСЕ .
Если у когонибудь есть чтонибудь похожее, ПЛИЗ подскажите текст проги :-/ .
??? ??? ???
Автор: Shadow 7.05.2003 3:04
:D
---
а какие эффекты нужны
Автор: AlaRic 7.05.2003 15:26
Кидай свой текст сюда - народ посмотрит!
Автор: GLuk 7.05.2003 20:03
Правильно! Кидай сырец доработаем...
Автор: SMART 7.05.2003 20:51
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 :-/).
Автор: GLuk 9.05.2003 13:51
Получай, эксперементируй... (минимум асма!)
Код
{$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 10.05.2003 3:00
GLUUUK!, spasibo za pomos, ona mne kakraz k stati :) .
Sas poidu protestiruju ee. Thank YOU sto udelil vremja !
Автор: GLuk 10.05.2003 3:33
Работает?
Автор: SMART 10.05.2003 3:41
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 10.05.2003 3:44
Нет проблем, перепишу на текстовый... но после того как посплю :-X
Автор: SMART 10.05.2003 3:47
Mozet ktonit' mozet podskazat' adresok s saitikom gde mona nadibat' gotovih tekstov programm, mozet tam pod4erpnu 4egonibud' poleznoe i podhodjasee????
Автор: SMART 10.05.2003 3:57
Bilo bi zdorovo! ;D Ja toze spat' svalivaju, ato 4e-to segodnja zapaskaliksa. :D
Автор: SMART 11.05.2003 4:12
Людииииииииииии, срочно нужна помощь с дороботкой моей программы. Мне её на предстоящей неделе сдавать, а у меня ничего толкогово НИКАК НЕ ВЫХОДИТ :( . ПоМоГиТе! Правдо я понимаю, конец учебного года, у многих экзамены, сесии и все такое, НО ВДРУГ у кого-то время есть => то помогите!
:-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/ :-/
Автор: GLuk 11.05.2003 8:10
Вот, посмотри, потести, покспереминтируй со значениями...
И самое главное: Не волнуйся...
Код
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 11.05.2003 19:38
SPASIBOOOOOOOOOOOOOOOOOOOOOOOO!!!!!
:D :D :D :D :D :D :D :D :D :D :D :D :D :D :D :D :D :D
sas protestiruju ;D