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. ' 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 60.091 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
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. |
vb@rchiv CD Vol.6 Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 sevWizard für VB5/6 Professionelle Assistenten im Handumdrehen Erstellen Sie eigene Assistenten (Wizards) im Look & Feel von Windows 2000/XP - mit allem Komfort und zwar in Windeseile :-) |
||||||||||||||||
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. |