langsamer aber interessanter Fülleffekt

Übersicht

BlitzBasic

Codearchiv

	Kabelbinder Sieger des WM-Contest 2006 Betreff: langsamer aber interessanter Fülleffekt	Mo, Apr 03, 2006 14:23 Antworten mit Zitat
Hi Ich hab eine Funktion zum Füllen von Bereichen geschrieben. Die Funktion benötigt einen array namens active(). Je nach dem, wie die aktuellen Dimensionierung von active() ist, füllt er genauer oder ungenauer. Bei hohen dimensionierungen ist das langsam, aber genau. Bei niedrigen ungenau aber schnell. Die Konstante amax gibt die Dimensionierung vor. Expeimentiert am besten mal damit herum. Code: [AUSKLAPPEN] [EINKLAPPEN] AppTitle "füllen" Graphics 640,480,16,2 Const amax = 100 Dim active(amax,3) Global num = 1 Function cell_active(cx,cy) ac = 0 For ce = 0 To amax If active(ce,3)=1 And active(ce,1)=cx And active(ce,2)=cy Then ac = 1 Exit EndIf Next Return ac End Function Function fill(xf,yf,farb) ;Farbe des pixels, der angeklickt wurde ermitteln ;Man kann sich diese Pixelfrabe wie brennmaterial vorstellen stim = ReadPixel(xf,yf) ;Brand legen active(0,1)=xf active(0,2)=yf active(0,3)=1 Repeat ;alle Brände überprüfen For i = 0 To amax ;Wenn ein Brand aktiv ist If active(i,3) = 1 Then ;Die stelle mit der gewünschten Farbe ausfüllen WritePixel active(i,1),active(i,2),farb ;Den Brand sich ausbreiten lassen: ;Wenn rechts daneben Brennmaterial ist, dort einen Brand legen a = ReadPixel(active(i,1)+1,active(i,2)) If a = stim And cell_active(active(i,1)+1,active(i,2))=0 Then active(num,3)=1 active(num,1)=active(i,1)+1 active(num,2)=active(i,2) If num = amax Then num = 0 Else num = num + 1 EndIf EndIf ;Wenn darunter Brennmaterial ist, dort einen Brand legen a = ReadPixel(active(i,1),active(i,2)+1) If a = stim And cell_active(active(i,1),active(i,2)+1)=0 Then active(num,3)=1 active(num,1)=active(i,1) active(num,2)=active(i,2)+1 If num = amax Then num = 0 Else num = num + 1 EndIf EndIf ;Wenn links daneben Brennmaterial ist, dort einen Brand legen a = ReadPixel(active(i,1)-1,active(i,2)) If a = stim And cell_active(active(i,1)-1,active(i,2))=0 Then active(num,3)=1 active(num,1)=active(i,1)-1 active(num,2)=active(i,2) If num = amax Then num = 0 Else num = num + 1 EndIf EndIf ;Wenn oben Brennmaterial ist, dort einen Brand legen a = ReadPixel(active(i,1),active(i,2)-1) If a = stim And cell_active(active(i,1),active(i,2)-1)=0 Then active(num,3)=1 active(num,1)=active(i,1) active(num,2)=active(i,2)-1 If num = amax Then num = 0 Else num = num + 1 EndIf EndIf ;Brände löschen, deren Stelle mit der gewünschten Farbe ausgefüllt sind active(i,3)=0 EndIf Next ;Aufhören, sobald alle Brände erloschen sind notfull = 0 For i = 0 To amax If active(i,3)=1 Then notfull = 1 Exit EndIf Next full = Not notfull Until full = 1 UnlockBuffer() End Function Color 0,255,0 Rect 100,100,200,200,0 fill(110,110,255*$100) WaitKey End Edit: hab die Function dokumentiert. Man kann sich diesen Fülleffekt wie ein sich ausbreitendes Feuer vorstellen. Edit: Der günstigste Wert für amax, den ich bisher gefunden hab ist 65 . Edit: 52 ist auch nicht schlecht. Edit: Oder 47 .
<Wing Avenger Download> ◊◊◊ <Macrophage Download>

