GDI: ExtFloodFill Function

[José Roca]

 
The following example demonstrates the use of the ExtFloodFill function.

Code Select Expand


' ########################################################################################
' 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
' ========================================================================================


[Patrice Terrier]

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...

Code Select Expand


'// 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