Imports System.Drawing.Imaging
Imports System.Runtime.InteropServices.Marshal
 
Public Class Form1
    Dim bmp As New Bitmap(1024, 768, PixelFormat.Format24bppRgb), g As Graphics _
      = Graphics.FromImage(bmp)
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As _
    System.EventArgs) Handles MyBase.Load
        Me.SetBounds(0, 0, 1024, 768)
        PictureBox1.SetBounds(0, 0, bmp.Width, bmp.Height)
        g.Clear(Color.Silver)
        g.DrawRectangle(Pens.Black, 100, 200, 800, 300)
        g.DrawEllipse(Pens.Blue, 300, 250, 400, 400)
        g.DrawEllipse(Pens.Green, 150, 100, 650, 500)
        PictureBox1.Image = bmp
    End Sub
 
    Private Sub PictureBox1_MouseDown(ByVal sender As Object, ByVal e As _
      System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseDown
        Dim col As Color = IIf(e.Button = Windows.Forms.MouseButtons.Left, _
        Color.Red, Color.Gold)
        Dim pcol As Color = bmp.GetPixel(e.X, e.Y)                 ' Pixelcolor 
        ' unter Mauszeiger
        If pcol.ToArgb <> col.ToArgb Then                          ' nur bei 
        ' abweichender Farbe
            Dim newcol() As Byte = {col.B, col.G, col.R}
            Dim oldcol() As Byte = {pcol.B, pcol.G, pcol.R}
            Dim rect As New Rectangle(0, 0, bmp.Width, bmp.Height)
            Dim bd As BitmapData = bmp.LockBits(rect, ImageLockMode.ReadWrite, _
              PixelFormat.Format24bppRgb)
            Dim zb As Int32 = bd.Stride                            ' Die 
            ' Zeilenbreite in Byte
            Dim fw((zb * bmp.Height) - 1) As Byte                  ' Array für 
            ' Farbwerte
            Copy(bd.Scan0, fw, 0, fw.Length)                       ' 
            ' Pixelfarben in das Array kopieren
            Dim st As New Stack(Of Int32)                          ' Stack für 
            ' die noch zu untersuchende Punkte
            Dim pos As Int32 = (e.X * 3) + (e.Y * zb)              ' Position 
            ' im Array
            Array.Copy(newcol, 0, fw, pos, 3)                      ' Farbwerte 
            ' für Punkt x,y setzen
            st.Push(pos)                                           ' Position 
            ' für Punkt x,y auf den Stack
            Dim xp, p As Int32                                     ' aktuelle 
            ' X-Position, Position
            Do
                p = st.Pop                                         ' Position 
                ' für Test auf: oben,unten,rechts,links 
                If p > zb AndAlso fw(p - zb) = oldcol(0) AndAlso fw(p - zb + _
                  1) = oldcol(1) AndAlso fw(p - zb + 2) = oldcol(2) Then
                    Array.Copy(newcol, 0, fw, p - zb, 3)           ' Farbwert 
                    ' für x,y-1 setzen
                    st.Push(p - zb)                                ' Position 
                    ' für neuen Test sichern
                End If
                If p < fw.Length - zb AndAlso fw(p + zb) = oldcol(0) AndAlso fw( _
                  p + zb + 1) = oldcol(1) AndAlso fw(p + zb + 2) = oldcol(2) _
                  Then
                    Array.Copy(newcol, 0, fw, p + zb, 3)           ' Farbwert 
                    ' für x,y+1 setzen
                    st.Push(p + zb)
                End If
                xp = p Mod zb
                If xp < zb - 3 AndAlso fw(p + 3) = oldcol(0) AndAlso fw(p + 4) _
                  = oldcol(1) AndAlso fw(p + 5) = oldcol(2) Then
                    Array.Copy(newcol, 0, fw, p + 3, 3)            ' Farbwert 
                    ' für x+1,y setzen
                    st.Push(p + 3)
                End If
                If xp > 2 AndAlso fw(p - 3) = oldcol(0) AndAlso fw(p - 2) = _
                  oldcol(1) AndAlso fw(p - 1) = oldcol(2) Then
                    Array.Copy(newcol, 0, fw, p - 3, 3)            ' Farbwert 
                    ' für x-1,y setzen
                    st.Push(p - 3)
                End If
            Loop While st.Count > 0                                ' Weiter 
            ' bis der Stack leer ist
            Copy(fw, 0, bd.Scan0, fw.Length)                       ' 
            ' Arrayinhalt zurückschreiben
            bmp.UnlockBits(bd)                                     ' Bitmap 
            ' freigeben
            PictureBox1.Invalidate()                               ' und noch 
            ' anzeigen
        End If
    End Sub
End Class