Sternenfeld-spezial von Rob von Rob
Ein interessantes Sternenfeld, dass immer von der Maus ausgeht geschrieben von Rob.
Dazu noch ein kleiner Gravitationseffekt o.Ä


[code:1:6fb7748dfd]
anzahl = 1000 ; Anzahl der Sterne
xscreen = 640 ; Auflösung des Bildschirms
yscreen = 480
xmitte = xscreen/2 ; Startpunkt der Sterne.
ymitte = yscreen/2

Graphics xscreen, yscreen, 16, 1
SetBuffer BackBuffer()


; Die Felder dimensionieren. Für jeden Stern (Punkt) eigene Werte
Dim x#(anzahl)
Dim y#(anzahl)
Dim winkel#(anzahl)
Dim speed#(anzahl)


; Allen einen Wert zuweisen
For i = 1 To anzahl
x#(i) = xmitte
y#(i) = ymitte
winkel#(i) = Rnd(1,360)
speed#(i) = Rnd(1,3)
Next



; Vorberechnete Sinus/Cosinus-Tabellen
; Ist sehr viel schneller als alles jedesmal neu auszurechnen.
Dim sinus#(360)
Dim cosinus#(360)

For i = 0 To 360
sinus#(i) = Sin(i)
cosinus#(i) = Cos(i)
Next



; Hauptschleife
Repeat
Cls



LockBuffer BackBuffer() ; Für WritePixelFast wichtig.

; Alle Sterne durchgehen
For i = 1 To anzahl
; Geschwindigkeit errechnen. Je weiter vom Mittelpunkt entfernt, desto schneller.
; Dadurch kommt erst dieser Sternen-Flug-Effekt zustande.
localspeed# = (abstand#(xmitte,ymitte,x#(i), y#(i)) / 200) * speed#(i) + 1

; Die Sternkoordinaten veränden.
x#(i) = xbewegen#(x#(i), winkel#(i), localspeed#)
y#(i) = ybewegen#(y#(i), winkel#(i), localspeed#)


; Wenn Stern am Rand, dann Werte neu berechnen und ihn zum Mittelpunkt zurücksetzen.
If x#(i) < 0 Or x#(i) > xscreen Or y#(i) < 0 Or y#(i) > yscreen Then
x#(i) = xmitte
y#(i) = ymitte
winkel#(i) = Rnd(1,360)
speed#(i) = Rnd(1,3)
EndIf

; Farbe verändern. Je schneller desto weisser
farbe = speed#(i)*100 - 55

; Sterne auf schnellstmögliche Art malen.
WritePixelFast x#(i), y#(i), rgb(farbe, farbe, farbe)


Next
UnlockBuffer BackBuffer() ; Buffer wieder Unlocken.



; Der einzige Unterschied zum ersten Sternenprogramm (neben der kleineren Auflösung):
xmitte = MouseX()
ymitte = MouseY()






Flip
Until KeyHit(1)
End







; Einene Punkt(Stern) in eine Richtung bewegen.
Function xbewegen#(x#,winkel#,speed#)
x2# = x# + Cosinus#(winkel#)*speed#
Return x2#
End Function

; Das gleiche mit y#.
Function ybewegen#(y#,winkel#,speed#)
y2# = y# + Sinus#(winkel#)*speed#
Return y2#
End Function

Function abstand#(x1#,y1#,x2#,y2#)
xhypo# = x1# - x2#
yhypo# = y1# - y2#

; Sqr = Wurzel
abstand# = Abs(Sqr((xhypo# ^ 2) + (yhypo# ^2)))
Return abstand#
End Function


; Aus RGB-Werten einen ReadPixelFast-Farbwert errechnen.
Function rgb(rot,gruen,blau)
Return blau Or (gruen Shl 8) Or (rot Shl 16)
End Function
[/code:1:6fb7748dfd]
===
meins von Rob
Das ist mein Programm. Vom Dezember 2001. Ist auch in der Downloadversion meines Kurses.
===
von Triton
habs mal editiert



Suche:
(unterstützt mySQL Wildcards ala %)
Titel:
Text:
Autor: