Hopalong - Fraktal

    • VB.NET

    Es gibt 84 Antworten in diesem Thema. Der letzte Beitrag () ist von zn-gong.

      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:

      VB.NET-Quellcode

      1. Public Class HopalongGenerator
      3. Private bmp As Bitmap
      4. Public Property Image As Bitmap
      5. Get
      6. Return bmp
      7. End Get
      8. Set(value As Bitmap)
      9. bmp = value
      10. End Set
      11. End Property
      13. ''' <summary>
      14. ''' Gibt an, dass sich das aktuelle Abbild des Fraktals geändert hat
      15. ''' </summary>
      16. ''' <param name="img">Das aktuelle Abbild</param>
      17. ''' <param name="iterations">Die Anzahl der Iterationen, die auf dem Bild abgebildet sind</param>
      18. Public Event ImageChanged(img As Bitmap, iterations As Long)
      20. ''' <summary>
      21. ''' Generiert ein Hopalong-Fraktal
      22. ''' </summary>
      23. ''' <param name="iterations">Die Anzahl der zu generierenden Iterationen</param>
      24. ''' <param name="zoom">Die Zoomstufe</param>
      25. ''' <param name="colorjump">Der Farbsprung</param>
      26. ''' <param name="size">Die Größe des zu generierenden Abbildes</param>
      27. ''' <param name="a">A</param>
      28. ''' <param name="b">B</param>
      29. ''' <param name="c">C</param>
      30. 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)
      31. 'Überprüfen, ob die übergebene Anzahl der Iterationen überhaupt möglich ist
      32. If Not iterations > 0 Then Throw New ArgumentOutOfRangeException("The number of Iterations has to be higher than 0")
      34. 'Hier wird nachher reingerendert
      35. Dim TargetBitmap As New Bitmap(size.Width, size.Height, System.Drawing.Imaging.PixelFormat.Format24bppRgb)
      37. 'Hintergrund --> Schwarz
      38. Using g As Graphics = Graphics.FromImage(TargetBitmap)
      39. g.Clear(Color.Black)
      40. End Using
      42. 'Die Bildproperty aktualisieren und das Event auslösen
      43. bmp = DirectCast(TargetBitmap.Clone(), Bitmap)
      44. RaiseEvent ImageChanged(bmp, 0)
      46. 'Vorbereitung
      47. Dim ColorCount As Integer = 0
      48. Dim DistH As Integer = size.Width \ 2
      49. Dim DistV As Integer = size.Height \ 2
      51. 'Alle X Iterationen das Bild aktualisieren und übergeben
      52. Dim IterationsPerFrame As Double = iterations / frames
      54. 'Hier werden alle für diesen Frame zu rendernden Punkte gespeichert.
      55. Dim FrameIterationCount As Double = 0
      56. Dim DrawQuery As New Queue(Of Tuple(Of Point, Color))
      57. Dim X As Double = 1
      58. Dim Y As Double = 1
      59. For Iteration As Long = 1 To iterations
      61. 'Farbe festlegen
      62. ColorCount = CInt(Math.Max(1, (ColorCount Mod 256)))
      63. Dim Col As Color = GetColorFormula(colorFormula, ColorCount)
      65. Dim ptX As Integer = CInt(X * zoom + DistH)
      66. Dim ptY As Integer = CInt(Y * zoom + DistV)
      68. 'Punkt abspeichern
      69. DrawQuery.Enqueue(Tuple.Create(New Point(ptX, ptY), Col))
      71. 'Neue Koordinaten berechnen
      72. Dim xx As Double = Y - Math.Sign(X) * Math.Sqrt(Math.Abs(b * X - c))
      73. Dim yy As Double = a - X
      74. If Math.Abs(X - xx) < colorJump Then ColorCount += 1
      76. 'Wenn alle Iterationen für den aktuellen Frame fertig sind, den Frame mit LockBits zeichnen
      77. If FrameIterationCount >= IterationsPerFrame Then
      78. FrameIterationCount = FrameIterationCount - IterationsPerFrame
      81. Dim LockData As Imaging.BitmapData = TargetBitmap.LockBits(New Rectangle(0, 0, TargetBitmap.Width, TargetBitmap.Height), Imaging.ImageLockMode.ReadWrite, System.Drawing.Imaging.PixelFormat.Format24bppRgb)
      82. Dim Bytes As Integer = Math.Abs(LockData.Stride) * TargetBitmap.Height
      83. Dim ArgbValues(Math.Abs(LockData.Stride) * TargetBitmap.Height - 1) As Byte
      84. System.Runtime.InteropServices.Marshal.Copy(LockData.Scan0, ArgbValues, 0, Bytes)
      86. 'Alle Punkte zeichnen
      87. For Each t In DrawQuery
      89. Dim Index As Integer = (t.Item1.Y * TargetBitmap.Width * 3) + (t.Item1.X * 3)
      90. 'Nur drei Werte da nur 24 Bit (RGB)
      91. If Not (Index + 2 > ArgbValues.GetLength(0) - 1 OrElse Index < 0) Then
      92. ArgbValues(Index) = t.Item2.R
      93. ArgbValues(Index + 1) = t.Item2.G
      94. ArgbValues(Index + 2) = t.Item2.B
      95. End If
      96. Next
      98. System.Runtime.InteropServices.Marshal.Copy(ArgbValues, 0, LockData.Scan0, Bytes)
      99. TargetBitmap.UnlockBits(LockData)
      102. 'Das aktuelle Bild zurückgeben
      103. bmp = DirectCast(TargetBitmap.Clone(), Bitmap)
      104. RaiseEvent ImageChanged(bmp, Iteration)
      105. End If
      107. X = xx
      108. Y = yy
      109. FrameIterationCount += 1
      110. Next
      112. 'Am Ende das Bild nochmal zurückgeben
      113. bmp = DirectCast(TargetBitmap.Clone(), Bitmap)
      114. RaiseEvent ImageChanged(bmp, iterations)
      115. End Sub
      117. Private Function GetColorFormula(i As Integer, cc As Integer) As Color
      118. Select Case i
      119. Case 0
      120. Return Color.FromArgb(255 - cc, cc, CInt(127 + cc / 2))
      121. Case 1
      122. Return Color.FromArgb(255 - cc, CInt(127 + cc / 2), cc)
      123. Case 2
      124. Return Color.FromArgb(cc, CInt(127 + cc / 2), 255 - cc)
      125. Case 3
      126. Return Color.FromArgb(cc, 255 - cc, CInt(127 + cc / 2))
      127. Case 4
      128. Return Color.FromArgb(CInt(127 + cc / 2), cc, 255 - cc)
      129. Case 5
      130. Return Color.FromArgb(CInt(127 + cc / 2), 255 - cc, cc)
      131. Case Else
      132. Return Color.FromArgb(255 - cc, cc, CInt(127 + cc / 2))
      133. End Select
      134. End Function
      136. 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.
      Dateien

      ThePlexian schrieb:

      Was zählst du denn noch alles zu Grundlagen wenn ich mal fragen darf? ^^
      ich meinte nix konkretes - das kommt ganz drauf an (es ging ja darum, ob ein Tutorial zur Engine prinzipiell möglich sei, oder ob der User durch herum-üben damit von selbst drauf kommen müsse).
      Wenn einer seine Engine erklärt, und man stößt auf eine Zeile, die der Leser nicht versteht, dann muß da nach-erklärt werden.
      Und es handelt sich dabei nicht um Erklärungen der Engine, sondern was anneres.

      Also Grundlagen sind alles, was zusätzlich erklärt werden muss, damit die eigentliche Erklärung der Engine ühaupt verstanden werden kann.

      Okay vielen Dank @nafets3646, aber ich habe noch ein paar Fragen:

      1. Zeile 62 und 74 sind doch iwie doppelt oder ?
      2. In Zeile 109 addierst du nur 1 dazu, also ist doch in Zeile 77 ">=" durch "=" ersetzbar, und in Zeile 78 kann man direkt FrameIterationCount = 0 schreiben, oder ?
      3. frames sind die Anzahl der Bilder, die man gesamt braucht, wenn man bei x Iterationen eine Framerate von f haben will ?
      4. Scheinbar ist mir das immer noch nicht ganz klar, wo trennst du da Graphik von Logik bitte ?

      Aber dankeschön soweit :)


      @ErfinderDesRades:
      Achso, ja macht Sinn ^^
      »There's no need to "teach" atheism. It's the natural result of education without indoctrination.« — Ricky Gervais

      @ThePlexian
      Oh, ich hatte wohl vergessen zu speichern, bevor ich das Programm geschlossen hatte. Der Code scheint noch aus einer der Vorversionen zu kommen, ich schau mal, ob ich das noch hinbekomme ;).

      Interesantes Thema,ich bekunde dann auch mal Interesse für einen Background eines MDI Fensters^^

    Facebook
    Telefonspende