Flood Filling Objects with VB

Introduction

I have always loved GDI+. It has given me much joy experimenting and playing with all things graphics related. I guess it is because I come from a VB 6 background where drawing mundane things was always a great chore. Now, I try to make use of the full power of GDI+ whenever I can. Today, I will show you how to flood fill drawn objects.

What Is Flood Filling?

It is the complicated term for coloring in drawn shapes. If you are accustomed to working with CorelDRAW, Photoshop, or even Paint, you will have noticed that you can click a colour and fill the empty spaces with it. This is flood filling. Let me start.

Design

Create a new VB Windows Forms project. There is no design as such because you will create the drawings dynamically. Make sure the form is big enough so that it gives you ample space to see the drawn objects.

Code

Add a class named ARGB32 to your project and add the following code into the newly created class:

Imports System.Drawing.Imaging
Imports System.Runtime.InteropServices

Public Class ARGB32

   Public bytImage() As Byte
   Public intSize As Integer
   Public Const bytPixel As Integer = 4
   Public Const intPixel As Integer = bytPixel * 8

   ' Reference to Bitmap.
   Private bmpBitmap As Bitmap

   Public Sub New(ByVal bm As Bitmap)
      bmpBitmap = bm
   End Sub

   ' Bitmap data.
   Private bmddBitmapData As BitmapData

   Public Sub LockBitmap()
      ' Lock the bitmap data.
      Dim rectBounds As Rectangle = New Rectangle( _
         0, 0, bmpBitmap.Width, bmpBitmap.Height)
      bmddBitmapData = bmpBitmap.LockBits(rectBounds, _
         Imaging.ImageLockMode.ReadWrite, _
         Imaging.PixelFormat.Format32bppArgb)
      intSize = bmddBitmapData.Stride

      ' Allocate room 
      Dim intTotalSize As Integer = bmddBitmapData.Stride * _
         bmddBitmapData.Height
      ReDim bytImage(intTotalSize)

      ' Copy the data into the ImageBytes array.
      Marshal.Copy(bmddBitmapData.Scan0, bytImage, _
         0, intTotalSize)
   End Sub

   ' Copy the data back into the Bitmap
   ' and release resources.
   Public Sub UnlockBitmap(Optional ByVal blnSave _
      As Boolean = True)
      ' Copy the data back into the bitmap.
      If blnSave Then
         Dim total_size As Integer = bmddBitmapData.Stride * _
            bmddBitmapData.Height
         Marshal.Copy(bytImage, 0, _
            bmddBitmapData.Scan0, total_size)
      End If

      ' Unlock the bitmap.
      bmpBitmap.UnlockBits(bmddBitmapData)

      ' Release resources.
      bytImage = Nothing
      bmddBitmapData = Nothing
   End Sub
End Class

The purpose of this class is to create and save a reference to a bitmap. This bitmap object will be the one that will ultimately hold the in-memory image of the colored-in images(s).

Add the next class (Fill):

Public Class Fill
   Public Xmin As Integer
   Public Xmax As Integer
   Public Y As Integer
   Public Sub New(ByVal intXMin As Integer, _
         ByVal intXMax As Integer, _
         ByVal intY As Integer)
      Xmin = intXMin
      Xmax = intXMax
      Y = intY
   End Sub

   ' Color the pixels in the run.
   Public Sub SetColor(ByVal rgbBytes As ARGB32, _
         ByVal bytR As Byte, ByVal bytG As Byte, _
         ByVal bytB As Byte)
      Dim pix As Integer = _
         Y * rgbBytes.intSize + _
         Xmin * rgbBytes.bytPixel
      For x As Integer = Xmin To Xmax
         rgbBytes.bytImage(pix) = bytB
         rgbBytes.bytImage(pix + 1) = bytG
         rgbBytes.bytImage(pix + 2) = bytR
         pix += rgbBytes.bytPixel
         Next x
   End Sub
End Class

This class handles the physical filling of the drawn objects.

Add a Module to your project and add the following code:

Module Flood

   ' See if this point has the target color.
   Private Function PointHasColor(ByVal bm_bytes As ARGB32, _
         ByVal x As Integer, ByVal y As Integer, _
         ByVal target_r As Byte, ByVal target_g As Byte, _
         ByVal target_b As Byte) As Boolean
      Dim pix As Integer = y * bm_bytes.intSize + x * _
         bm_bytes.bytPixel
      Dim b As Byte = bm_bytes.bytImage(pix)
      Dim g As Byte = bm_bytes.bytImage(pix + 1)
      Dim r As Byte = bm_bytes.bytImage(pix + 2)

      Return _
         (r = target_r) AndAlso _
         (g = target_g) AndAlso _
         (b = target_b)
   End Function


   ' Flood the area at this point.
   Public Sub UnsafeFloodFillRuns(ByVal bm As Bitmap, _
         ByVal x As Integer, ByVal y As Integer, _
         ByVal new_color As Color)
      ' Get the old and new colors' components.
      Dim old_r As Byte = bm.GetPixel(x, y).R
      Dim old_g As Byte = bm.GetPixel(x, y).G
      Dim old_b As Byte = bm.GetPixel(x, y).B

      Dim new_r As Byte = new_color.R
      Dim new_g As Byte = new_color.G
      Dim new_b As Byte = new_color.B

      ' Make a BitmapBytesARGB32 object.
      Dim bm_bytes As New ARGB32(bm)

      ' Lock the bitmap.
      bm_bytes.LockBitmap()

      ' Find and color the initial run.
      Dim initial_run As Fill = MakeRun(bm_bytes, bm.Width, _
         bm.Height, x, y, old_r, old_g, old_b
      initial_run.SetColor(bm_bytes, new_r, new_g, new_b)

       ' Start with the initial run in the stack.
      Dim runs As New Stack(1000)
      runs.Push(initial_run)

      ' While the stack is not empty, process a run.
      Dim pix As Integer
      Do While runs.Count > 0
         ' Get the next run.
         Dim the_run As Fill = DirectCast(runs.Pop(), Fill)
         y = the_run.Y

         ' Look for runs above.
         If y > 0 Then
            Dim x0 As Integer = the_run.Xmi
            Do
               If x0 > the_run.Xmax Then Exit Do
               ' See if this point has the old color.
               If PointHasColor(bm_bytes, x0, y - 1, old_r, _
                     old_g, old_b) Then
                  ' Make and color a run here.
                  Dim new_run As Fill = MakeRun(bm_bytes, _
                     bm.Width, bm.Height, x0, y - 1, old_r, _
                     old_g, old_b)
                  new_run.SetColor(bm_bytes, new_r, new_g, new_b)
                  runs.Push(new_run)

                  ' Skip one pixel beyond the end of this run.
                  x0 = new_run.Xmax + 2
               Else
                  x0 += 1
               End If
            Loop
         End If

         ' Look for runs below.
         If y < bm.Height - 1 Then
            Dim x0 As Integer = the_run.Xmin
            Do
               If x0 > the_run.Xmax Then Exit Do
               ' See if this point has the old color.
               If PointHasColor(bm_bytes, x0, y + 1, old_r, _
                     old_g, old_b) Then
                  ' Make and color a run here.
                  Dim new_run As Fill = MakeRun(bm_bytes, _
                     bm.Width, bm.Height, x0, y + 1, _
                     old_r, old_g, old_b)
                  new_run.SetColor(bm_bytes, new_r, new_g, new_b)
                  runs.Push(new_run)

                  ' Skip one pixel beyond the end of this run.
                  x0 = new_run.Xmax + 2
               Else
                  x0 += 1
               End If
            Loop
         End If
      Loop

      ' Unlock the bitmap.
      bm_bytes.UnlockBitmap()
   End Sub

   ' Find the run at this point.
   Private Function MakeRun(ByVal bm_bytes As ARGB32, _
         ByVal wid As Integer, ByVal hgt As Integer, _
         ByVal x As Integer, ByVal y As Integer, _
         ByVal old_r As Byte, ByVal old_g As Byte, _
         ByVal old_b As Byte) As Fill
      Dim x0 As Integer = x
      Do
         If x0 < 0 Then Exit Do
         If Not PointHasColor(bm_bytes, x0, y, old_r, _
               old_g, old_b) Then Exit Do
            x0 -= 1
      Loop
      Dim x1 As Integer = x
      Do
         If x1 >= wid Then Exit Do
         If Not PointHasColor(bm_bytes, x1, y, old_r, _
            old_g, old_b) Then Exit Do
         x1 += 1
      Loop
      Return New Fill(x0 + 1, x1 - 1, y)
   End Function

End Module

Now that everything is set up, we obviously need some objects to fill in. Add the necessary Namespaces:

Imports System.Math
Imports System.Drawing.Drawing2D

Add the rest of the code:

   Private bmpBitmap As Bitmap
      ' Draw random circles.
      Private Sub Form1_Load(ByVal sender As Object, _
           ByVal e As System.EventArgs) Handles MyBase.Load
         DrawBitmap()
      End Sub
      Private Sub Form1_Resize(ByVal sender As Object, _
            ByVal e As System.EventArgs) Handles MyBase.Resize
         DrawBitmap()
         Me.Invalidate()
      End Sub
      Private Sub DrawBitmap()
         If Me.ClientRectangle.Width < 10 OrElse _
            Me.ClientRectangle.Height < 10 Then Exit Sub

         bmpBitmap = New Bitmap(Me.ClientRectangle.Width, _
            Me.ClientRectangle.Height)
         Dim gr As Graphics = Graphics.FromImage(bmpBitmap)
         gr.Clear(Color.White)

         Dim rnd As New Random
         Dim max_r As Integer = Min(Me.ClientRectangle.Width, _
            Me.ClientRectangle.Height) \ 3
         Dim min_r As Integer = max_r \ 4
         For i As Integer = 1 To 20
            Dim r As Integer = rnd.Next(min_r, max_r)
            Dim x As Integer = rnd.Next(min_r, _
               Me.ClientRectangle.Width - min_r)
            Dim y As Integer = rnd.Next(min_r, _
            Me.ClientRectangle.Height - min_r)
            gr.DrawEllipse(Pens.Black, x - r, y - r, _
               2 * r, 2 * r)
         Next i
         gr.Dispose()
      End Sub

      ' Display the picture.
      Private Sub Form1_Paint(ByVal sender As Object, _
            ByVal e As System.Windows.Forms.PaintEventArgs) _
            Handles MyBase.Paint
         e.Graphics.DrawImage(bmpBitmap, 0, 0)
      End Sub

      ' Flood fill the clicked area.
      Private Sub Form1_MouseDown(ByVal sender As Object, _
            ByVal e As System.Windows.Forms.MouseEventArgs) _
            Handles MyBase.MouseDown
         ' Pick a random new color.
         Dim rnd As New Random
         Dim old_color As Color = bmpBitmap.GetPixel(e.X, e.Y)
         Dim new_color As Color
         Do
            Dim qb_clr As Integer = QBColor(rnd.Next(1, 16))
            new_color = Color.FromArgb(qb_clr Or &HFF000000)
         Loop Until Not (new_color.Equals(old_color))

         ' Flood.
         Dim start_time As Date = Now
         If e.Button = MouseButtons.Left Then
            UnsafeFloodFillRuns(bmpBitmap, e.X, e.Y, new_color)

         End If
         Dim elapsed_time As TimeSpan = Now.Subtract(start_time)
         Debug.WriteLine(elapsed_time.TotalSeconds.ToString("0.00") _
            & " seconds")

         ' Redraw.
         Me.Invalidate()
      End Sub

In Form_Load, you create circle shapes randomly. Inside The MouseDown event, you randomly choose a colour and fill the area that was clicked upon.

Conclusion

Thank you for reading today’s article. I have attached a working sample with this article. Until we meet again, cheers!



Related Articles

Downloads

Comments

  • Graphics

    Posted by pradeep on 05/19/2015 10:17pm

    It works without any hitch.Program is self explanatory. I would like to have program in which one can map (with latitude and longitude ) on the form. so that one can put the data at required pixel which is reference point of latitude and longitude. Thanks in advance

    Reply
Leave a Comment
  • Your email address will not be published. All fields are required.

Top White Papers and Webcasts

Most Popular Programming Stories

More for Developers

RSS Feeds

Thanks for your registration, follow us on our social networks to keep up-to-date