[BMax und B2D] Bildschirmschoner Feuerwerk

Übersicht

BlitzMax, BlitzMax NG

Codearchiv & Module

Gehe zu Seite 1, 2 Weiter

	ChaosCoder Betreff: [BMax und B2D] Bildschirmschoner Feuerwerk	Mi, Feb 01, 2006 15:36 Antworten mit Zitat
Hi! Hab das hier mal aus meinem Archiv rausgekramt, schnell optimiert und verbessert! Das ganze kann jeder frei benutzen und ihn, wenn er die Vollversion von BlitzBasic besitzt zu einer exe Datei compilieren und ihn als Bildschirmschoner laufen lassen, da ich selber im moment keine upload Möglichkeit habe! Vielleicht kommt das aber noch und wenn, dann poste ich hier den Link! Edit: Noch schnell ein Screen: Also, dann mal viel Spaß! Code: [AUSKLAPPEN] [EINKLAPPEN] ;Fireworks 2D made by Andy Global gw=1024,gh=768 ;The Graphics! Please edit for best graphics! Graphics gw,gh,16,1 SetBuffer BackBuffer() SeedRnd MilliSecs() Global mx,my,frame,gr#=0.1,gra#=0.3,time,zeit,ka Global img=CreateImage(gw,gh) Global sound1=LoadSound("rakete.wav"),sound2=LoadSound("105.mp3"),sound3=LoadSound("295.mp3"),sound4=LoadSound("220.mp3") Global knall1=LoadSound("42.mp3"),knall2=LoadSound("45.mp3"),knall3=LoadSound("188.mp3") Global p.particle Global r.rocket Type rocket Field x#,y#,sx#,sy#,f,t End Type Type particle Field x#,y#,sx#,sy#,s#,t,r,g,b,nr End Type Function crrocket() ka=Rand(1,4) If ka=1 PlaySound sound1 If ka=2 PlaySound sound2 If ka=3 PlaySound sound3 If ka=4 PlaySound sound4 r=New rocket r\x=Rand(gw) r\y=gh r\sx=Rnd(-5,3) r\sy=Rnd(-8,-13) r\f=frame+Rand(50,100) r\t=Rand(0,8) End Function Function uprocket() For r=Each rocket r\sy=r\sy+gr If r\y<2 r\sy=2 r\y=r\y+r\sy If r\x+r\sx<0 r\sx=-r\sx If r\x+r\sx>gw r\sx=-r\sx r\x=r\x+r\sx r\x=r\x Color 255,128,0 Line r\x,r\y,r\x+r\sx,r\y+r\sy If r\f=frame crparticle(r\x,r\y,r\sx,r\sy,r\t,100) ;Last number is the number of the creating particles when rocket explodes! ka=Rand(1,3) If ka=1 PlaySound knall1 If ka=2 PlaySound knall2 If ka=3 PlaySound knall3 Delete r EndIf Next End Function Function crparticle(x,y,sx,sy,t,anz) For i=0 To anz p=New particle p\x=x p\y=y p\sx=sx/2+Sin(Rand(360))Rnd(-8,8) p\sy=Cos(Rand(360))Rnd(-8,8) p\s=Rand(1,5) p\t=t Select p\t Case 0 p\r=255 p\g=0 p\b=0 Case 1 p\r=0 p\g=255 p\b=0 Case 2 p\r=0 p\g=0 p\b=255 Case 3 p\r=255 p\g=0 p\b=0 Case 4 p\r=0 p\g=255 p\b=0 Case 5 p\r=0 p\g=0 p\b=255 Case 6 p\r=255 p\g=255 p\b=255 Case 7 p\r=255 p\g=255 p\b=255 Case 8 p\r=255 p\g=255 p\b=255 End Select Next End Function Function upparticle() For p=Each particle p\sy=p\sy+gra p\y=p\y+p\sy p\x=p\x+p\sx p\x=p\x p\s=p\s+0.01 Color p\r,p\g,p\b Oval p\x,p\y,p\s,p\s If p\x+p\sx<0 Delete p Exit If p\x+p\sx>gw Delete p Exit If p\y<2 Delete p Exit If p\y>gh Delete p Exit Select p\t Case 0 If p\r>0 p\r=p\r-5 If p\r=0 Delete p Case 1 If p\g>0 p\g=p\g-5 If p\g=0 Delete p Case 2 If p\b>0 p\b=p\b-5 If p\b=0 Delete p Case 3 If p\r=255 And p\g<255 p\g=p\g+10 If p\r=255 And p\g>255 p\r=250 p\g=250 If p\r<255 p\r=p\r-10 p\g=p\g-10 If p\r=0 Delete p Case 4 If p\g=255 And p\r<255 p\r=p\r+10 If p\g=255 And p\r>255 p\g=250 p\r=250 If p\g<255 p\g=p\g-10 p\r=p\r-10 If p\g=0 Delete p Case 5 If p\b=255 And p\r<255 p\r=p\r+10 If p\b=255 And p\r>255 p\b=250 p\r=250 If p\b<255 p\b=p\b-10 p\r=p\r-10 If p\b=0 Delete p Case 6 If p\r=255 And p\g=255 p\b=p\b-10 If p\r=255 And p\g=255 And p\b<0 p\b=0 p\r=250 p\g=250 If p\r=250 And p\g>0 p\g=p\g-10 If p\g<0 p\g=0 p\r=240 If p\g=0 And p\b=0 And p\r>0 p\r=p\r-10 If p\r<=0 Delete p Case 7 If p\r>0 And p\nr=0 p\r=p\r-5 p\g=p\g-5 p\b=p\b-5 If p\r=0 Or p\r=255 p\nr=p\nr+1 p\r=255 p\g=255 p\b=255 If p\nr=2 Delete p Case 8 p\nr=p\nr+1 If p\nr>20 p\b=p\b-5 If p\b=0 Delete p End Select Next End Function mx=MouseX() my=MouseY() While MouseX()=mx And MouseY()=my And GetKey()=0 time=MilliSecs() If MilliSecs()>zeit+Rand(2000,5000) ;Edit the last two numbers for a bigger or smaller time interval between the particle creation zeit=MilliSecs() crrocket() EndIf frame=frame+1 DrawImage img,0,0 uprocket() upparticle() CopyRect 0,0,gw,gh,0,3,BackBuffer(),ImageBuffer(img) Flip Delay 20-(MilliSecs()-time) Cls Wend End
Projekte: Geolaria \| aNemy Webseite: chaosspace.de

