Информационный сервер для программистов: Исходники со всего света. Паскальные исходники со всего света
  Powered by Поисковый сервер Яndex: Найдется ВСЁ!
На Главную Исходники Форум Информер Страны мира
   Demo Making    >>    draw
   
 
 Draw - Sinusoidal Running Text String [320x200x256]   Alexey Monastyrenko 04.05.97

Демострационная заставка. Бегущая по отраженной синусоиде цветная текстовая строка.



1k 
 

  {> Cut here. FileName= DRAW.PAS } {Draw - Sinusoidal Running Text Demo [320x200x256] by Alexey Monastyrenko <aamonster@mail.ru> 04 May 1997 } {$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; if KeyPressed then case ReadKey of ' ': ReadKey; #27: Break; end; Inc(I); until False; vidMode($03); { return to 80x25 textmode } end.