Code archives/Graphics/Fast Flood Fill (ProPixel Code)
This code has been declared by its author to be Public Domain code.
Download source code
| As I missed the entry for flood fill I had to start from scratch, I've run this one against the other flood fill routine and found this way to be faster. Updated: 18-11-02, Now Generically Coded. |
; Fill Routines ; Written By Paul Snart (Snarty) ; Oct 2001 ; RCol = RGB Color to Fill with ; Ax = X Start on Image to Fill ; Ay = Y Start on Image to Fill ; Image = Image to fill on Type Point Field x Field y End Type Function FloodFill(RCol,ax,ay,Image) timeit=MilliSecs() temp=CreateImage(1,1):SetBuffer ImageBuffer(temp) LockBuffer:WritePixelFast 0,0,RCol RCol=ReadPixelFast(0,0) UnlockBuffer:FreeImage Temp SetBuffer ImageBuffer(Image):LockBuffer BCol=ReadPixelFast(ax,ay) ImW=ImageWidth(Image) ImH=ImageHeight(Image) If BCol<>RCol Hlt=-1:Hlb=-1 Hrt=-1:Hrb=-1 Entrys=1 Fp.Point = New Point Fp\x=ax Fp\y=ay Repeat Fp.Point=First Point Lx=Fp\x:Rx=Fp\x+1 HitL=False:HitR=False Hlt=-1:Hlb=-1 Hrt=-1:Hrb=-1 Repeat If Lx=>0 And HitL=False CColL=ReadPixelFast(Lx,Fp\y) If CColL=BCol WritePixelFast Lx,Fp\y,RCol If Fp\y>0 CColL=ReadPixelFast(Lx,Fp\y-1) If CColL=BCol Hlt=Lx Else If Hlt<>-1 y=Fp\y-1 Fp.Point = New Point Fp\y=y:Fp\x=Hlt Hlt=-1 Fp.Point = First Point Entrys=Entrys+1 EndIf EndIf EndIf If Fp\y<ImH-1 CColL=ReadPixelFast(Lx,Fp\y+1) If CColL=BCol Hlb=Lx Else If Hlb<>-1 y=Fp\y+1 Fp.Point = New Point Fp\y=y:Fp\x=Hlb Hlb=-1 Fp.Point = First Point Entrys=Entrys+1 EndIf EndIf EndIf Lx=Lx-1 Else HitL=True If Hlt<>-1 y=Fp\y-1 Fp.Point = New Point Fp\y=y:Fp\x=Hlt Hlt=-1 Fp.Point = First Point Entrys=Entrys+1 EndIf If Hlb<>-1 y=Fp\y+1 Fp.Point = New Point Fp\y=y:Fp\x=Hlb Hlb=-1 Fp.Point = First Point Entrys=Entrys+1 EndIf EndIf Else HitL=True If Hlt<>-1 y=Fp\y-1 Fp.Point = New Point Fp\y=y:Fp\x=Hlt Hlt=-1 Fp.Point = First Point Entrys=Entrys+1 EndIf If Hlb<>-1 y=Fp\y+1 Fp.Point = New Point Fp\y=y:Fp\x=Hlb Hlb=-1 Fp.Point = First Point Entrys=Entrys+1 EndIf EndIf If Rx<=ImW-1 And HitR=False CColR=ReadPixelFast(Rx,Fp\y) If CColR=BCol WritePixelFast Rx,Fp\y,RCol If Fp\y>0 CColR=ReadPixelFast(Rx,Fp\y-1) If CColR=BCol Hrt=Rx Else If Hrt<>-1 y=Fp\y-1 Fp.Point = New Point Fp\y=y:Fp\x=Hrt Hrt=-1 Fp.Point = First Point Entrys=Entrys+1 EndIf EndIf EndIf If Fp\y<ImH-1 CColR=ReadPixelFast(Rx,Fp\y+1) If CColR=BCol Hrb=Rx Else If Hrb<>-1 y=Fp\y+1 Fp.Point = New Point Fp\y=y:Fp\x=Hrb Hrb=-1 Fp.Point = First Point Entrys=Entrys+1 EndIf EndIf EndIf Rx=Rx+1 Else HitR=True If Hrt<>-1 y=Fp\y-1 Fp.Point = New Point Fp\y=y:Fp\x=Hrt Hrt=-1 Fp.Point = First Point Entrys=Entrys+1 EndIf If Hrb<>-1 y=Fp\y+1 Fp.Point = New Point Fp\y=y:Fp\x=Hrb Hrb=-1 Fp.Point = First Point Entrys=Entrys+1 EndIf EndIf Else HitR=True If Hrt<>-1 y=Fp\y-1 Fp.Point = New Point Fp\y=y:Fp\x=Hrt Hrt=-1 Fp.Point = First Point Entrys=Entrys+1 EndIf If Hrb<>-1 y=Fp\y+1 Fp.Point = New Point Fp\y=y:Fp\x=Hrb Hrb=-1 Fp.Point = First Point Entrys=Entrys+1 EndIf EndIf Until (HitR=True And HitL=True) Or KeyHit(1) Fp.Point=First Point Delete Fp Entrys=Entrys-1 Until Entrys=False Or KeyHit(1) EndIf UnlockBuffer SetBuffer BackBuffer() mhit=False DebugLog (Float(MilliSecs()-TimeIt)/1000)+" seconds" End Function |