Bitmap-Explosion

Übersicht BlitzBasic Codearchiv

Neue Antwort erstellen

Travis

Betreff: Bitmap-Explosion

BeitragMi, Jan 21, 2004 19:49
Antworten mit Zitat
Benutzer-Profile anzeigen
Ein kleines Programm, das ein 24-Bit Bitmap auf dem Bildschirm explodieren lässt.

BlitzBasic: [AUSKLAPPEN]

InputFile$ = \"neu2004.bmp\"

Graphics 1024, 768, 16, 1
SetBuffer BackBuffer()
AppTitle \"BitMapExplosion\"

SeedRnd MilliSecs()


; --- Bilddatei laden
Datei = ReadFile(InputFile$)

SeekFile Datei, 18 ; Pos für Breite in Pixeln
ResX = ReadShort(Datei)

SeekFile Datei, 22 ; Pos für Höhe in Pixeln
ResY = ReadShort(Datei)

Rest = (ResX Mod 4): If Rest = 4 Then Rest = 0 ; Restbytes bis zur Teilbarkeit durch 4


Type Pixel
Field blue, green, red, x#, y#, speed#, winkel#
End Type

SeekFile Datei, 54 ; Leseposition auf Anfang der Bildinfos setzen


; --- Einzelne Pixel auslesen ---
For y = ResY To 1 Step -1
For x = 1 To ResX
p.pixel = New pixel
p\blue = ReadByte(Datei)
p\green = ReadByte(Datei)
p\red = ReadByte(Datei)
p\x# = x
p\y# = y
p\winkel# = Rnd(0,359)
p\speed# = Rnd(0.1,1)
Next
SeekFile(Datei, FilePos(Datei) + Rest) ; Zeilenende suchen
Next

CloseFile Datei


; Bild zentrieren
BildX = 1024/2 - (ResX/2)
BildY = 768/2 - (ResY/2)


; --- Bild anzeigen ---
LockBuffer BackBuffer()
For p.pixel = Each pixel
Color p\red, p\green, p\blue
If Not p\red = 248 And p\green = 0 And p\blue = 248 Then ; Transparentfarbe
Pixelfarbe=255*$1000000 + p\red*$10000 + p\green*$100 + p\blue
WritePixelFast(p\x+BildX, p\y+BildY, Pixelfarbe)
EndIf
Next
UnlockBuffer BackBuffer()

Flip
Delay 1500


Repeat
Cls


; ==== FPS-Counter ====>>
syszeit=MilliSecs()
If syszeit>fpszeit+1000
fps=fpsct : fpszeit=syszeit : fpsct=0
Else
fpsct=fpsct+1
EndIf
; ==== FPS-Counter ====>>


; --- Verlorene Pixel löschen
For p.pixel = Each pixel
If p\x#+bildx > 1023 Or p\y#+bildy > 767 Or p\y#+bildy < 0 Or p\x#+bildx < 0 Then Delete p
Next


; --- Bild anzeigen ---
LockBuffer BackBuffer()
For p.pixel = Each pixel
Color p\red, p\green, p\blue
If Not p\red = 248 And p\green = 0 And p\blue = 248 Then ; Transparentfarbe
Pixelfarbe=255*$1000000 + p\red*$10000 + p\green*$100 + p\blue
WritePixelFast(p\x+BildX, p\y+BildY, Pixelfarbe)
EndIf
Next
UnlockBuffer BackBuffer()


; --- Bild zerstreuen ---
For p.pixel = Each pixel
p\x# = p\x# + Cos(p\Winkel#) * p\speed#
p\y# = p\y# + Sin(p\Winkel#) * p\speed#
Next


; --- Anzahl der Pixel feststellen
n = 0
For p.pixel = Each pixel
n = n + 1
Next


; --- Programm verlassen
If n = 0 Then Delay 2000: End


Color 255,255,255
Text 0,0, \"Pixel: \" + n
Text 0,10, \"FPS: \" + fps


Flip 1
Until KeyHit(1)
End
www.funforge.org

Ich hasse WASD-Steuerung.

