 |
Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
| Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
| Autor |
Nachricht |
steff
Anmeldungsdatum: 24.03.2007
Beiträge: 11
|
 Verfasst am: 25.03.2007, 16:21 Titel: Fireworks (particle-test-demo) |
 |
|
Grüße!
Ein simpler Experimentiercode/Particletest
Da ich einen eher lahmen comp benutze, ist es möglich,dass es zu schnell läuft.
Verändert dann den Wert von "MAXPARTICLES"
zum prog:
Klick einach mit einer Maustaste irgendwohin
EDIT: zur Sicherheit : Benutz die mittlere Maustaste nur spärlich, und gar nicht wenn du an Epilepsie leidest.
EDIT: Code wurde etwas 'entschärft'.
(Wenn "MAXPARTICLES" verändert wird, kann es bei der mittleren Maustaste zu Farbüberlagerungen/Interferenzen kommen. Hat nichts mit FB zu tun, sondern mit meiner Farbroutine; müsste etwas verändert werden, habs aber der Einfachheit halber so belassen;ist kein wirkliches Problem)
Gruß
steff
| Code: |
' Fireworks
' by stef
OPTION STATIC
OPTION EXPLICIT
CONST MAXPARTICLES=3600 '300;600;900;1500;3000; 6000; 12000;24000;48000
CONST SCREENW=800
CONST SCREENH=600
declare sub initparticles()
declare sub calcparticles()
declare sub drawparticles()
declare sub createcolours()
declare sub createstars()
declare sub drawstars()
dim shared grav as single =0.02
dim shared posx as integer
dim shared posy as integer
dim shared buttons as integer
dim shared col as integer
dim shared col_red as integer
dim shared col_green as integer
dim shared col_blue as integer=255
dim shared colfactor as integer =5 ' only: 1; 5; 15
dim shared counter as integer
dim shared mousestatus as integer
dim shared colourstatus as integer
type tstars
x as integer
y as integer
end type
type tparticles
x as single
y as single
dx as single
dy as single
size as integer
angle as single
speed as single
col as integer
end type
dim shared stars(100) as tstars
dim shared particle(MAXPARTICLES) as tparticles
SCREEN 19, 16, 2, 1
SCREENSET 1, 0
RANDOMIZE TIMER
Dim Im As Byte Ptr
Im = Imagecreate(SCREENW, SCREENH, RGB(5, 5, 5))
createstars()
DO
GETMOUSE posx, posy,, buttons
if buttons=0 then
'if not Bit(buttons, 0) THEN
mousestatus=0
endif
if mousestatus=0 then
IF Bit(buttons, 0) THEN
initparticles()
mousestatus=1
colourstatus=1
endif
IF Bit(buttons, 2) THEN
initparticles()
mousestatus=1
colourstatus=2
endif
IF Bit(buttons, 1) THEN
initparticles()
mousestatus=1
colourstatus=3
endif
endif
drawstars()
calcparticles()
drawparticles()
put (0,0),im,alpha,5
locate 1,1,0
print "click LM/RM/MM"
SCREENCOPY
LOOP UNTIL INKEY$=CHR$(27)
Imagedestroy Im
end
sub initparticles()
dim x as integer
for x= 0 to MAXPARTICLES
createcolours()
particle(x).col=rgb(col_red,col_green,col_blue)
particle(x).x=posx
particle(x).y=posy
particle(x).size=Rnd*3+1
particle(x).angle=(Rnd*360)*0.017453293
particle(x).speed=Rnd*5+0.1
particle(x).dx=sin(particle(x).angle)*particle(x).speed
particle(x).dy=cos(particle(x).angle)*particle(x).speed
next
end sub
sub calcparticles()
dim x as integer
if colourstatus= 1 then
createcolours()
col=rgb(col_red,col_green,col_blue)
endif
for x= 0 to MAXPARTICLES
if colourstatus= 2 then
createcolours()
col=rgb(col_red,col_green,col_blue)
particle(x).size=1
endif
if colourstatus<3 then
particle(x).col=col
endif
particle(x).x=particle(x).x+particle(x).dx
particle(x).y=particle(x).y+particle(x).dy
particle(x).dy=particle(x).dy+grav
next
end sub
sub drawparticles()
dim x as integer
for x= 0 to MAXPARTICLES
circle (particle(x).x,particle(x).y),particle(x).size,particle(x).col,,,,F
next
end sub
sub createcolours()
If col_red<255 And col_green =0 And col_blue =255 Then col_red=col_red+colfactor
If col_red=255 And col_green=0 And col_blue >0 Then col_blue=col_blue-colfactor
If col_red=255 And col_green < 255 And col_blue =0 Then col_green=col_green+colfactor
If col_red>0 And col_green = 255 And col_blue =0 Then col_red=col_red-colfactor
If col_red=0 And col_green = 255 And col_blue <255 Then col_blue=col_blue+colfactor
If col_red=0 And col_green >0 And col_blue =255 Then col_green=col_green-colfactor
end sub
sub drawstars()
dim c as integer
for counter =0 to 100
c=rnd*255
if c>127 then
circle (stars(counter).x,stars(counter).y),rnd*2,rgb(c,c,c),,,,F
endif
next
end sub
sub createstars()
dim c as integer
for counter =0 to 100
stars(counter).x=rnd*SCREENW
stars(counter).y=rnd*SCREENH
next
end sub
|
Zuletzt bearbeitet von steff am 25.03.2007, 18:03, insgesamt 4-mal bearbeitet |
|
| Nach oben |
|
 |
Eternal_pain
Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA
|
| Verfasst am: 25.03.2007, 16:32 Titel: |
|
|
Ich bin immer wieder von einigen Projekten begeistert 
Was so ein paar Mathematische berechnungen doch so alles anrichten können. Sieht toll aus... Allerdings by the way muss ich dazu sagen das
jemand zu bzw für sylvester schon mal etwas ähnliches geschrieben hat, leider ist mir gerade entfallen wer das war (sorry)
Finde diese Partikelberechnungen aber super, vielleicht schreibt irgendwann mal jemand ein Tutorial darüber das ich das auch mal begreife 
_________________
 |
|
| Nach oben |
|
|
Jojo
alter Rang
Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte
|
| Verfasst am: 25.03.2007, 16:46 Titel: |
|
|
zu Mittlerer Mausbutton: epillepsie, ich komme  
sieht shcön aus
_________________
» Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
 |
|
| Nach oben |
|
|
ThePuppetMaster
Anmeldungsdatum: 18.02.2007
Beiträge: 1839
Wohnort: [JN58JR]
|
| Verfasst am: 25.03.2007, 16:51 Titel: |
|
|
Jo .. die MIttlere is schon SEHR Derbe 
MfG
TPM
_________________
[ WebFBC ][ OPS ][ ToOFlo ][ Wiemann.TV ] |
|
| Nach oben |
|
|
steff
Anmeldungsdatum: 24.03.2007
Beiträge: 11
|
| Verfasst am: 25.03.2007, 17:23 Titel: |
|
|
| Zitat: | | Jo .. die MIttlere is schon SEHR Derbe |
| Zitat: | | zu Mittlerer Mausbutton: epillepsie, ich komme |
muß Euch recht geben
hab im ersten posting eine Warnung eingefügt!
Hab den Code auch entschärft.
| Zitat: | Allerdings by the way muss ich dazu sagen das
jemand zu bzw für sylvester schon mal etwas ähnliches geschrieben hat, leider ist mir gerade entfallen wer das war |
Der Code,den Du meinst stammt von Volta.
Voltas Code ist wesentlich komplexer und raffinierter.
Gruß
steff |
|
| Nach oben |
|
|
Mao
Anmeldungsdatum: 25.09.2005
Beiträge: 4409
Wohnort: /dev/hda1
|
| Verfasst am: 25.03.2007, 18:52 Titel: |
|
|
Eine Partikelengine an sich ist nix allzu komplexes.
Du musst halt aber je nach Zweck die Farben und die Richtung beeinflussen/ändern.
Sieht aber toll aus! 
_________________
Eine handvoll Glück reicht nie für zwei.
--
 |
|
| Nach oben |
|
|
|
|
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
|
|
FAQ
Suchen
Mitgliederliste
Benutzergruppen
Registrieren
Profil
Einloggen, um private Nachrichten zu lesen
Login
