Löwenherz
Anmeldungsdatum: 25.08.2008
Beiträge: 86
Wohnort: auf einer sonnigen Insel :)
|
 Verfasst am: 20.08.2009, 21:01 Titel: partikel übung, teil eins :) |
 |
|
hallo zusammen 
habe eine kleine Partikel Übung gemacht, die wie folgt aussieht...
| Code: |
''-- christians partikel übung, part one, 20.august 2009
Const maxpartikel=1500
Const screenw=800
Const screenh=600
Declare Sub generierepartikels()
Declare Sub berechnepartikels()
Declare Sub zeichnepartikels()
Declare Sub erzeugefarbe()
Declare Sub erzeugesterne()
Declare Sub zeichnesterne()
Dim shared gravitation As Single =0.02
Dim shared posx As Integer
Dim shared posy As Integer
Dim shared buttons As Integer
Dim shared farbe As Integer
Dim shared farbe_rot As Integer
Dim shared farbe_gruen As Integer
Dim shared farbe_blau As Integer=255
Dim shared farbefaktor As Integer =15
Dim shared zaehler As Integer
Dim shared mousestatus As Integer
Dim shared farbstatus As Integer
Type tsterne
x As Integer
y As Integer
End Type
Type tpartikel
x As Single
y As Single
dx As Single
dy As Single
groesse As Integer
winkel As Single
geschwindigkeit As Single
farbe As Integer
End Type
Dim shared sterne(100) As tsterne
Dim shared partikel(maxpartikel) As tpartikel
Screen 19, 16, 2, 1
SCREENSET 1, 0
Randomize Timer
Dim Im As Byte Ptr
Im = Imagecreate(SCREENW, SCREENH, RGB(5, 5, 5))
erzeugesterne()
Do
GETMOUSE posx, posy,, buttons
If buttons=0 Then
mousestatus=0
Endif
If mousestatus=0 Then
If Bit(buttons, 0) Then
generierepartikels()
mousestatus=1
farbstatus=1
Endif
If Bit(buttons, 2) Then
generierepartikels()
mousestatus=1
farbstatus=2
Endif
If Bit(buttons, 1) Then
generierepartikels()
mousestatus=1
farbstatus=3
Endif
Endif
zeichnesterne()
berechnepartikels()
zeichnepartikels()
Put (0,0),im,alpha,5
Locate 1,1,0
Print "beruehre LinkeMouse/RechteMouse/MittelMouse"
SCREENCOPY
Loop Until Inkey$=Chr$(27)
Imagedestroy Im
End
Sub generierepartikels()
Dim x As Integer
For x= 0 To maxpartikel
erzeugefarbe()
partikel(x).farbe=rgb(farbe_rot,farbe_gruen,farbe_blau)
partikel(x).x=posx
partikel(x).y=posy
partikel(x).groesse=Rnd*3+1
partikel(x).winkel=(Rnd*360)*0.017453293
partikel(x).geschwindigkeit=Rnd*5+0.1
partikel(x).dx=Sin(partikel(x).winkel)*partikel(x).geschwindigkeit
partikel(x).dy=Cos(partikel(x).winkel)*partikel(x).geschwindigkeit
Next
End Sub
Sub berechnepartikels()
Dim x As Integer
If farbstatus= 1 Then
erzeugefarbe()
farbe=rgb(farbe_rot,farbe_gruen,farbe_blau)
Endif
For x= 0 To maxpartikel
If farbstatus= 2 Then
erzeugefarbe()
farbe=rgb(farbe_rot,farbe_gruen,farbe_blau)
partikel(x).groesse=1
Endif
If farbstatus<3 Then
partikel(x).farbe=farbe
Endif
partikel(x).x=partikel(x).x+partikel(x).dx
partikel(x).y=partikel(x).y+partikel(x).dy
partikel(x).dy=partikel(x).dy+gravitation
Next
End Sub
Sub zeichnepartikels()
Dim x As Integer
For x= 0 To maxpartikel
Circle (partikel(x).x,partikel(x).y),partikel(x).groesse,partikel(x).farbe,,,,F
Next
End Sub
Sub erzeugefarbe()
If farbe_rot<255 And farbe_gruen =0 And farbe_blau =255 Then farbe_rot=farbe_rot+farbefaktor
If farbe_rot=255 And farbe_gruen=0 And farbe_blau >0 Then farbe_blau=farbe_blau-farbefaktor
If farbe_rot=255 And farbe_gruen < 255 And farbe_blau =0 Then farbe_gruen=farbe_gruen+farbefaktor
If farbe_rot>0 And farbe_gruen = 255 And farbe_blau =0 Then farbe_rot=farbe_rot-farbefaktor
If farbe_rot=0 And farbe_gruen = 255 And farbe_blau <255 Then farbe_blau=farbe_blau+farbefaktor
If farbe_rot=0 And farbe_gruen >0 And farbe_blau =255 Then farbe_gruen=farbe_gruen-farbefaktor
End Sub
Sub zeichnesterne()
Dim c As Integer
For zaehler =0 To 100
c=Rnd*255
If c>127 Then
Circle (sterne(zaehler).x,sterne(zaehler).y),Rnd*2,rgb(c,c,c),,,,F
else
Circle (sterne(zaehler).x,sterne(zaehler).y),Rnd*4,rgb(c,c,c)
Endif
Next
End Sub
Sub erzeugesterne()
Dim c As Integer
For zaehler =0 To 100
sterne(zaehler).x=Rnd*SCREENW
sterne(zaehler).y=Rnd*SCREENH
Next
End Sub
|
habe ein paar Codezeilen von einer alten partikelübung von mir und von einer unfertigen FB übung abgeändert. Ist schon ein Jahr her. Aber heute kapiere ich das erst wie das mit den Partikeln läuft. Ist noch recht einfach gehalten, aber funzt
Info: die Aktion müßte mit rechter, linker, mittel Mousetaste gehen. Habe aber nur eine Zweimaustaste, ähem, räusper. 
beste sonnige Grüße, Christian (löwenherz)
_________________
Das Leben ist wie eine Pralinenschachtel, man weiß nie, was dort drinnen für tolle wie böse Überraschungen stecken |
|
FAQ
Suchen
Mitgliederliste
Benutzergruppen
Registrieren
Profil
Einloggen, um private Nachrichten zu lesen
Login
