Ich habe mal versucht, es möglichst performant hinzubekommen. Der Code generiert nun eine beliebige Anzahl an Frames, welche dann später (oder auch direkt) zu einer Animation weiterverarbeitet werden können. Der Code, der das Fraktal generiert, sieht folgendermaßen aus:
Es funktioniert auch alles, jedoch denke ich, dass ich irgendwo in der Berechnung des aktuellen Punktes einen Fehler gemacht habe, schau dir einfach mal den Teil ab Zeile 65 an, vielleicht findest du ja den Fehler ;).
Für den Code habe ich auch noch eine Form mit etwas Code im Hintergrund auf die Schnelle hingeklatscht, nicht sehr sauber, funktioniert aber mit Multithreading.
Im Anhang ist noch das Projekt, damit du dir auch mal ein Bild davon machen kannst.
VB.NET-Quellcode
- Public Class HopalongGenerator
- Private bmp As Bitmap
- Public Property Image As Bitmap
- Get
- Return bmp
- End Get
- Set(value As Bitmap)
- bmp = value
- End Set
- End Property
- ''' <summary>
- ''' Gibt an, dass sich das aktuelle Abbild des Fraktals geändert hat
- ''' </summary>
- ''' <param name="img">Das aktuelle Abbild</param>
- ''' <param name="iterations">Die Anzahl der Iterationen, die auf dem Bild abgebildet sind</param>
- Public Event ImageChanged(img As Bitmap, iterations As Long)
- ''' <summary>
- ''' Generiert ein Hopalong-Fraktal
- ''' </summary>
- ''' <param name="iterations">Die Anzahl der zu generierenden Iterationen</param>
- ''' <param name="zoom">Die Zoomstufe</param>
- ''' <param name="colorjump">Der Farbsprung</param>
- ''' <param name="size">Die Größe des zu generierenden Abbildes</param>
- ''' <param name="a">A</param>
- ''' <param name="b">B</param>
- ''' <param name="c">C</param>
- Public Sub GenerateHopalong(iterations As Long, zoom As Double, colorJump As Integer, colorFormula As Integer, size As Size, a As Double, b As Double, c As Double, frames As Integer)
- 'Überprüfen, ob die übergebene Anzahl der Iterationen überhaupt möglich ist
- If Not iterations > 0 Then Throw New ArgumentOutOfRangeException("The number of Iterations has to be higher than 0")
- 'Hier wird nachher reingerendert
- Dim TargetBitmap As New Bitmap(size.Width, size.Height, System.Drawing.Imaging.PixelFormat.Format24bppRgb)
- 'Hintergrund --> Schwarz
- Using g As Graphics = Graphics.FromImage(TargetBitmap)
- g.Clear(Color.Black)
- End Using
- 'Die Bildproperty aktualisieren und das Event auslösen
- bmp = DirectCast(TargetBitmap.Clone(), Bitmap)
- RaiseEvent ImageChanged(bmp, 0)
- 'Vorbereitung
- Dim ColorCount As Integer = 0
- Dim DistH As Integer = size.Width \ 2
- Dim DistV As Integer = size.Height \ 2
- 'Alle X Iterationen das Bild aktualisieren und übergeben
- Dim IterationsPerFrame As Double = iterations / frames
- 'Hier werden alle für diesen Frame zu rendernden Punkte gespeichert.
- Dim FrameIterationCount As Double = 0
- Dim DrawQuery As New Queue(Of Tuple(Of Point, Color))
- Dim X As Double = 1
- Dim Y As Double = 1
- For Iteration As Long = 1 To iterations
- 'Farbe festlegen
- ColorCount = CInt(Math.Max(1, (ColorCount Mod 256)))
- Dim Col As Color = GetColorFormula(colorFormula, ColorCount)
- Dim ptX As Integer = CInt(X * zoom + DistH)
- Dim ptY As Integer = CInt(Y * zoom + DistV)
- 'Punkt abspeichern
- DrawQuery.Enqueue(Tuple.Create(New Point(ptX, ptY), Col))
- 'Neue Koordinaten berechnen
- Dim xx As Double = Y - Math.Sign(X) * Math.Sqrt(Math.Abs(b * X - c))
- Dim yy As Double = a - X
- If Math.Abs(X - xx) < colorJump Then ColorCount += 1
- 'Wenn alle Iterationen für den aktuellen Frame fertig sind, den Frame mit LockBits zeichnen
- If FrameIterationCount >= IterationsPerFrame Then
- FrameIterationCount = FrameIterationCount - IterationsPerFrame
- Dim LockData As Imaging.BitmapData = TargetBitmap.LockBits(New Rectangle(0, 0, TargetBitmap.Width, TargetBitmap.Height), Imaging.ImageLockMode.ReadWrite, System.Drawing.Imaging.PixelFormat.Format24bppRgb)
- Dim Bytes As Integer = Math.Abs(LockData.Stride) * TargetBitmap.Height
- Dim ArgbValues(Math.Abs(LockData.Stride) * TargetBitmap.Height - 1) As Byte
- System.Runtime.InteropServices.Marshal.Copy(LockData.Scan0, ArgbValues, 0, Bytes)
- 'Alle Punkte zeichnen
- For Each t In DrawQuery
- Dim Index As Integer = (t.Item1.Y * TargetBitmap.Width * 3) + (t.Item1.X * 3)
- 'Nur drei Werte da nur 24 Bit (RGB)
- If Not (Index + 2 > ArgbValues.GetLength(0) - 1 OrElse Index < 0) Then
- ArgbValues(Index) = t.Item2.R
- ArgbValues(Index + 1) = t.Item2.G
- ArgbValues(Index + 2) = t.Item2.B
- End If
- Next
- System.Runtime.InteropServices.Marshal.Copy(ArgbValues, 0, LockData.Scan0, Bytes)
- TargetBitmap.UnlockBits(LockData)
- 'Das aktuelle Bild zurückgeben
- bmp = DirectCast(TargetBitmap.Clone(), Bitmap)
- RaiseEvent ImageChanged(bmp, Iteration)
- End If
- X = xx
- Y = yy
- FrameIterationCount += 1
- Next
- 'Am Ende das Bild nochmal zurückgeben
- bmp = DirectCast(TargetBitmap.Clone(), Bitmap)
- RaiseEvent ImageChanged(bmp, iterations)
- End Sub
- Private Function GetColorFormula(i As Integer, cc As Integer) As Color
- Select Case i
- Case 0
- Return Color.FromArgb(255 - cc, cc, CInt(127 + cc / 2))
- Case 1
- Return Color.FromArgb(255 - cc, CInt(127 + cc / 2), cc)
- Case 2
- Return Color.FromArgb(cc, CInt(127 + cc / 2), 255 - cc)
- Case 3
- Return Color.FromArgb(cc, 255 - cc, CInt(127 + cc / 2))
- Case 4
- Return Color.FromArgb(CInt(127 + cc / 2), cc, 255 - cc)
- Case 5
- Return Color.FromArgb(CInt(127 + cc / 2), 255 - cc, cc)
- Case Else
- Return Color.FromArgb(255 - cc, cc, CInt(127 + cc / 2))
- End Select
- End Function
- End Class
Es funktioniert auch alles, jedoch denke ich, dass ich irgendwo in der Berechnung des aktuellen Punktes einen Fehler gemacht habe, schau dir einfach mal den Teil ab Zeile 65 an, vielleicht findest du ja den Fehler ;).
Für den Code habe ich auch noch eine Form mit etwas Code im Hintergrund auf die Schnelle hingeklatscht, nicht sehr sauber, funktioniert aber mit Multithreading.
Im Anhang ist noch das Projekt, damit du dir auch mal ein Bild davon machen kannst.