Animierte GIF-Grafiken in VB Animierte GIF-Dateien sind in Verbindung mit dem Internet so richtig bekannt und populär geworden. Visual-Basic unterstützt zwar das GIF-Bildformat,...
Autor:   Heinz Prelle	Bewertung:     [ Jetzt bewerten ]	Views:  60.958
www.visual-basic5.de	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 221 Bewertung insgesamt: gut Durchschnittliche Bewertung: 3.8 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Animierte GIF-Dateien sind in Verbindung mit dem Internet so richtig bekannt und populär geworden. Visual-Basic unterstützt zwar das GIF-Bildformat, jedoch keine animierten GIFs. Um animierte GIF-Dateien dennoch in Ihren Anwendungen verwenden zu können, brauchen Sie keine teuren Tools zu kaufen. Mit Hilfe eines Image- und Timer-Objekts, sowie ein paar Zeilen Quellcode, könnnen auch Sie animierte GIFs in Ihren eigenen Projekten anzeigen.

Die nachfolgende Routine ermittelt die Anzahl der Bilder einer animierten GIF-Datei und speichert die einzelnen Bilder in einem Variant-Array. Mittels eines Timers werden dann die einzelnen Bilder nacheinander in einem Image-Objekt angezeigt. So entsteht der Animationseffekt.

' GIF-Datei auslesen und Einzelbilder im 
' Variant-Array varImage zwischenspeichern
Public Function GIF_LADEN(strDatei As String, _
varImage As Variant) As Boolean
    GIF_LADEN = False
    If Dir$(strDatei) = "" Or strDatei = "" Then
      MsgBox "Datei " & strDatei & " nicht gefunden.", _
      vbInformation
      Exit Function
    End If
 
    On Error GoTo Fehler
    Dim DNr As Integer
    Dim Bild_Header As String
    Dim Datei_Header As String
    Dim strBuffer As String
    Dim strBildBuffer As String
    Dim intBildZaehler As Integer
    Dim lngX As Long
    Dim lngY As Long
    Dim lngOffsetX As Long
    Dim lngOffsetY As Long
    Dim lngWarteZeit As Long
    Dim strGifEnde As String
 
    strGifEnde = Chr(0) & Chr(33) & Chr(249)
    For lngX = 1 To varImage.Count - 1
      Unload varImage(lngX)
    Next lngX
    DNr = FreeFile
    Open strDatei For Binary Access Read As DNr
    strBuffer = String(LOF(DNr), Chr(0))
    Get #DNr, , strBuffer
    Close DNr
    lngX = 1
    intBildZaehler = 0
    lngY = InStr(1, strBuffer, strGifEnde) + 1
    Datei_Header = Left(strBuffer, lngY)
    If Left$(Datei_Header, 3) <> "GIF" Then
      MsgBox "Bei der gewaehlten Datei handelt es " + _
        "sich nicht um eine Gif-Datei.", vbInformation
      Exit Function
    End If
    GIF_LADEN = True
    lngX = lngY + 2
    If Len(Datei_Header) >= 127 Then
      lngZeit& = Asc(Mid(Datei_Header, 126, 1)) + _
        (Asc(Mid(Datei_Header, 127, 1)) * 256&)
    Else
      lngZeit = 0
    End If
    Do
      intBildZaehler = intBildZaehler + 1
      lngY = InStr(lngX, strBuffer, strGifEnde) + 3
      If lngY > Len(strGifEnde) Then
        DNr = FreeFile
        Open "tmp.gif" For Binary As DNr
        strBildBuffer = String(Len(Datei_Header) + _
          lngY - lngX, Chr(0))
        strBildBuffer = Datei_Header & _
          Mid(strBuffer, lngX - 1, lngY - lngX)
        Put #DNr, 1, strBildBuffer
        Bild_Header = Left(Mid(strBuffer, lngX - 1, _
         lngY - lngX), 16)
        Close DNr
        lngWarteZeit = ((Asc(Mid(Bild_Header, 4, 1))) + _
          (Asc(Mid(Bild_Header, 5, 1)) * 256&)) * 10&
        If intBildZaehler > 1 Then
          lngOffsetX = Asc(Mid(Bild_Header, 9, 1)) + _
           (Asc(Mid(Bild_Header, 10, 1)) * 256&)
          lngOffsetY = Asc(Mid(Bild_Header, 11, 1)) + _
           (Asc(Mid(Bild_Header, 12, 1)) * 256&)
          Load varImage(intBildZaehler - 1)
          varImage(intBildZaehler - 1).Left = varImage(0).Left + _
           (lngOffsetX * Screen.TwipsPerPixelX)
          varImage(intBildZaehler - 1).Top = varImage(0).Top + _
           (lngOffsetY * Screen.TwipsPerPixelY)
        End If
        varImage(intBildZaehler - 1).Tag = lngWarteZeit
        varImage(intBildZaehler - 1).Picture = _
         LoadPicture("tmp.gif")
        Kill ("tmp.gif")
        lngX = lngY
      End If
      DoEvents
    Loop Until lngY = 3
    If lngX < Len(strBuffer) Then
      DNr = FreeFile
      Open "tmp.gif" For Binary As DNr
      strBildBuffer = String(Len(Datei_Header) + _
       Len(strBuffer) - lngX, Chr(0))
      strBildBuffer = Datei_Header & _
       Mid(strBuffer, lngX - 1, Len(strBuffer) - lngX)
      Put #DNr, 1, strBildBuffer
      Bild_Header = Left(Mid(strBuffer, lngX - 1, _
       Len(strBuffer) - lngX), 16)
      Close DNr
      lngWarteZeit = ((Asc(Mid(Bild_Header, 4, 1))) + _
       (Asc(Mid(Bild_Header, 5, 1)) * 256)) * 10
      If intBildZaehler > 1 Then
        lngOffsetX = Asc(Mid(Bild_Header, 9, 1)) + _
         (Asc(Mid(Bild_Header, 10, 1)) * 256)
        lngOffsetY = Asc(Mid(Bild_Header, 11, 1)) + _
         (Asc(Mid(Bild_Header, 12, 1)) * 256)
        Load varImage(intBildZaehler - 1)
        varImage(intBildZaehler - 1).Left = varImage(0).Left + _
         (lngOffsetX * Screen.TwipsPerPixelX)
        varImage(intBildZaehler - 1).Top = varImage(0).Top + _
         (lngOffsetY * Screen.TwipsPerPixelY)
      End If
      varImage(intBildZaehler - 1).Tag = lngWarteZeit
      varImage(intBildZaehler - 1).Picture = _
       LoadPicture("tmp.gif")
      Kill ("tmp.gif")
    End If
    lngEinzelPic = varImage.Count - 1
    Exit Function
Fehler:
    MsgBox "Fehler Nummer. " & Err.Number & _
     " beim Lesen der Datei.", vbInformation
    GIF_LADEN = False
    On Error GoTo 0
End Function
 
' Bildsequenzen anzeigen
Private Sub Timer1_Timer()
  If lngBildAnzahl < lngEinzelPic Then
    Image1(lngBildAnzahl).Visible = False
    lngBildAnzahl = lngBildAnzahl + 1
    Image1(lngBildAnzahl).Visible = True
    Timer1.Interval = CLng(Image1(lngBildAnzahl).Tag)
  Else
   lngBildAnzahl = 0
   For lngX = 1 To Image1.Count - 1
     Image1(lngX).Visible = False
   Next lngX
   Image1(lngBildAnzahl).Visible = True
   Timer1.Interval = CLng(Image1(lngBildAnzahl).Tag)
  End If
End Sub