The following example demonstrates the use of the ExtFloodFill function.
' ########################################################################################
' The following example demonstrates the use of the ExtFloodFill function.
' ########################################################################################
' CSED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
%UNICODE = 1
' // Include files for external files
#INCLUDE ONCE "CWindow.inc" ' // CWindow class
' ========================================================================================
' Draws filled boxes
' ========================================================================================
SUB DrawFilledBoxes (BYVAL hDC AS LONG)
LOCAL i AS LONG
LOCAL x AS LONG
LOCAL hPen AS LONG
LOCAL hOldPen AS LONG
LOCAL hBrush AS LONG
LOCAL hOldBrush AS LONG
' // Create a pen: style, width, color
hPen = CreatePen (%PS_SOLID, 0, RGB(000, 000, 000))
' // Select the pen (use this color for now) and save old one
hOldPen = SelectObject(hDC, hPen)
' // Draw the boxes
FOR i = 0 TO 7
FOR x = 0 TO 9
Rectangle hDC, x * 50, i * 50, (x * 50) + 49, (i * 50) + 49
NEXT
NEXT
' // Fill the boxes with color
FOR i = 0 TO 7
FOR x = 0 TO 9
hBrush = CreateSolidBrush(RGB(0, 0, x * i * 10))
hOldBrush = SelectObject(hDC, hBrush)
ExtFloodFill hDC, (x * 50) + 25, (i * 50) + 25, RGB(255, 255, 255), %FLOODFILLSURFACE
SelectObject hDC, hOldBrush
DeleteObject hBrush
NEXT
NEXT
' // Select the old pen
SelectObject hDC, hOldPen
' // Delete the pen
DeleteObject hPen
END SUB
' ========================================================================================
' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS WSTRINGZ PTR, BYVAL nCmdShow AS LONG) AS LONG
' // Create an instance of the class
LOCAL pWindow AS IWindow
pWindow = CLASS "CWindow"
IF ISNOTHING(pWindow) THEN EXIT FUNCTION
' // Create the main window
' // Note: CW_USEDEFAULT is used as the default value When passing 0's as the width and height
pWindow.CreateWindow(%NULL, "ExtFloodFill Demo", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
' // Change the background color
pWindow.Brush = %COLOR_WINDOW + 1
' // Set the client size
pWindow.SetClientSize 500, 320
' // Center the window
pWindow.CenterWindow
' // Default message pump (you can replace it with your own)
pWindow.DoEvents(nCmdShow)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Main window procedure
' ========================================================================================
FUNCTION WindowProc (BYVAL hwnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
LOCAL rc AS RECT
LOCAL hDC AS DWORD
LOCAL ps AS PAINTSTRUCT
LOCAL hBitmap AS DWORD
LOCAL hOldBitmap AS DWORD
LOCAL hTmpDC AS DWORD
STATIC hMemDC AS DWORD
SELECT CASE wMsg
CASE %WM_CREATE
GetClientRect hwnd, rc
hTmpDC = GetDC(%NULL)
hMemDC = CreateCompatibleDC(hTmpDC)
hBitmap = CreateCompatibleBitmap(hTmpDC, rc.nRight - rc.nLeft, rc.nBottom - rc.nTop)
hOldBitmap = SelectObject(hMemDC, hBitmap)
FillRect hMemDC, rc, GetStockObject(%WHITE_BRUSH)
DrawFilledBoxes hMemDC
ReleaseDC %NULL, hTmpDC
EXIT FUNCTION
CASE %WM_COMMAND
SELECT CASE LO(WORD, wParam)
CASE %IDCANCEL
IF HI(WORD, wParam) = %BN_CLICKED THEN
SendMessage hwnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
END SELECT
EXIT FUNCTION
CASE %WM_PAINT
hDC = BeginPaint(hWnd, ps)
BitBlt ps.hDC, 0, 0, ps.rcPaint.nRight, ps.rcPaint.nBottom, hMemDC, 0, 0, %SRCCOPY
EndPaint(hWnd, ps)
EXIT FUNCTION
CASE %WM_DESTROY
SelectObject hMemDC, hOldBitmap
DeleteObject hBitmap
DeleteDC hMemDC
PostQuitMessage 0
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProc(hwnd, wMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
The Best algorithm to perform real floodfill is LinearFloodfill.
However rather complex to program.
Here is the one i wrote several years ago for my own painting tools.
Note: This function peforms the core flood fill using diagonal detection along with the standard vertical and horizontal detection, it also allows you to setup the floodfill tolerance.
Note also the liberal size of the STACK being used, because of recursivity...
'// PowerBASIC Linearfloodfill written by Patrice Terrier for ZAP Picture Tool and zDraw.
'
#STACK 8388608 ' (8Mb)
GLOBAL Colr() AS DWORD, NewFillColor AS DWORD, xFillWidth AS LONG, yFillHeight AS LONG
GLOBAL FillTolerance AS LONG, FillLr AS BYTE, FillHr AS BYTE, FillLg AS BYTE, FillHg AS BYTE, FillLb AS BYTE, FillHb AS BYTE
GLOBAL UseFloodFill4 AS LONG, FloodCount AS LONG
SUB FloodBoxProcData(Tolerance&, Choice&, UseFloodFill&, UseTransparent&, BYVAL RW&)
STATIC sTolerance&, sChoice&, sUseFloodFill&, sUseTransparent&
IF RW& THEN
sTolerance& = Tolerance&
sChoice& = Choice&
sUseFloodFill& = UseFloodFill&
sUseTransparent& = UseTransparent&
ELSE
Tolerance& = sTolerance&
Choice& = sChoice&
UseFloodFill& = sUseFloodFill&
UseTransparent& = sUseTransparent&
END IF
END SUB
SUB LinearFlood (BYVAL hDC AS LONG, BYVAL x AS LONG, BYVAL y AS LONG, BYVAL FillColor AS LONG, BYVAL xWidth AS LONG, BYVAL yHeight AS LONG, U AS ZUNDO)
CALL FloodBoxProcData(Tolerance&, 0, UseFloodFill&, UseTransparent&, 0)
' Must check the temp U.tFlag and NOT the global UseTransparent& flag
Item& = zItem(U.hWnd)
IF U.tFlag AND Item& > 1 THEN FillColor = %TRANSCOLOR
WasFillColor& = FillColor
SeedColor& = GetPixel(hDC, x, y): IF SeedColor& = -1 THEN EXIT SUB ' %CLR_INVALID
WasSeedColor& = zcColorARGB(255, SeedColor&)
CheckTolerance:
CALL SplitColorARGB(WasSeedColor&, A?, R?, G?, B?)
FillTolerance = CLNG(2.55 * Tolerance&): IF FillTolerance THEN FillTolerance = (FillTolerance + 1) \ 2
FillLr? = MAX&(CLNG(R? - FillTolerance), 0): FillHr? = MIN&(CLNG(R? + FillTolerance), 255)
FillLg? = MAX&(CLNG(G? - FillTolerance), 0): FillHg? = MIN&(CLNG(G? + FillTolerance), 255)
FillLb? = MAX&(CLNG(B? - FillTolerance), 0): FillHb? = MIN&(CLNG(B? + FillTolerance), 255)
NewFillColor = zcColorARGB(255, FillColor)
CALL SplitColorARGB(NewFillColor, A?, R?, G?, B?)
' Make sure FillColor is not in the range of the SeedColor& tolerance
IF B? >= FillLb AND B? <= FillHb THEN
IF G? >= FillLg AND G? <= FillHg THEN
IF R? >= FillLr AND R? <= FillHr THEN FillColor = SeedColor&
END IF
END IF
IF FillColor = SeedColor& AND Tolerance& > 0 THEN
Tolerance& = Tolerance& - 1: FillColor = WasFillColor&
GOTO CheckTolerance
END IF
IF FillColor = SeedColor& THEN
IF zcOsversion < 600 THEN CALL WinBeep(2000,200)
EXIT SUB
END IF
LOCAL dwp AS DWORD PTR
WasCursor& = zcCursorWait
'// CALL SaveRestore(%SAVE, U)
DIM bm AS BITMAP
DIM bmi AS BITMAPINFO
bmi.bmiHeader.biSize = SIZEOF(bmi.bmiHeader)
bmi.bmiHeader.biWidth = xWidth
bmi.bmiHeader.biHeight = yHeight
bmi.bmiHeader.biPlanes = 1
bmi.bmiHeader.biBitCount = 32
bmi.bmiHeader.biCompression = %BI_RGB
hTmpDC& = CreateCompatibleDC(hDC)
hDIB& = CreateDIBSection(hTmpDC&, bmi, %DIB_RGB_COLORS, 0, 0, 0)
CALL SelectObject(hTmpDC&, hDIB&)
CALL BitBlt(hTmpDC&, 0, 0, xWidth, yHeight, hDC&, 0, 0, %SRCCOPY)
CALL GetObject(hDIB&, SIZEOF(bm), bm)
IF UseFloodFill& = 1 THEN UseFloodFill4 = -1 ELSE UseFloodFill4 = 0
' IF Tolerance& > 50 THEN UseFloodFill4 = -1
FloodCount = 0
xFillWidth = xWidth
yFillHeight = yHeight
dwp = bm.bmBits
REDIM Colr(xWidth - 1, yHeight - 1) AS DWORD AT dwp
CALL LinearFloodFill8(x, y)
IF U.tFlag AND Item& > 1 THEN
' Compute unique color number
ColorCount& = 0
DIM C(524287) AS LONG ' 524287 * 8 bits = room for 16777216 colors
DIM pBits AS BYTE PTR
pBits = bm.bmBits
FOR Y& = yHeight - 1 TO 0 STEP - 1
FOR X& = 0 TO xWidth - 1
Colr& = RGB(@pBits[2], @pBits[1], @pBits[0])
IF BIT(C(0), Colr&) = 0 THEN BIT SET C(0), Colr&: INCR ColorCount&
pBits = pBits + 4
NEXT
NEXT
ERASE C()
IF ColorCount& = 1 THEN U.tFlag = 255
END IF
CALL BitBlt(hDC&, 0, 0, xWidth, yHeight, hTmpDC&, 0, 0, %SRCCOPY)
CALL DeleteDC(hTmpDC&)
CALL DeleteObject(hDIB&)
ERASE Colr()
CALL SetCursor(WasCursor&)
END SUB
' This function peforms the core flood fill using diagonal detection along with
' the standard vertical and horizontal detection
SUB LinearFloodFill8(x AS LONG, y AS LONG)
LOCAL LFillLoc AS LONG, RFillLoc AS LONG, I AS LONG
' LOCAL cb AS COLORBYTES
LOCAL xx AS LONG, yy AS LONG
CALL apiSleep(0)
INCR FloodCount: IF FloodCount > 10000 THEN EXIT SUB
Uy& = UBOUND(Colr(2))
LFillLoc = x
DoFillLeft:
Colr(LFillLoc, Uy& - y) = NewFillColor
xx = LFillLoc - 1: yy = y
IF xx > - 1 THEN
GOSUB CheckFillPixel: IF PixOk& THEN DECR LFillLoc: GOTO DoFillLeft
END IF
RFillLoc = x
DoFillRight:
Colr(RFillLoc, Uy& - y) = NewFillColor
xx = RFillLoc + 1: yy = y
IF xx < xFillWidth THEN
GOSUB CheckFillPixel: IF PixOk& THEN INCR RFillLoc: GOTO DoFillRight
END IF
FOR I = LFillLoc TO RFillLoc
' START LOOP UPWARDS
' if we're not above the top of the bitmap
' and the pixel above this one is within the color tolerance
' START LOOP DOWNWARDS
IF y - 1 > -1 THEN
' UP
xx = I: yy = y - 1: GOSUB CheckFillPixel: IF PixOk& THEN CALL LinearFloodFill8(xx, yy)
IF UseFloodFill4 = 0 THEN
' UP-LEFT
xx = I - 1: yy = y - 1: IF xx > -1 THEN GOSUB CheckFillPixel: IF PixOk& THEN CALL LinearFloodFill8(xx, yy)
' UP-RIGHT
xx = I + 1: yy = y - 1: IF xx < xFillWidth THEN GOSUB CheckFillPixel: IF PixOk& THEN CALL LinearFloodFill8(xx, yy)
END IF
END IF
IF y + 1 < yFillHeight THEN
' DOWN
xx = I: yy = y + 1: GOSUB CheckFillPixel: IF PixOk& THEN CALL LinearFloodFill8(xx, yy)
IF UseFloodFill4 = 0 THEN
' DOWN-LEFT
xx = I - 1: yy = y + 1: IF xx> -1 THEN GOSUB CheckFillPixel: IF PixOk& THEN CALL LinearFloodFill8(xx, yy)
' UP-RIGHT
xx = I + 1: yy = y + 1: IF xx < xFillWidth THEN GOSUB CheckFillPixel: IF PixOk& THEN CALL LinearFloodFill8(xx, yy)
END IF
END IF
NEXT
EXIT SUB
CheckFillPixel:
PixOk& = 0
REDIM cb(0) AS COLORBYTES AT VARPTR(Colr(xx, Uy& - yy))
IF cb(0).B < FillLb OR cb(0).B > FillHb THEN RETURN
IF cb(0).G < FillLg OR cb(0).G > FillHg THEN RETURN
IF cb(0).R < FillLr OR cb(0).R > FillHr THEN RETURN
PixOk& = -1
RETURN
END SUB