Sección de códigos , trucos y ejemplos para visual basic

59 - Reproducir un Gif animado sin utilizar un Ocx y hacerlo mediante código

Contenido

Ejemplo 1
Ejemplo 2
Enlaces relacionados

Ejemplo 1

Este ejemplo muy interesante muestra como podemos reproducir un Gif animado en un control Image o PictureBox solamente mediante código, es decir leyendo en forma binaria el fichero y obteniendo la secuencia de imagenes.

Luego con la secuencia de imagenes , se reproduce mediante el uso de un Timer

Nota importante: el ejemplo no funciona con todos los archivos Gif.

Colocar los siguientes controles :

un control Timer
Un control CommandButton Command1 , que es el comienza a reproducir el Gif animado
Un control Image con la propiedad Index en 0 ( es decir para formar un array de image)
Colocar el Gif animado dentro de la carpeta del proyecto.

Código fuente en el formulario:

Option Explicit Private FrameCount As Long Private Const LB_DIR As Long = &H18D Private Const DDL_ARCHIVE As Long = &H20 Private Const DDL_EXCLUSIVE As Long = &H8000 Private Const DDL_FLAGS As Long = DDL_ARCHIVE Or DDL_EXCLUSIVE Private TotalFrames As Long Private RepeatTimes As Long Private Sub Command1_Click() Dim nFrames As Long nFrames = LoadGif(App.Path + "\archivoGif.gif", Image1) If nFrames > 0 Then FrameCount = 0 Timer1.Interval = CLng(Image1(0).Tag) Timer1.Enabled = True End If End Sub Private Sub Command2_Click() Timer1.Enabled = False End Sub Private Sub Timer1_Timer() Dim i As Long If FrameCount < TotalFrames Then Image1(FrameCount).Visible = False FrameCount = FrameCount + 1 Else FrameCount = 0 For i = 1 To Image1.Count - 1 Image1(i).Visible = False Next i End If Image1(FrameCount).Visible = True Timer1.Interval = CLng(Image1(FrameCount).Tag) End Sub Private Function LoadGif( _ sFile As String, _ aImg As Variant) As Long Dim hFile As Long Dim sImgHeader As String Dim sFileHeader As String Dim sBuff As String Dim sPicsBuff As String Dim nImgCount As Long Dim i As Long Dim j As Long Dim xOff As Long Dim yOff As Long Dim TimeWait As Long Dim sGifMagic As String If Dir$(sFile) = "" Or sFile = "" Then MsgBox "File " & sFile & " not found", vbInformation Exit Function End If sGifMagic = Chr$(0) & Chr$(33) & Chr$(249) If aImg.Count > 1 Then For i = 1 To aImg.Count - 1 Unload aImg(i) Next i End If hFile = FreeFile Open sFile For Binary Access Read As hFile sBuff = String(LOF(hFile), Chr(0)) Get #hFile, , sBuff Close #hFile i = 1 nImgCount = 0 j = InStr(1, sBuff, sGifMagic) + 1 sFileHeader = Left(sBuff, j) If Left$(sFileHeader, 3) <> "GIF" Then MsgBox "This file is not a *.gif file", vbInformation Exit Function End If LoadGif = True i = j + 2 If Len(sFileHeader) >= 127 Then RepeatTimes& = Asc(Mid(sFileHeader, 126, 1)) + _ (Asc(Mid(sFileHeader, 127, 1)) * 256&) Else RepeatTimes = 0 End If hFile = FreeFile Open "temp.gif" For Binary As hFile Do nImgCount = nImgCount + 1 j = InStr(i, sBuff, sGifMagic) + 3 If j > Len(sGifMagic) Then sPicsBuff = String(Len(sFileHeader) + j - i, Chr$(0)) sPicsBuff = sFileHeader & Mid(sBuff, i - 1, j - i) Put #hFile, 1, sPicsBuff sImgHeader = Left(Mid(sBuff, i - 1, j - i), 16) TimeWait = ((Asc(Mid(sImgHeader, 4, 1))) + _ (Asc(Mid(sImgHeader, 5, 1)) * 256&)) * 10& If nImgCount > 1 Then Load aImg(nImgCount - 1) xOff = Asc(Mid(sImgHeader, 9, 1)) + _ (Asc(Mid(sImgHeader, 10, 1)) * 256&) yOff = Asc(Mid(sImgHeader, 11, 1)) + _ (Asc(Mid(sImgHeader, 12, 1)) * 256&) aImg(nImgCount - 1).Left = aImg(0).Left + _ (xOff * Screen.TwipsPerPixelX) aImg(nImgCount - 1).Top = aImg(0).Top + _ (yOff * Screen.TwipsPerPixelY) End If aImg(nImgCount - 1).Tag = TimeWait aImg(nImgCount - 1).Picture = LoadPicture("temp.gif") i = j End If Loop Until j = 3 Close #hFile Kill "temp.gif" TotalFrames = aImg.Count - 1 LoadGif = TotalFrames Exit Function ErrHandler: MsgBox "Error No. " & Err.Number & " when reading file", vbCritical LoadGif = False On Error GoTo 0 End Function

Ejemplo 2

Código fuente enviado por Helmuth Schmelzer Campos , de un formulario para reproducir archivos gif animados en un image.

formulario para animar el gif

Nota: no funciona con todos los archivos Gifs

Descargar ejemplo

Recursos vb 6.0 - Enlaces relacionados a gif animado

Buscar en Recursos vb