Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0754: FloodFill-Algorithmus

VB 5/6-Tipp 0754: FloodFill-Algorithmus

 von Dario

Schwierigkeitsgrad:

Verwendete API-Aufrufe: Sleep

Download: Download des Beispielprojektes [2,76 KB]

' Dieser Quellcode stammt von http://www.activevb.de
' und kann frei verwendet werden. Für eventuelle Schäden
' wird nicht gehaftet.
' Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
' Ansonsten viel Spaß und Erfolg mit diesem Source!
' ------------- Anfang Projektdatei Projekt1.vbp -------------
' --------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Kontrollkästchen-Steuerelement "chkStyle"
' Steuerelement: Bildfeld-Steuerelement "Pixel" (Index von 0 bis 0)
Option Explicit

' Für die Animation
Private Declare Sub Sleep Lib "kernel32" ( _
                    ByVal dwMilliseconds As Long)
                    
Private Sub Form_Load()

    Call InitializeForm
    
End Sub

' Form einrichten
Public Sub InitializeForm()

    Dim x As Long, y As Long, cnt As Long
    
    Call Randomize
    
    For y = 0 To 19
        For x = 0 To 19
        
            If cnt <> 0 Then Call Load(Pixel(cnt))
            
            With Pixel(cnt)
            
                .Visible = True
                .Left = 200 * x
                .Top = 200 * y
                
            End With
            
            mPixel(x, y) = IIf(Int(Rnd * 100) Mod 3 = 0, vbBlack, vbWhite)
            cnt = cnt + 1
            
        Next x
    Next y
    
End Sub

' Vorgang auslösen
Private Sub Pixel_Click(Index As Integer)

    If chkStyle.Value = 0 Then
    
        Call FloodFillRec(Index Mod 20, Index \ 20)
        
    Else
    
        Call FloodFillIt(Index Mod 20, Index \ 20, New CoordStack)
        
    End If
    
End Sub

' "Pixelfarbe" beeinflussen
Public Property Get mPixel(ByVal x As Long, ByVal y As Long) As Long

    mPixel = Pixel(x + 20 * y).BackColor
    
End Property

Public Property Let mPixel(ByVal x As Long, ByVal y As Long, ByVal rhs As _
    Long)
    
    Pixel(x + 20 * y).BackColor = rhs
    
End Property

' Rekursives FloodFill
Private Sub FloodFillRec(ByVal x As Long, ByVal y As Long)

    If x > 19 Or y > 19 Or x < 0 Or y < 0 Then Exit Sub
    If mPixel(x, y) = vbWhite Then
    
        mPixel(x, y) = vbBlue
        
        Call Sleep(25)
        
        DoEvents
        
        Call FloodFillRec(x, y + 1)
        Call FloodFillRec(x, y - 1)
        Call FloodFillRec(x + 1, y)
        Call FloodFillRec(x - 1, y)
        
    End If
    
End Sub

' Iteratives FloodFill
Private Sub FloodFillIt(ByVal x As Long, ByVal y As Long, Stack As CoordStack)

    Call Stack.Push(x, y)
    
    Do While Not Stack.IsEmpty
    
        Call Stack.Pop(x, y)
        
        If mPixel(x, y) = vbWhite Then
        
            mPixel(x, y) = vbGreen
            
            DoEvents
            
            Call Sleep(25)
            Call Stack.Push(x, y + 1)
            Call Stack.Push(x, y - 1)
            Call Stack.Push(x + 1, y)
            Call Stack.Push(x - 1, y)
            
        End If
        
    Loop
    
End Sub

' ---------- Ende Formular "Form1" alias Form1.frm  ----------
' ----- Anfang Klasse "CoordStack" alias CoordStack.cls  -----
Option Explicit

Private CoordX As New Collection, CoordY As New Collection

Public Sub Push(ByVal x As Long, ByVal y As Long)

    If (x > 19 Or y > 19 Or x < 0 Or y < 0) Then Exit Sub
    
    Call CoordX.Add(x)
    Call CoordY.Add(y)
    
End Sub

Public Sub Pop(ByRef x As Long, ByRef y As Long)

    x = PopCollection(CoordX)
    y = PopCollection(CoordY)
    
End Sub

Private Function PopCollection(Collection As Collection) As Long

    PopCollection = Collection(Collection.Count)
    
    Call Collection.Remove(Collection.Count)
    
End Function

Public Property Get IsEmpty() As Boolean

    IsEmpty = (CoordX.Count <= 0)
    
End Property

' ------ Ende Klasse "CoordStack" alias CoordStack.cls  ------
' -------------- Ende Projektdatei Projekt1.vbp --------------