Algoritme til tegneprogram - "Out of stack space"

[Jonas]

Heisann

 

Tenker på å prøve å lage et tegneprogram igjen, og ser litt på forskjellige tegne-algoritmer. Er på fill-funksjonen nå, men har litt problemer.

 

Greia er at funksjonen kaller seg selv (Hva kalles slike funksjoner?) og det finnes tydelighvis en begrensning på hvor mange ganger det kan skje. (Prøv å fyll å trykk på det høyre området på bildet)

 

Hvordan løser jeg dette?

 

Og forresten, mens jeg har en tråd.. Fungerer denne algoritmen? Kan jeg på noen måte gjøre den bedre?

 

- Jonas

Fill_funksjon.zip

Endret 26. desember 2005 av Jonas

[aadnk]

Slike funksjoner kalles rekursive funksjoner. Antall ganger de kan kalle seg selv begrenses av stack-størrelsen, en datastrukstur - en form for array - som inneholder alle paramentre og pekere til de forskjellige funksjonene oppover i kall-hierakiet.

 

For å optimalisere denne funksjonen, kan du begrense rekursiv søking vertikalt, og heller søke linært vertikalt, eksempelvis slik:

 

Public Sub Fill(Pic As PictureBox, X As Single, Y As Single, src As Long, color As Long)

   

    Dim hDC As Long, lngLeft As Long, lngRight As Long, Tell As Single

   

    ' Utfør hendelser

    DoEvents

   

    ' Optimaliserer koden en smule

    hDC = Pic.hDC

   

    If X < 0 Or X > Pic.ScaleWidth Or _

      Y < 0 Or Y > Pic.ScaleHeight Or _

      src = color Then Exit Sub

 

    If GetPixel(hDC, X, Y) = src Then

 

        ' Først, finn venstre kant

        For Tell = X To 0 Step -1

            If GetPixel(hDC, Tell, Y) <> src Then

                Exit For

            Else

                SetPixel hDC, Tell, Y, color

            End If

        Next

       

        ' Lagre venstre kant

        lngLeft = Tell + 1

       

        ' Dernest, finn høyre kant

        For lngRight = X + 1 To Pic.ScaleWidth

            If GetPixel(hDC, lngRight, Y) <> src Then

                lngRight = lngRight - 1

                Exit For

            Else

                SetPixel hDC, lngRight, Y, color

            End If

        Next

       

        ' Finn områder ovenfor og nedenfor gjeldende linje

        For Tell = lngLeft To lngRight

       

            ' Se om en piksel ovenfor kan fylles

            If GetPixel(hDC, Tell, Y + 1) = src Then

                Fill Pic, Tell, Y + 1, src, color

            End If

           

            ' Likeledes om en piksel nedenfor kan fylles

            If GetPixel(hDC, Tell, Y - 1) = src Then

                Fill Pic, Tell, Y - 1, src, color

            End If

       

        Next

       

    End If

   

End Sub

Endret 30. desember 2005 av aadnk

[Jonas]

Genialt, det fungerer jo perfekt. Takker så meget!!