Kabelbinder

Sieger des WM-Contest 2006

Betreff: langsamer aber interessanter Fülleffekt

Mo, Apr 03, 2006 14:23
Antworten mit Zitat

Hi

Ich hab eine Funktion zum Füllen von Bereichen geschrieben.
Die Funktion benötigt einen array namens active(). Je nach dem, wie die aktuellen Dimensionierung von active() ist, füllt er genauer oder ungenauer. Bei hohen dimensionierungen ist das langsam, aber genau. Bei niedrigen ungenau aber schnell.

Die Konstante amax gibt die Dimensionierung vor.
Expeimentiert am besten mal damit herum.

Code: [AUSKLAPPEN]

AppTitle "füllen"
Graphics 640,480,16,2

Const amax = 100

Dim active(amax,3)

Global num = 1

Function cell_active(cx,cy)
ac = 0
For ce = 0 To amax
If active(ce,3)=1 And active(ce,1)=cx And active(ce,2)=cy Then
ac = 1
Exit
EndIf
Next
Return ac
End Function

Function fill(xf,yf,farb)
;Farbe des pixels, der angeklickt wurde ermitteln
;Man kann sich diese Pixelfrabe wie brennmaterial vorstellen
stim = ReadPixel(xf,yf)
;Brand legen
active(0,1)=xf
active(0,2)=yf
active(0,3)=1
Repeat
;alle Brände überprüfen
For i = 0 To amax
;Wenn ein Brand aktiv ist
If active(i,3) = 1 Then
;Die stelle mit der gewünschten Farbe ausfüllen
WritePixel active(i,1),active(i,2),farb
;Den Brand sich ausbreiten lassen:
;Wenn rechts daneben Brennmaterial ist, dort einen Brand legen
a = ReadPixel(active(i,1)+1,active(i,2))
If a = stim And cell_active(active(i,1)+1,active(i,2))=0 Then
active(num,3)=1
active(num,1)=active(i,1)+1
active(num,2)=active(i,2)
If num = amax Then
num = 0
Else
num = num + 1
EndIf
EndIf
;Wenn darunter Brennmaterial ist, dort einen Brand legen
a = ReadPixel(active(i,1),active(i,2)+1)
If a = stim And cell_active(active(i,1),active(i,2)+1)=0 Then
active(num,3)=1
active(num,1)=active(i,1)
active(num,2)=active(i,2)+1
If num = amax Then
num = 0
Else
num = num + 1
EndIf
EndIf
;Wenn links daneben Brennmaterial ist, dort einen Brand legen
a = ReadPixel(active(i,1)-1,active(i,2))
If a = stim And cell_active(active(i,1)-1,active(i,2))=0 Then
active(num,3)=1
active(num,1)=active(i,1)-1
active(num,2)=active(i,2)
If num = amax Then
num = 0
Else
num = num + 1
EndIf
EndIf
;Wenn oben Brennmaterial ist, dort einen Brand legen
a = ReadPixel(active(i,1),active(i,2)-1)
If a = stim And cell_active(active(i,1),active(i,2)-1)=0 Then
active(num,3)=1
active(num,1)=active(i,1)
active(num,2)=active(i,2)-1
If num = amax Then
num = 0
Else
num = num + 1
EndIf
EndIf
;Brände löschen, deren Stelle mit der gewünschten Farbe ausgefüllt sind
active(i,3)=0
EndIf
Next
;Aufhören, sobald alle Brände erloschen sind
notfull = 0
For i = 0 To amax
If active(i,3)=1 Then
notfull = 1
Exit
EndIf
Next
full = Not notfull
Until full = 1
UnlockBuffer()
End Function

Color 0,255,0

Rect 100,100,200,200,0

fill(110,110,255*$100)

WaitKey
End

Edit: hab die Function dokumentiert. Man kann sich diesen Fülleffekt wie ein sich ausbreitendes Feuer vorstellen.

Edit: Der günstigste Wert für amax, den ich bisher gefunden hab ist 65 Laughing

.
Edit: 52 ist auch nicht schlecht. Laughing

Edit: Oder 47 Laughing