ChaosCoder

Betreff: [BMax und B2D] Bildschirmschoner Feuerwerk

Mi, Feb 01, 2006 15:36
Antworten mit Zitat

Hi!
Hab das hier mal aus meinem Archiv rausgekramt, schnell optimiert und verbessert! Das ganze kann jeder frei benutzen und ihn, wenn er die Vollversion von BlitzBasic besitzt zu einer exe Datei compilieren und ihn als Bildschirmschoner laufen lassen, da ich selber im moment keine upload Möglichkeit habe! Vielleicht kommt das aber noch und wenn, dann poste ich hier den Link!

Edit: Noch schnell ein Screen:

Also, dann mal viel Spaß!

Code: [AUSKLAPPEN]

;Fireworks 2D made by Andy

Global gw=1024,gh=768 ;The Graphics! Please edit for best graphics!

Graphics gw,gh,16,1
SetBuffer BackBuffer()
SeedRnd MilliSecs()

Global mx,my,frame,gr#=0.1,gra#=0.3,time,zeit,ka
Global img=CreateImage(gw,gh)
Global sound1=LoadSound("rakete.wav"),sound2=LoadSound("105.mp3"),sound3=LoadSound("295.mp3"),sound4=LoadSound("220.mp3")
Global knall1=LoadSound("42.mp3"),knall2=LoadSound("45.mp3"),knall3=LoadSound("188.mp3")
Global p.particle
Global r.rocket

Type rocket
Field x#,y#,sx#,sy#,f,t
End Type

Type particle
Field x#,y#,sx#,sy#,s#,t,r,g,b,nr
End Type

Function crrocket()
ka=Rand(1,4)
If ka=1 PlaySound sound1
If ka=2 PlaySound sound2
If ka=3 PlaySound sound3
If ka=4 PlaySound sound4
r=New rocket
r\x=Rand(gw)
r\y=gh
r\sx=Rnd(-5,3)
r\sy=Rnd(-8,-13)
r\f=frame+Rand(50,100)
r\t=Rand(0,8)
End Function

Function uprocket()
For r=Each rocket
   r\sy=r\sy+gr
   If r\y<2 r\sy=2
   r\y=r\y+r\sy
   If r\x+r\sx<0 r\sx=-r\sx
   If r\x+r\sx>gw r\sx=-r\sx
   r\x=r\x+r\sx
   r\x=r\x
   Color 255,128,0
   Line r\x,r\y,r\x+r\sx,r\y+r\sy
   If r\f=frame
      crparticle(r\x,r\y,r\sx,r\sy,r\t,100) ;Last number is the number of the creating particles when rocket explodes!
      ka=Rand(1,3)
      If ka=1 PlaySound knall1
      If ka=2 PlaySound knall2
      If ka=3 PlaySound knall3
      Delete r
   EndIf
Next
End Function

Function crparticle(x,y,sx,sy,t,anz)
For i=0 To anz
   p=New particle
   p\x=x
   p\y=y
   p\sx=sx/2+Sin(Rand(360))*Rnd(-8,8)
   p\sy=Cos(Rand(360))*Rnd(-8,8)
   p\s=Rand(1,5)
   p\t=t
   Select p\t
      Case 0
      p\r=255
      p\g=0
      p\b=0
      Case 1
      p\r=0
      p\g=255
      p\b=0
      Case 2
      p\r=0
      p\g=0
      p\b=255
      Case 3
      p\r=255
      p\g=0
      p\b=0
      Case 4
      p\r=0
      p\g=255
      p\b=0
      Case 5
      p\r=0
      p\g=0
      p\b=255
      Case 6
      p\r=255
      p\g=255
      p\b=255
      Case 7
      p\r=255
      p\g=255
      p\b=255
      Case 8
      p\r=255
      p\g=255
      p\b=255
   End Select
