| Partikelfontaine von ??? von ??? |
| schöne Partikelfontaine, mit wechselnden Farben. Hab Autor nicht mehr - bitte melden. [code:1:cd29ff2f75] Graphics 1024,768,32,1 SetBuffer BackBuffer() ClsColor 0,0,0 Const m=10000,h=40,g=1,cc=5 ;Partikel, Höhe, Gravitation, Farbe Dim x#(m),y#(m),ax#(m),ay#(m),c(m) b=CreateImage(1024,768) Color 255,128,0 ber=2 cg#=255 While ende=0 Cls LockBuffer BackBuffer Select ber Case 1:cr#=cr#-cc:cg#=cg#+cc Case 2:cg#=cg#-cc:cb#=cb#+cc Case 3:cb#=cb#-cc:cr#=cr#+cc End Select If cr#=255 Then ber=1 If cg#=255 Then ber=2 If cb#=255 Then ber=3 col=256*256*cr#+256*cg#+cb# If max<m Then max=max+m/100 For d=1 To max If y#(d)<0 Then x#(d)=0:y#(d)=0 ax#(d)=Rnd#(2)-1:ay#(d)=Rnd#(Rand(h)) c(d)=col End If ax#(d)=ax#(d)*1.02 ;Breite ay#(d)=ay#(d)-g x#(d)=x#(d)+ax#(d) y#(d)=y#(d)+ay#(d) If y#(d)>=0 And y#(d)<767 And -500<x#(d) And x#(d)<500 Then WritePixelFast 512+x#(d),767-y#(d),c(d) Next UnlockBuffer BackBuffer If KeyDown(1) Or MouseDown(1) Then ende=1 If KeyDown(28) Then GrabImage b,0,0 SaveImage b,"fountain.bmp" End If Flip Wend [/code:1:cd29ff2f75] |