vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
sevAniGif - als kostenlose Vollversion auf unserer vb@rchiv CD Vol.5  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2021
 
zurück
Rubrik: Grafik und Font · Bilder & Icons   |   VB-Versionen: VB4, VB5, VB607.12.00
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 PrelleBewertung:     [ Jetzt bewerten ]Views:  57.858 
www.visual-basic5.deSystem:  Win9x, WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10 Beispielprojekt auf CD 

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

Dieser Tipp wurde bereits 57.858 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Aktuelle Diskussion anzeigen (1 Beitrag)

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2021 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel