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 |