Next
End Function

Function upparticle()
For p=Each particle
   p\sy=p\sy+gra
   p\y=p\y+p\sy
   p\x=p\x+p\sx
   p\x=p\x
   p\s=p\s+0.01
   Color p\r,p\g,p\b
   Oval p\x,p\y,p\s,p\s
   If p\x+p\sx<0 Delete p Exit
   If p\x+p\sx>gw Delete p Exit
   If p\y<2 Delete p Exit
   If p\y>gh Delete p Exit
   Select p\t
      Case 0
      If p\r>0 p\r=p\r-5
      If p\r=0 Delete p
      Case 1
      If p\g>0 p\g=p\g-5
      If p\g=0 Delete p
      Case 2
      If p\b>0 p\b=p\b-5
      If p\b=0 Delete p
      Case 3
      If p\r=255 And p\g<255 p\g=p\g+10
      If p\r=255 And p\g>255 p\r=250 p\g=250
      If p\r<255 p\r=p\r-10 p\g=p\g-10
      If p\r=0 Delete p
      Case 4
      If p\g=255 And p\r<255 p\r=p\r+10
      If p\g=255 And p\r>255 p\g=250 p\r=250
      If p\g<255 p\g=p\g-10 p\r=p\r-10
      If p\g=0 Delete p
      Case 5
      If p\b=255 And p\r<255 p\r=p\r+10
      If p\b=255 And p\r>255 p\b=250 p\r=250
      If p\b<255 p\b=p\b-10 p\r=p\r-10
      If p\b=0 Delete p
      Case 6
      If p\r=255 And p\g=255 p\b=p\b-10
      If p\r=255 And p\g=255 And p\b<0 p\b=0 p\r=250 p\g=250
      If p\r=250 And p\g>0 p\g=p\g-10
      If p\g<0 p\g=0 p\r=240
      If p\g=0 And p\b=0 And p\r>0 p\r=p\r-10
      If p\r<=0 Delete p
      Case 7
      If p\r>0 And p\nr=0 p\r=p\r-5 p\g=p\g-5 p\b=p\b-5
      If p\r=0 Or p\r=255 p\nr=p\nr+1 p\r=255 p\g=255 p\b=255
      If p\nr=2 Delete p
      Case 8
      p\nr=p\nr+1
      If p\nr>20 p\b=p\b-5
      If p\b=0 Delete p
   End Select
Next
End Function

mx=MouseX()
my=MouseY()

While MouseX()=mx And MouseY()=my And GetKey()=0

time=MilliSecs()

If MilliSecs()>zeit+Rand(2000,5000) ;Edit the last two numbers for a bigger or smaller time interval between the particle creation
   zeit=MilliSecs()
   crrocket()
EndIf

frame=frame+1

DrawImage img,0,0
uprocket()
upparticle()
CopyRect 0,0,gw,gh,0,3,BackBuffer(),ImageBuffer(img)

Flip
Delay 20-(MilliSecs()-time)
Cls

Wend

End

Projekte: Geolaria | aNemy
Webseite: chaosspace.de

Zuletzt bearbeitet von ChaosCoder am So, Jul 16, 2006 14:20, insgesamt 2-mal bearbeitet

	BlitzChecker	Do, Feb 02, 2006 16:30 Antworten mit Zitat
genial... is aber nicht sehr real, weil bei einem echten feuerwerk zieht das bestimmt nich nach links rüber... aber echt fett! in welchem archiv gibts denn so geile codes?
www.xairro.com

BlitzChecker

Do, Feb 02, 2006 16:30
Antworten mit Zitat

genial...
is aber nicht sehr real, weil bei einem echten feuerwerk zieht das bestimmt nich nach links rüber...

aber echt fett! in welchem archiv gibts denn so geile codes?

www.xairro.com

	aMul Sieger des Minimalist Compo 01/13	Do, Feb 02, 2006 16:51 Antworten mit Zitat
Kann mich Blitzchecker nur anschließen... Ist zwar unrealistisch, sieht aber genial aus!!!
Panic Pong - ultimate action mashup of Pong and Breakout <= aktives Spiele-Projekt, Downloads mit vielen bunten Farben! advASCIIdraw - the advanced ASCII art program <= aktives nicht-Spiele-Projekt, must-have für ASCII/roguelike/dungeon-crawler fans! Alter BB-Kram: ThroughTheAsteroidBelt - mit Quelltext! \| RGB-Palette in 32²-Textur / Farbige Beleuchtung mit Dot3 \| Stereoskopie in Blitz3D \| Teleport-Animation Screensaver

aMul

Sieger des Minimalist Compo 01/13

Do, Feb 02, 2006 16:51
Antworten mit Zitat

Kann mich Blitzchecker nur anschließen...
Ist zwar unrealistisch, sieht aber genial aus!!!

Panic Pong - ultimate action mashup of Pong and Breakout <= aktives Spiele-Projekt, Downloads mit vielen bunten Farben!
advASCIIdraw - the advanced ASCII art program <= aktives nicht-Spiele-Projekt, must-have für ASCII/roguelike/dungeon-crawler fans!
Alter BB-Kram: ThroughTheAsteroidBelt - mit Quelltext! | RGB-Palette in 32²-Textur / Farbige Beleuchtung mit Dot3 | Stereoskopie in Blitz3D | Teleport-Animation Screensaver

	ChaosCoder	Do, Feb 02, 2006 20:59 Antworten mit Zitat
das mit dem nach links laufenden Feuerwerk war eigentlich dafür gedacht, dass unten noch Landschaft zu sehen ist, so ne Art Scrolling Hintergrund! Und das wär dann real... Naja.. das ganze müsste dann natürlich noch ein bisschen nach unten ziehen... mal gucken, vielleicht verbesser ich das noch! Hatte aber keine guten Pixs gefunden und Pixeln kann ich ja mal garnet!
Projekte: Geolaria \| aNemy Webseite: chaosspace.de

ChaosCoder

Do, Feb 02, 2006 20:59
Antworten mit Zitat

das mit dem nach links laufenden Feuerwerk war eigentlich dafür gedacht, dass unten noch Landschaft zu sehen ist, so ne Art Scrolling Hintergrund!
Und das wär dann real... Naja.. das ganze müsste dann natürlich noch ein bisschen nach unten ziehen... mal gucken, vielleicht verbesser ich das noch! Hatte aber keine guten Pixs gefunden und Pixeln kann ich ja mal garnet! Embarassed

Projekte: Geolaria | aNemy
Webseite: chaosspace.de

	ChaosCoder	Do, Feb 02, 2006 23:03 Antworten mit Zitat
so... hab mal schnell nen Effekt hinzugefügt und das ganze als exe gemacht, damit mans als Screensaver benutzen kann! Bitteschön: http://www.eastwestgames.de/file.php?id=85
Projekte: Geolaria \| aNemy Webseite: chaosspace.de

ChaosCoder

Do, Feb 02, 2006 23:03
Antworten mit Zitat

so... hab mal schnell nen Effekt hinzugefügt und das ganze als exe gemacht, damit mans als Screensaver benutzen kann! Razz

Bitteschön:
http://www.eastwestgames.de/file.php?id=85

Projekte: Geolaria | aNemy
Webseite: chaosspace.de

Zuletzt bearbeitet von ChaosCoder am Fr, Feb 03, 2006 15:53, insgesamt einmal bearbeitet

	Schnuff	Fr, Feb 03, 2006 11:24 Antworten mit Zitat
wenn es noch realer aussehen soll, müssen die oberen Pixel schneller runter kommen, als die unteren(und die Fluglinie Verschwinden) aber sieht echt genial aus
Programmers dont die. They gosub without return...

Schnuff

Fr, Feb 03, 2006 11:24
Antworten mit Zitat

wenn es noch realer aussehen soll, müssen die oberen Pixel schneller runter kommen, als die unteren(und die Fluglinie Verschwinden)

aber sieht echt genial aus Very Happy

Programmers dont die. They gosub without return...

	ChaosCoder	Fr, Feb 03, 2006 14:46 Antworten mit Zitat
@Schnuff: Das versteh ich net, sry! Welche oberen Pixel und warum schneller runter fallen? Und die Fluglinie verschwinden lassen? warum das? sry, hab grad glaub ich nen blackout
Projekte: Geolaria \| aNemy Webseite: chaosspace.de

ChaosCoder

Fr, Feb 03, 2006 14:46
Antworten mit Zitat

@Schnuff:

Das versteh ich net, sry! Welche oberen Pixel und warum schneller runter fallen? Und die Fluglinie verschwinden lassen? warum das? sry, hab grad glaub ich nen blackout Wink

Projekte: Geolaria | aNemy
Webseite: chaosspace.de

	Spikespine	Fr, Feb 03, 2006 15:01 Antworten mit Zitat
nett. Die Feuerwerksblumen sollten aber nicht ewig stehen bleiben. spikespine
Athlon 64 3700+ \| 1024 MB RAM \| GeForce 7900 GT \| Blitz2D, Blitz3D, BlitzPlus, BlitzMax

Spikespine

Fr, Feb 03, 2006 15:01
Antworten mit Zitat

nett.
Die Feuerwerksblumen sollten aber nicht ewig stehen bleiben.

spikespine

Athlon 64 3700+ | 1024 MB RAM | GeForce 7900 GT | Blitz2D, Blitz3D, BlitzPlus, BlitzMax

	ChaosCoder	Fr, Feb 03, 2006 15:52 Antworten mit Zitat
so, danke für die positiven Bewertungen! Hab schnell ne neue Version geuploaded... die ist jetzt mit ein paar sounds und einem zusätzlichen effekt! Viel Spaß! Edit: Außerdem wurde der Code oben entsprechend geupdatet! Neuer Link: http://www.eastwestgames.de/file.php?id=85
Projekte: Geolaria \| aNemy Webseite: chaosspace.de

ChaosCoder

Fr, Feb 03, 2006 15:52
Antworten mit Zitat

so, danke für die positiven Bewertungen! Hab schnell ne neue Version geuploaded... die ist jetzt mit ein paar sounds und einem zusätzlichen effekt! Viel Spaß!

Edit: Außerdem wurde der Code oben entsprechend geupdatet!

Neuer Link:
http://www.eastwestgames.de/file.php?id=85

Projekte: Geolaria | aNemy
Webseite: chaosspace.de

	5k41	Fr, Feb 03, 2006 17:45 Antworten mit Zitat
Hi! Super Arbeit! Finde man könnte es noch so machen das sich die Farben langsam gen schwarz hin auflösen...ich mein ein Feuerwerk fällt ja auchnicht einfach so in der Blumenform vom Himmel sondern löst sich vorher langsam auf bis nur noch ein paar funken fallen...nur so als denkanstoß
Projekte: For a better World - Gesellschaftsspiel ( 100%) User posted image

5k41

Fr, Feb 03, 2006 17:45
Antworten mit Zitat

Hi!
Super Arbeit! Finde man könnte es noch so machen das sich die Farben langsam gen schwarz hin auflösen...ich mein ein Feuerwerk fällt ja auchnicht einfach so in der Blumenform vom Himmel sondern löst sich vorher langsam auf bis nur noch ein paar funken fallen...nur so als denkanstoß Wink

Projekte:
For a better World - Gesellschaftsspiel ( 100%)

User posted image

	ChaosCoder	Fr, Feb 03, 2006 22:22 Antworten mit Zitat
Danke! Das mit dem langsam auflösen wollt ich ja auch machen, aber da ich das in Blitz 2D geproggt habe, kann ich leider kein Alpha verwenden Vlt fällt mir ja was ein! Außerdem lerne ich grad Blitz Max und der unterstütz natürlich den Alphakanal somit könnte ich dann den Code vlt umschreiben und ihn mit Blitzmax vertreiben Mal gucken und Danke für die Vorschläge! ChAoS\|DrAgOn
Projekte: Geolaria \| aNemy Webseite: chaosspace.de

ChaosCoder

Fr, Feb 03, 2006 22:22
Antworten mit Zitat

Danke! Das mit dem langsam auflösen wollt ich ja auch machen, aber da ich das in Blitz 2D geproggt habe, kann ich leider kein Alpha verwenden Sad

Vlt fällt mir ja was ein! Außerdem lerne ich grad Blitz Max und der unterstütz natürlich den Alphakanal somit könnte ich dann den Code vlt umschreiben und ihn mit Blitzmax vertreiben Smile

Mal gucken und Danke für die Vorschläge!

ChAoS|DrAgOn

Projekte: Geolaria | aNemy
Webseite: chaosspace.de

	Florian	Fr, Feb 03, 2006 22:40 Antworten mit Zitat
@Andy030 Du brauchst dazu kein Alpha umbedingt. Es reicht aus ,wenn du den Farbwert erniedrigt

Florian

Fr, Feb 03, 2006 22:40
Antworten mit Zitat

@Andy030 Du brauchst dazu kein Alpha umbedingt. Es reicht aus ,wenn du den Farbwert erniedrigt

	ChaosCoder	Fr, Feb 03, 2006 22:58 Antworten mit Zitat
naja... wenn du mal in meinen Code geguckt hättest, würdest du da sehen das einfach und wirklich simpel Alles am Ende eines durchgangs in ein Bild kopiert wird und dieses dann einfach nur gedrawed wird! Es ist wirklich ganz einfach! Oder kann man jetzt zusätzlich bei dem Bild nochwas machen... ich mein klar... alles mit readpixelfast und writepixelfast machen... das ganze geht dann so richtig in die knie ! Also wär nett, wenn du das ganze erläutern könntest! MfG ChAoS\|DrAgOn
Projekte: Geolaria \| aNemy Webseite: chaosspace.de

ChaosCoder

Fr, Feb 03, 2006 22:58
Antworten mit Zitat

naja... wenn du mal in meinen Code geguckt hättest, würdest du da sehen das einfach und wirklich simpel Alles am Ende eines durchgangs in ein Bild kopiert wird und dieses dann einfach nur gedrawed wird! Es ist wirklich ganz einfach!
Oder kann man jetzt zusätzlich bei dem Bild nochwas machen... ich mein klar... alles mit readpixelfast und writepixelfast machen... das ganze geht dann so richtig in die knie Wink

! Also wär nett, wenn du das ganze erläutern könntest!

MfG ChAoS|DrAgOn

Projekte: Geolaria | aNemy
Webseite: chaosspace.de

	ChaosCoder	Sa, Feb 04, 2006 16:56 Antworten mit Zitat
so... jetzt gibts ne bmax versoin die viel besser aussieht als die bb version ich wollte keinen extra thread dafür aufmachen... Also, dann hoff ich mal auf ein bisschen Kritik und Verbesserungsvorschlage! Die Exe für nen Screensaver werde ich auch bald mal uploaden! Hier der Code: (Bmax) Code: [AUSKLAPPEN] [EINKLAPPEN] 'Fireworks 2D made by Andy Global gw=1024,gh=768 'The Graphics! Please edit For best Graphics! Graphics gw,gh,0 SetBlend alphablend SeedRnd MilliSecs() Global frame,gr#=0.1,gra#=0.3,time,zeit,ka,i Global p:particle Global r:rocket Global list:TList=CreateList() Global list2:TList=CreateList() MoveMouse gw,gh Type rocket Field x#,y#,sx#,sy#,f,t End Type Type particle Field x#,y#,sx#,sy#,s#,t,r,g,b,a#,nr End Type Local mx%=MouseX() Local my%=MouseY() Function crrocket() r=New rocket r.x=Rand(gw) r.y=gh r.sx=Rnd(-5,3) r.sy=Rnd(-8,-13) r.f=frame+Rand(50,100) r.t=Rand(0,8) ListAddLast(list,r) End Function Function uprocket() For r=EachIn list r.sy=r.sy+gr If r.y<2 r.sy=2 r.y=r.y+r.sy If r.x+r.sx<0 r.sx=-r.sx If r.x+r.sx>gw r.sx=-r.sx r.x=r.x+r.sx r.x=r.x SetColor 255,128,0 DrawLine r.x,r.y,r.x+r.sx,r.y+r.sy If r.f=frame crparticle(r.x,r.y,r.sx,r.sy,r.t,500) 'Last number is the number of the creating particles when rocket explodes! ListRemove(list,r) EndIf Next End Function Function crparticle(x,y,sx,sy,t,anz) For i%=1 To anz p=New particle p.x=x p.y=y p.sx=sx/2+Sin(Rand(360))Rnd(-8,8) p.sy=Cos(Rand(360))Rnd(-8,8) p.s=Rand(1,5) p.t=t p.a=1 Select p.t Case 0 p.r=255 p.g=0 p.b=0 Case 1 p.r=0 p.g=255 p.b=0 Case 2 p.r=0 p.g=0 p.b=255 Case 3 p.r=255 p.g=0 p.b=0 Case 4 p.r=0 p.g=255 p.b=0 Case 5 p.r=0 p.g=0 p.b=255 Case 6 p.r=255 p.g=255 p.b=255 Case 7 p.r=255 p.g=255 p.b=255 Case 8 p.r=255 p.g=255 p.b=255 End Select ListAddLast(list2,p) Next End Function Function upparticle() For p=EachIn list2 p.sy=p.sy+gr p.y=p.y+p.sy p.x=p.x+p.sx p.x=p.x p.s=p.s+0.01 SetAlpha p.a SetColor p.r,p.g,p.b DrawOval p.x,p.y,p.s,p.s If p.x+p.sx<0 ListRemove(list2,p) If p.x+p.sx>gw ListRemove(list2,p) If p.y>gh ListRemove(list2,p) Select p.t Case 0 If p.r>0 p.a:-.01 If p.a=0 ListRemove(list2,p) Case 1 If p.g>0 p.a:-.01 If p.a=0 ListRemove(list2,p) Case 2 If p.b>0 p.a:-.01 If p.a=0 ListRemove(list2,p) Case 3 If p.r=255 And p.g<255 p.g=p.g+2 If p.r=255 And p.g>255 p.r=250 p.g=250 If p.r<255 p.a:-.01 If p.a=0 ListRemove(list2,p) Case 4 If p.g=255 And p.r<255 p.r=p.r+2 If p.g=255 And p.r>255 p.g=250 p.r=250 If p.g<255 p.a:-.01 If p.a=0 ListRemove(list2,p) Case 5 If p.b=255 And p.r<255 p.r=p.r+2 If p.b=255 And p.r>255 p.b=250 p.r=250 If p.b<255 p.a:-.01 If p.a=0 ListRemove(list2,p) Case 6 If p.r=255 And p.g=255 p.b=p.b-10 If p.r=255 And p.g=255 And p.b<0 p.b=0 p.r=253 p.g=253 If p.r=250 And p.g>0 p.g=p.g-2 If p.g<0 p.g=0 p.r=240 If p.g=0 And p.b=0 And p.r>0 p.a:-.01 If p.a<=0 ListRemove(list2,p) Case 7 If p.r>0 And p.nr=0 p.r:-1 If p.r=0 Or p.r=255 p.nr=p.nr+1 p.r=255 p.g=255 p.b=255 If p.nr=2 ListRemove(list2,p) Case 8 p.nr=p.nr+1 If p.nr>20 p.a:-.01 If p.a=0 ListRemove(list2,p) End Select Next End Function mx=MouseX() my=MouseY() While MouseX()=mx And MouseY()=my time=MilliSecs() If MilliSecs()>zeit+Rand(1000,3000) 'Edit the last two numbers For a bigger Or smaller time interval between the particle creation zeit=MilliSecs() crrocket() EndIf frame=frame+1 For x=1 To 2 uprocket() upparticle() SetAlpha .1 SetColor 0,0,0 DrawRect 0,0,1024,768 Flip Next SetAlpha .5 Wend End
Projekte: Geolaria \| aNemy Webseite: chaosspace.de

ChaosCoder

Sa, Feb 04, 2006 16:56
Antworten mit Zitat

so...
jetzt gibts ne bmax versoin die viel besser aussieht als die bb version Very Happy

ich wollte keinen extra thread dafür aufmachen... Also, dann hoff ich mal auf ein bisschen Kritik und Verbesserungsvorschlage! Die Exe für nen Screensaver werde ich auch bald mal uploaden!
Hier der Code: (Bmax)

Code: [AUSKLAPPEN]

'Fireworks 2D made by Andy

Global gw=1024,gh=768 'The Graphics! Please edit For best Graphics!

Graphics gw,gh,0
SetBlend alphablend
SeedRnd MilliSecs()

Global frame,gr#=0.1,gra#=0.3,time,zeit,ka,i
Global p:particle
Global r:rocket
Global list:TList=CreateList()
Global list2:TList=CreateList()

MoveMouse gw,gh

Type rocket
Field x#,y#,sx#,sy#,f,t
End Type

Type particle
Field x#,y#,sx#,sy#,s#,t,r,g,b,a#,nr
End Type

Local mx%=MouseX()
Local my%=MouseY()

Function crrocket()
r=New rocket
r.x=Rand(gw)
r.y=gh
r.sx=Rnd(-5,3)
r.sy=Rnd(-8,-13)
r.f=frame+Rand(50,100)
r.t=Rand(0,8)
ListAddLast(list,r)
End Function

Function uprocket()
For r=EachIn list
   r.sy=r.sy+gr
   If r.y<2 r.sy=2
   r.y=r.y+r.sy
   If r.x+r.sx<0 r.sx=-r.sx
   If r.x+r.sx>gw r.sx=-r.sx
   r.x=r.x+r.sx
   r.x=r.x
   SetColor 255,128,0
   DrawLine r.x,r.y,r.x+r.sx,r.y+r.sy
   If r.f=frame
      crparticle(r.x,r.y,r.sx,r.sy,r.t,500) 'Last number is the number of the creating particles when rocket explodes!
      ListRemove(list,r)
   EndIf
Next
End Function

Function crparticle(x,y,sx,sy,t,anz)
For i%=1 To anz
   p=New particle
   p.x=x
   p.y=y
   p.sx=sx/2+Sin(Rand(360))*Rnd(-8,8)
   p.sy=Cos(Rand(360))*Rnd(-8,8)
   p.s=Rand(1,5)
   p.t=t
   p.a=1
   Select p.t
      Case 0
      p.r=255
      p.g=0
      p.b=0
      Case 1
      p.r=0
      p.g=255
      p.b=0
      Case 2
      p.r=0
      p.g=0
      p.b=255
      Case 3
      p.r=255
      p.g=0
      p.b=0
      Case 4
      p.r=0
      p.g=255
      p.b=0
      Case 5
      p.r=0
      p.g=0
      p.b=255
      Case 6
      p.r=255
      p.g=255
      p.b=255
      Case 7
      p.r=255
      p.g=255
      p.b=255
      Case 8
      p.r=255
      p.g=255
      p.b=255
   End Select
   ListAddLast(list2,p)
Next
End Function

Function upparticle()
For p=EachIn list2
   p.sy=p.sy+gr
   p.y=p.y+p.sy
   p.x=p.x+p.sx
   p.x=p.x
   p.s=p.s+0.01
   SetAlpha p.a
   SetColor p.r,p.g,p.b
   DrawOval p.x,p.y,p.s,p.s
   If p.x+p.sx<0 ListRemove(list2,p)
   If p.x+p.sx>gw ListRemove(list2,p)
   If p.y>gh ListRemove(list2,p)
   Select p.t
      Case 0
      If p.r>0 p.a:-.01
      If p.a=0 ListRemove(list2,p)
      Case 1
      If p.g>0 p.a:-.01
      If p.a=0 ListRemove(list2,p)
      Case 2
      If p.b>0 p.a:-.01
      If p.a=0 ListRemove(list2,p)
      Case 3
      If p.r=255 And p.g<255 p.g=p.g+2
      If p.r=255 And p.g>255 p.r=250 p.g=250
      If p.r<255 p.a:-.01
      If p.a=0 ListRemove(list2,p)
      Case 4
      If p.g=255 And p.r<255 p.r=p.r+2
      If p.g=255 And p.r>255 p.g=250 p.r=250
      If p.g<255 p.a:-.01
      If p.a=0 ListRemove(list2,p)
      Case 5
      If p.b=255 And p.r<255 p.r=p.r+2
      If p.b=255 And p.r>255 p.b=250 p.r=250
      If p.b<255 p.a:-.01
      If p.a=0 ListRemove(list2,p)
      Case 6
      If p.r=255 And p.g=255 p.b=p.b-10
      If p.r=255 And p.g=255 And p.b<0 p.b=0 p.r=253 p.g=253
      If p.r=250 And p.g>0 p.g=p.g-2
      If p.g<0 p.g=0 p.r=240
      If p.g=0 And p.b=0 And p.r>0 p.a:-.01
      If p.a<=0 ListRemove(list2,p)
      Case 7
      If p.r>0 And p.nr=0 p.r:-1
      If p.r=0 Or p.r=255 p.nr=p.nr+1 p.r=255 p.g=255 p.b=255
      If p.nr=2 ListRemove(list2,p)
      Case 8
      p.nr=p.nr+1
      If p.nr>20 p.a:-.01
      If p.a=0 ListRemove(list2,p)
   End Select
