Tutorial: Animated Gif erstellen

    • VB.NET

      Tutorial: Animated Gif erstellen

      Hi Leute,
      da ich hier beim Suchen nicht wirklich das gefunden habe, was ich suchte, möchte ich Euch meinen Code posten, mit dem eine animated Gif erstellt werden kann.
      Folgende NameSpaces müssen importiert werden:
      Folgende DLLs müssen dem Projekt hinzugefügt werden:
      • PresentationCore;
      • WindowsBase;
      • System.Xaml

      VB.NET-Quellcode

      1. Imports System.Windows.Media
      2. Imports System.Windows.Media.Imaging ' GIF
      3. Imports System.Runtime.InteropServices ' Marshal

      Spoiler anzeigen

      VB.NET-Quellcode

      1. Public Class Form1
      2. ' Dictionary zur Zuordnung der Formatdefinitionen in den 2 Namespaces
      3. Private Formats As Dictionary(Of System.Drawing.Imaging.PixelFormat, System.Windows.Media.PixelFormat)
      4. Public Sub New()
      5. InitializeComponent()
      6. ' Dictionary anlegen
      7. Formats = New Dictionary(Of System.Drawing.Imaging.PixelFormat, System.Windows.Media.PixelFormat)
      8. ' Dictionary und befüllen
      9. Formats.Add(System.Drawing.Imaging.PixelFormat.Format32bppArgb, PixelFormats.Pbgra32)
      10. Formats.Add(System.Drawing.Imaging.PixelFormat.Format24bppRgb, PixelFormats.Bgr24)
      11. End Sub
      12. Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
      13. ' Quell-Liste bereitstellen
      14. Dim lBmp As New List(Of String)
      15. lBmp.Add("C:\Temp\Bitmap1.bmp")
      16. lBmp.Add("C:\Temp\Bitmap2.bmp")
      17. lBmp.Add("C:\Temp\Bitmap3.bmp")
      18. ' Gif-Erstellung aufrufen
      19. DrawMakroGif("c:\Temp\MyGif.gif", lBmp)
      20. End Sub
      21. Friend Sub DrawMakroGif(ByVal fileName As String, ByVal lBmp As List(Of String))
      22. ' Test, ob Daten vorhanden sind
      23. If (lBmp.Count = 0) Then
      24. MessageBox.Show("Keine Bilder verfügbar.")
      25. Return
      26. End If
      27. ' Encoder zur Erzeugung der Gif
      28. Dim encoder As GifBitmapEncoder = New GifBitmapEncoder()
      29. ' Schleife über alle Bilder
      30. For Each file As String In lBmp
      31. ' Bitmap erzeugen
      32. Dim bmp As New Bitmap(file)
      33. ' Test, ob das Format eingetragen ist
      34. If (Not Formats.ContainsKey(bmp.PixelFormat)) Then
      35. MessageBox.Show("Format nicht verfügbar: " & bmp.PixelFormat.ToString)
      36. Return
      37. End If
      38. ' Bitmap-Größe und -Daten holen und festhalten
      39. Dim rc As New Rectangle(0, 0, bmp.Width, bmp.Height)
      40. Dim bmpData As System.Drawing.Imaging.BitmapData
      41. bmpData = bmp.LockBits(rc, System.Drawing.Imaging.ImageLockMode.ReadWrite, bmp.PixelFormat)
      42. ' Feld für die Pixel-Information bereitstellen
      43. Dim pixels() As Byte
      44. ReDim pixels(rc.Height * bmpData.Stride - 1) ' ist halt in VB so
      45. ' Kopieren der Pixelinformation
      46. Marshal.Copy(bmpData.Scan0, pixels, 0, pixels.Length)
      47. bmp.UnlockBits(bmpData)
      48. ' Bitmap-Source nach dem Bilde der Bitmap erzeugen
      49. Dim _image As BitmapSource = BitmapSource.Create(rc.Width, rc.Height, 96, 96, Formats(bmp.PixelFormat), Nothing, pixels, bmpData.Stride)
      50. ' rc.Width - Breite der Bitmap in Pixeln
      51. ' rc.Height - Höhe der Bitmap in Pixeln
      52. ' 96 - horizontale Punkte pro Zoll (dots per inch, dpi) der Bitmap
      53. ' 96 - vertikale Punkte pro Zoll (dots per inch, dpi) der Bitmap.
      54. ' Formats(bmp.PixelFormat) - Pixelformat
      55. ' Nothing - Define the image palette
      56. ' pixels - die Pixel der Bitmap
      57. ' bmpData.Stride - Schrittweite der Bitmap
      58. ' der Gif hinzufügen
      59. encoder.Frames.Add(BitmapFrame.Create(_image))
      60. Next
      61. ' Gif abspeichern
      62. Using _stream As System.IO.FileStream = New System.IO.FileStream(fileName, System.IO.FileMode.Create)
      63. encoder.Save(_stream)
      64. End Using
      65. End Sub
      66. End Class
      Im Beispiel wird eine einfache Form mit einem Button benötigt. Im Konstruktor wird ein Dictionary zur Zuordnung von PixelFormat in 2 Namespaces bereitgestellt: Das Pixelformat (z.B. 24 Bit Per Pixel) wird im Namespace System.Drawing.Imaging und im Namespace System.Windows.Media separat belegt, beide Werte werden benötigt. Deshalb habe ich ein Dictionary zur eindeutigen Zuordnung angelegt. Kommt nur ein Format vor, kann dies natürlich hart codiert werden.
      Im Button1_Click()-Event werden die einzelnen Bilder als Liste der Dateipfade angelegt, das kann natürlich auch eine List(Of Bitmap) oder dergleichen sein.
      Die Hauptprozedur des Progreamms DrawMakroGif wird mit dem Namen der zu erstellenden Gif sowie der Liste der Bitmap-Namen aufgerufen.
      Zunächst wird getestet, ob überhaupt Daten vorhanden sind.
      Danach wird der Encoder zur Erzeugung der Gif angelegt.
      In der Schleife über alle Bilder wird zuerst die Bitmap erzeugt und das Vorhandensein des Pixelformats getestet. Danach wird ihre Größe ausgelesen und ihre Pixeldaten im Speicher festgehalten.
      Das Feld zur Übernahme der Pixel-Daten wird angelegt und mit den Informationen der Bitmap befüllt.
      Zuletzt wird noch die BitmapSource entsprechend dem Bild der Bitmap erzeugt und dem Gif-Encoder hinzugefügt.
      Sind alle Bilder hinzugefügt, muss die Gif nur noch abgespeichert werden.
      Fertig.

      Das besondere an dieser Gif-Erstellung ist, dass der Encoder intern überprüft, wieviele Farben tatsächlich benötigt werden, danach wird die Farbtiefe der Gif festgelegt.
      Es ist durchaus sinnvoll, 32-Bit per Pixel Bilder derr Gif hinzuzufügen, obwohl lediglich z.B. 12 Farben vorkommen. Die Gif würde dann mit 4 Bit Per Pixel erzeugt werden.
      So kann darauf verzichtet werden, beim Erstellen der BitmapSource eine Palette zu übergeben.
      Falls Du diesen Code kopierst, achte auf die C&P-Bremse.
      VB-Fragen über PN werden ignoriert!

      Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „RodFromGermany“ () aus folgendem Grund: Felddimensionierung an VB-interne Zählweise angepasst: ReDim pixels(rc.Height * bmpData.Stride - 1) ' ist halt in VB so