Движущийся текст ... :? |
1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!
Движущийся текст ... :? |
SMART |
Сообщение
#1
|
Новичок Группа: Пользователи Сообщений: 11 Репутация: 0 |
Народ, срочно нужна помощь.....
Подскажите сылку где мона достать текст проги в которой напечатоное слово передвигалось бы по экрану С КАКИМИНИБУДЬ ЭФЕКТАМИ. У меня ето слово только по кругу ездиет и УСЕ . Если у когонибудь есть чтонибудь похожее, ПЛИЗ подскажите текст проги :-/ . ??? ??? ??? -------------------- Умная мысль может пpийти и к дуpаку. Hо с ее стоpоны это будет глупостью.
|
GLuk |
Сообщение
#2
|
Профи Группа: Пользователи Сообщений: 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. |
Текстовая версия | 28.04.2024 7:54 |