Next
End Function

mx=MouseX()
my=MouseY()

While MouseX()=mx And MouseY()=my

time=MilliSecs()

If MilliSecs()>zeit+Rand(1000,3000) 'Edit the last two numbers For a bigger Or smaller time interval between the particle creation
   zeit=MilliSecs()
   crrocket()
EndIf

frame=frame+1

For x=1 To 2
uprocket()
upparticle()
SetAlpha .1
SetColor 0,0,0
DrawRect 0,0,1024,768
Flip
Next
SetAlpha .5

Wend

End

Projekte: Geolaria | aNemy
Webseite: chaosspace.de

	5k41	Sa, Feb 04, 2006 19:38 Antworten mit Zitat
mh würd mir das gern angucken hab aber kein Bmax... kannst du das Kompiliert vielleicht irgednwo hochladen? wär echt cool!
Projekte: For a better World - Gesellschaftsspiel ( 100%) User posted image

5k41

Sa, Feb 04, 2006 19:38
Antworten mit Zitat

mh würd mir das gern angucken hab aber kein Bmax... kannst du das Kompiliert vielleicht irgednwo hochladen? wär echt cool!

Projekte:
For a better World - Gesellschaftsspiel ( 100%)

User posted image

	ChaosCoder	Sa, Feb 04, 2006 21:19 Antworten mit Zitat
So, gesagt, getan! Hier der Link: http://www.eastwestgames.de/file.php?id=93 Viel Spaß! ChAoS DrAgOn
Projekte: Geolaria \| aNemy Webseite: chaosspace.de

ChaosCoder

Sa, Feb 04, 2006 21:19
Antworten mit Zitat

So, gesagt, getan!

Hier der Link:
http://www.eastwestgames.de/file.php?id=93

Viel Spaß!
ChAoS DrAgOn

Projekte: Geolaria | aNemy
Webseite: chaosspace.de

Zuletzt bearbeitet von ChaosCoder am Sa, Feb 04, 2006 23:02, insgesamt einmal bearbeitet

	5k41	Sa, Feb 04, 2006 21:33 Antworten mit Zitat
Danke! Gefällt mir so echt gut... kann es sein das du einige Spezial Raketen weg gelassen hast? erinnere mich da an so eine die so zackige leuchtspruen hatte... konnte die eben net erkennen...
Projekte: For a better World - Gesellschaftsspiel ( 100%) User posted image

5k41

Sa, Feb 04, 2006 21:33
Antworten mit Zitat

Danke!

Gefällt mir so echt gut... kann es sein das du einige Spezial Raketen weg gelassen hast? erinnere mich da an so eine die so zackige leuchtspruen hatte... konnte die eben net erkennen... Sad

Projekte:
For a better World - Gesellschaftsspiel ( 100%)

User posted image

	ChaosCoder	Sa, Feb 04, 2006 21:49 Antworten mit Zitat
das mit den zackigen spuren is ne ganz komische geschichte! Das lag nur daran, dass der Pc zwischendurch bei vielen Partikeln und bei deren Löschung also gen ende eines Partikels ein klein wenig zu langsam ist, weil ich beim bb code exit benutzt habe! Somit hat er einfach der rest der noch zu überprüfenden partikel in der schleife weggelassen. Dann wurde aber das ganze um 2 Pixel nach oben gesetzt und nochmal überprüft... Somit enstanden komische zackige Spuren! Das heißt, es war nur ein kleiner Logikfehler! Aber ich kann mal gucken, ob ich das in BMax hinkriege, hab schon so ne Idee !
Projekte: Geolaria \| aNemy Webseite: chaosspace.de

ChaosCoder

Sa, Feb 04, 2006 21:49
Antworten mit Zitat

das mit den zackigen spuren is ne ganz komische geschichte!
Das lag nur daran, dass der Pc zwischendurch bei vielen Partikeln und bei deren Löschung also gen ende eines Partikels ein klein wenig zu langsam ist, weil ich beim bb code exit benutzt habe! Somit hat er einfach der rest der noch zu überprüfenden partikel in der schleife weggelassen.
Dann wurde aber das ganze um 2 Pixel nach oben gesetzt und nochmal überprüft... Somit enstanden komische zackige Spuren! Das heißt, es war nur ein kleiner Logikfehler! Aber ich kann mal gucken, ob ich das in BMax hinkriege, hab schon so ne Idee Very Happy

Projekte: Geolaria | aNemy
Webseite: chaosspace.de

	ChaosCoder	Sa, Feb 04, 2006 23:01 Antworten mit Zitat
So... Es gibt jetzt 2 weiter Effekte und Zick-Zack-Spuren Außerdem nun Blitz effekte Wünsch euch noch viel Spaß mit dem Programm! Hier der neue Link! http://www.eastwestgames.de/file.php?id=93 Edit: Neuer Screenshot
Projekte: Geolaria \| aNemy Webseite: chaosspace.de