fill tool

Blitz3D Forums/Blitz3D Programming/fill tool

Hoi

Heres many routines:

Graphics 640, 480, 32, 2
rgbalt% = 0
rgbneu% = 255*$10000 + 100*$100 + 50
Color 255, 255, 255
Oval 0, 0, 200, 200, 0
WaitKey()
LockBuffer FrontBuffer()
fuellen_rekursiv(100, 100, FrontBuffer(), 640, 480, rgbalt%, rgbneu%)
UnlockBuffer FrontBuffer()
Flip
WaitKey()
End


Function fuellen_rekursiv(x%, y%, buffer%, breite%, hoehe%, rgbalt%, rgbneu%)   
   ;x%, y% -> Koordinaten des Pixels
   ;buffer% -> Identität des Buffers, in dem gearbeitet wird
   ;breite%, hoehe% -> Größe des Buffers
   ;rgbalt% -> RGB-Wert der Farbe, die geändert werden soll
   ;rgbneu% -> RGB-Wert der Farbe, die das Pixel annehmen soll
   ;      => rgb = r*$10000 + g*$100 + b
   If (ReadPixelFast(x%, y%, buffer%)And $FFFFFF)=rgbalt% Then
      WritePixelFast(x%, y%, rgbneu%, buffer%)
      If (x% + 1)<breite% Then fuellen_rekursiv((x% + 1), y%, buffer%, breite%, hoehe%, rgbalt%, rgbneu%)
      If (x% - 1)>=0 Then fuellen_rekursiv((x% - 1), y%, buffer%, breite%, hoehe%, rgbalt%, rgbneu%)
      If (y% + 1)<hoehe% Then fuellen_rekursiv(x%, (y% + 1), buffer%, breite%, hoehe%, rgbalt%, rgbneu%)
      If (y% - 1)>=0 Then fuellen_rekursiv(x%, (y% - 1), buffer%, breite%, hoehe%, rgbalt%, rgbneu%)
   EndIf
End Function


; Kreisfunktion

Graphics 640, 480, 16, 2
AppTitle "Kreisfunktion"

Print "Press any key to start"
WaitKey

Start = MilliSecs()
 Kreis(320,240,100,1,255,0,0) ; Kreis(X, Y, Radius, Füllung, r,g,b)
Zeit = MilliSecs() - Start

Color 255,255,255
Print "Benötigte Zeit: " + Zeit + "ms"

WaitKey
End


Function Kreis(PosX, PosY, Radius, Fill, r, g, b)

 LockBuffer FrontBuffer() 
  If Fill = 0
   For grad# = 0 To 360 Step .05
    x = ((Sin (grad#) * radius) + PosX)
    y = ((Cos (grad#) * radius) + PosY)
    WritePixelFast x, y, a*$1000000 + r*$10000 + g*$100 + b
   Next
  EndIf

  If Fill = 1 Then
   For rad = radius To 0 Step -1
    For grad# = 0 To 360 Step .3
     x = ((Sin (grad#) * rad) + PosX)
     y = ((Cos (grad#) * rad) + PosY)   
     WritePixelFast x, y, a*$1000000 + r*$10000 + g*$100 + b
    Next
   Next
  EndIf
 UnlockBuffer FrontBuffer()

End Function


Graphics 800,600,32
SeedRnd MilliSecs()

Global x1,y1,NeueFarbe,AlteFarbe
Global xstart,xend,ystart,yend

xstart=100
xend=400
ystart=100
yend=400

NeueFarbe=$ff0000ff
AlteFarbe=$ffff0000

While Not KeyHit(1)

  Cls
  Color 255,0,0
  Oval 100,100,Rand(100,300),Rand(100,300),1
  Color 255,255,0
  Rect 200,90,Rand(10,60),Rand(100,400)
  h#=MilliSecs()
   LockBuffer FrontBuffer()
     Flood_Fill_Now 150,150,AlteFarbe,NeueFarbe
   UnlockBuffer FrontBuffer()
  Text 100,500,MilliSecs()-h+" ms"
  Delay 1000

Wend

WaitKey
End


Function Flood_Fill_Now (Xpos,Ypos,AlteFarbe,NeueFarbe)
     LeftX=Xpos
     RightX=Xpos
     WritePixel Xpos,Ypos,NeueFarbe
     While (LeftX>xstart)
       rgb=ReadPixel(LeftX-1,Ypos)
       If rgb=AlteFarbe LeftX=LeftX-1 WritePixel LeftX,Ypos,NeueFarbe Else Exit
     Wend

     While (RightX<xend)
        rgb=ReadPixel(RightX+1,Ypos) 
        If rgb=AlteFarbe RightX=RightX+1 WritePixel RightX,Ypos,NeueFarbe Else Exit
     Wend

    If Ypos>ystart Then
        For i=LeftX To RightX
          rgb=ReadPixel(i,Ypos-1)
          If rgb=AlteFarbe Flood_Fill_Now i,Ypos-1,AlteFarbe,NeueFarbe
        Next
    End If

    If Ypos<yend Then
        For i=LeftX To RightX
          rgb=ReadPixel(i,Ypos+1)
          If rgb=AlteFarbe Flood_Fill_Now i, Ypos+1,AlteFarbe,NeueFarbe
        Next
    End If
End Function


cu