Man kann alles sagen, man muss es nur vernünftig begründen können.

Mr.Keks

BeitragMi, Jan 21, 2004 20:18
Antworten mit Zitat
Benutzer-Profile anzeigen
BlitzBasic: [AUSKLAPPEN]
Const alpha = 255*$1000000 + 0*$10000 + 0*$100 + 0 
InputFile$ = \"spheremap.bmp\"

Graphics 1024, 768, 16, 2
SetBuffer BackBuffer()
AppTitle \"BitMapExplosion\"

SeedRnd MilliSecs()


; --- Bilddatei laden
Datei = ReadFile(InputFile$)

SeekFile Datei, 18 ; Pos für Breite in Pixeln
ResX = ReadShort(Datei)

SeekFile Datei, 22 ; Pos für Höhe in Pixeln
ResY = ReadShort(Datei)

Rest = (ResX Mod 4): If Rest = 4 Then Rest = 0 ; Restbytes bis zur Teilbarkeit durch 4


Type Pixel
Field x#, y#,xs#,ys#,Col
End Type

SeekFile Datei, 54 ; Leseposition auf Anfang der Bildinfos setzen

BildX = 1024/2 - (ResX/2)
BildY = 768/2 - (ResY/2)

; --- Einzelne Pixel auslesen ---
For y = ResY To 1 Step -1
For x = 1 To ResX
p.pixel = New pixel
blue = ReadByte(Datei)
green = ReadByte(Datei)
red = ReadByte(Datei)
p\col = 255*$1000000 + red*$10000 + green*$100 + blue
p\x# = x + bildx
p\y# = y + bildy
winkel# = Rnd(0,359)
speed# = Rnd(0.1,1)
p\xs#= Cos(Winkel#) * speed#
p\ys#= Sin(Winkel#) * speed#
If p\col = alpha Then Delete p.Pixel
Next
SeekFile(Datei, FilePos(Datei) + Rest) ; Zeilenende suchen
Next

CloseFile Datei

; Bild zentrieren




; --- Bild anzeigen ---
LockBuffer BackBuffer()
For p.pixel = Each pixel
WritePixelFast(p\x, p\y, p\col)
Next
UnlockBuffer BackBuffer()

Flip
Delay 1500


Repeat
Cls


; ==== FPS-Counter ====>>
syszeit=MilliSecs()
If syszeit>fpszeit+1000
fps=fpsct : fpszeit=syszeit : fpsct=0
Else
fpsct=fpsct+1
EndIf
; ==== FPS-Counter ====>>

LockBuffer BackBuffer()
n = 0
; --- Verlorene Pixel löschen
For p.pixel = Each pixel


; --- Bild anzeigen ---

WritePixelFast(p\x, p\y, p\col)

; --- Bild zerstreuen ---
p\x# = p\x# + p\xs#
p\y# = p\y# + p\ys#
n = n + 1
If p\x > 1023 Or p\y > 767 Or p\y<0 Or p\x < 0 Then Delete p
Next
UnlockBuffer BackBuffer()

; --- Programm verlassen
If n = 0 Then Delay 2000: End


Color 255,255,255
Text 0,0, \"Pixel: \" + n
Text 0,10, \"FPS: \" + fps


Flip 0
Until KeyHit(1)
End
so ist es _etwas_ schneller Wink
MrKeks.net

Travis

BeitragMi, Jan 21, 2004 21:15
Antworten mit Zitat
Benutzer-Profile anzeigen
Das ist ja interessant. Du hast die Verschiebung der Pixel vorberechnet und dann zum bewegen nur noch addiert. Und die Farbwerte werden so auch nur einmal berechnet.

Das läuft jetzt aber um einiges schneller. Jetzt kann ich auch endlich Bilder mit 60.000 Pixel flüssig explodieren lassen. Very Happy

Danke.
www.funforge.org

Ich hasse WASD-Steuerung.

Man kann alles sagen, man muss es nur vernünftig begründen können.

Neue Antwort erstellen


Übersicht BlitzBasic Codearchiv

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group