List
Add
Info
Contact
Stats
To edit this entry i need username and password!
Fields marked * are required!
* Username:
* Password:
Type:
Sourcecode (WITHOUT BBCode support)
Name:
blitz.bas
* Data:
(max. 1 MB)
Available TAG's (new window)
'=[ Parameter ]= '[RI] = Rechen-Intensiv '(Wirkt sich in verbindung mit anderen [RI]s EXTREM!!! auf die Rechenzeit aus) 'Bildschirmbreite Dim SWidth as UInteger = 500 'Sparc Höhe (Wie weit sich von Sparc zu Sparc der "Beam" verdehnen darf) Dim XHight as UInteger = 30 '[RI] Sparc Schritte (Nach wie vielen Schritten ein Sparc ausbrechen soll Dim Sparcs as UInteger = 25 '[RI] Sparc Ausbrüche (Wie viele Sparcs ausbrechen sollen) Dim SparcsBreak as UInteger = 2 '[RI] Sparc Ausbruchs Höhe / Länge (Wei weit ein ausgebrochener Sparc laufen soll) Dim SparcsBreakLen as UInteger = 1000 'Sparc Ausbruchs Breite (Wie weit der Sparc seine richtung (Links/Rechts) ändern darf) Dim SparcsBreakW as UInteger = 5 'Korrektur der Sparc Ausbruchsrichtung (Korriegiert Laufbahn des Sparcs zum ausbruchspunkt zurück) Dim SparcCorrection as UInteger = 12 'Aktiviert den interaktiven Maus-Sensor Dim Sensing as UByte = 0 'Farben Dim RCol as UInteger = 100 Dim GCol as UInteger = 100 Dim BCol as UInteger = 255 Dim C as UInteger Dim ZY as UInteger Dim LY as UInteger = XHight / 2 Dim TX as UInteger Dim TY as UInteger Dim LTX as UInteger Dim LTY as UInteger Dim XCV1 as UInteger Dim XCV2 as UInteger Dim XCV3 as UInteger Dim YScreen as UInteger = 100 Dim XOffSet as UInteger = 10 Dim YOffSet as UInteger = 100 Dim MouseX as Integer Dim MouseY as Integer Dim MouseXL as Integer Dim MouseYL as Integer screenres SWidth, 400, 24 Randomize Timer Do If Sensing = 1 Then If GetMouse(MouseX, MouseY) = 0 Then XHight = Abs(MouseYL - MouseYL) SparcsBreakLen = (Abs(MouseXL - MouseXL) + 1) * 300 MouseXL = MouseX MouseYL = MouseY End If End If cls For X as UInteger = 1 to SWidth - XOffSet step Sparcs C = Int((Rnd * XHight) + 1) - (XHight / 2) If ZY + C > YScreen Then ZY -= C Else: ZY += C End If For Y as UInteger = 1 to Sparcs ZY += Int((Rnd * 3) - 1) PSet(XOffSet + X + Y, YOffSet + ZY), RGB(RCol, GCol, BCol) ' For Z as UInteger = 1 to 10 ' PSet(XOffSet + X + Y + Int((Rnd * Sparcs) - (Sparcs / 2)), YOffSet + ZY + Int((Rnd * 3) - 1)), RGB(100, 100, 255) ' Next Next LY = ZY For Y as UInteger = 1 to SparcsBreak TY = LY TX = X For Z as UInteger = 1 to SparcsBreakLen TX += Int((Rnd * SparcsBreakW) - Fix(SparcsBreakW / 2)) TY += Int((Rnd * 3) - 1) XCV1 = RCol - ((RCol / SparcsBreakLen) * Z) XCV2 = GCol - ((GCol / SparcsBreakLen) * Z) XCV3 = BCol - ((BCol / SparcsBreakLen) * Z) PSet(XOffSet + TX, YOffSet + TY), RGB(XCV1, XCV2, XCV3) ' Line(XOffSet + LTX, YOffSet + LTY)-(XOffSet + TX, YOffSet + TY), RGB(XCV, XCV, 255 - ((255 / SparcsBreakLen) * Z)) LTX = TX LTY = TY If TX < X Then TX += Fix(Int(Rnd * SparcCorrection) / 10) Else: TX -= Fix(Int(Rnd * SparcCorrection) / 10) End if Next Next Next Sleep '1000, 1 Loop until InKey() = Chr(27) screen 0 End
Filetype / Highlight:
freeBASIC
Action: