Jump to content
Sign in to follow this  
Jonas

Algoritme til tegneprogram - "Out of stack space"

Recommended Posts

Heisann :fun:

 

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

post-20869-1135568527_thumb.jpg

Edited by Jonas

Share this post


Link to post

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

Edited by aadnk

Share this post


Link to post

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...
Sign in to follow this  

×
×
  • Create New...