- Option Explicit
 
- Dim NumberOfTimesToRepeatSequence As Long
 
- Dim RepeatedCount As Long
 
- Dim MaxCnt As Integer
 
- Dim ImgCnt As Integer
 
- Private Sub Form_Load()
 
-   On Error GoTo Form_LoadError
 
-   Image1(0).Left = 0
 
-   Image1(0).Top = 0
 
-   'lugar de la ruta de acceso al GIF que desea animar aquí
 
-   Call DecodeGif("C:\FicheroGifAnimado.gif")
 
-   'PONER AQUI EL FICHERO GIF
 
-   Exit Sub
 
- Form_LoadError:
 
-   MsgBox Err.Description
 
- End Sub
 
-   
- Public Sub DecodeGif(PathToGifFile As String)
 
-   
-   ' si hay errores saltamos a la etiqueta DecodeGifError
 
-   On Error GoTo DecodeGifError
 
-   
 
-   'Declaramos las variables
 
-   Dim FNumb As Integer
 
-   Dim GifBuffer As String
 
-   Dim GifHeader As String
 
-   Dim SectionStart As Long
 
-   Dim SectionEnd As Long
 
-   Dim SectionMarker As String
 
-   Dim ImageCount As Integer
 
-   Dim i As Integer
 
-   Dim NewPicBuff As String
 
-   Dim ImageHeader As String
 
-   Dim DisplayTime As Long
 
-   Dim LftOffSet As Long
 
-   Dim TopOffSet As Long
 
-   
 
-   ' comprobamos básicamente si existe el fichero contenido en la variable PathToGifFile
 
-   If Dir(PathToGifFile) = vbNullString Then
 
-     MsgBox "Dónde está el GIF!?"
 
-     ' si no lo encuentra salimos
 
-     Exit Sub
 
-   End If
 
-   
 
-   'detenemos el timer y cualquier animación que pueda estar en marcha
 
-   Timer1.Enabled = False
 
-   
 
-   ' eliminamos las imágenes existentes por si ya hemos mostrado antes otra animación
 
-   For i = 1 To Image1.Count - 1
 
-     Unload Image1(i)
 
-   Next i
 
-   ' solo dejamos la imagen (0) como base para crear mas
 
-   
 
-   ' nos aseguramos de que el control image no va a cambiar de tamaño para adaptarse al tamaño de la imagen
 
-   Image1(0).Stretch = False
 
-   'set value(s)
 
-   
 
-   'valor de referencia (s)
 
-   SectionMarker = Chr(0) & "!ù"
 
-   ' Esto imagino que es algo técnico sobre el formato de un fichero gif.
 
-   ' Posiblemente son caracteres que encontraremos precediendo a cada imagen o algo así.
 
-   
-   ' Puntero que iremos usando para guardar la posicion de comienzo de cada seccion con la que trabajemos
 
-   SectionStart = 1
 
-   
 
-   ' el sistema nos dá un numero de fichero que no se está usando en otro open en este momento
 
-   FNumb = FreeFile  ' <--- Esto es mejor que esto ---> FNumb = 1
 
-   
-   'abrimos el fichero gif
 
-   Open PathToGifFile For Binary As #FNumb
 
-   
-   ' leemos todo el fichero y lo cargamos en un string llamado GifBuffer
 
-   GifBuffer = Input(FileLen(PathToGifFile), #FNumb)
 
-   ' y lo cerramos. 
 
-   Close #FNumb
 
-   
 
-   ' Buscamos el final del encabezado del fichero gif usando los caracteres de sectionmarker
 
-   SectionEnd = InStr(SectionStart, GifBuffer, SectionMarker) + Len(SectionMarker) - 2
 
-   
 
-   'guardamos esa parte del comienzo del gif (encabezado-header) que contendrá datos sobre el gif...
 
-   GifHeader = Left(GifBuffer, SectionEnd)
 
-   
-   ' guardamos la posición de inicio de la primera imagen
 
-   SectionStart = SectionEnd + 2
 
-   
 
-   'según la longitud del encabezado calculamos si el gif es continuo o se repite un numero limitado de veces
 
-   If Len(GifHeader) > 127 Then
 
-     ' si es mayor que 127 extraemos la cantidad de ciclos que se va a repetir con la formula:
 
-     ' ((Numero ascii del caracter 127) * 256) + Numero ascii del caracter 126
 
-     NumberOfTimesToRepeatSequence = Asc(Mid(GifHeader, 127, 1))
 
-     NumberOfTimesToRepeatSequence = NumberOfTimesToRepeatSequence * 256
 
-     NumberOfTimesToRepeatSequence = NumberOfTimesToRepeatSequence + Asc(Mid(GifHeader, 126, 1))
 
-   Else
 
-     ' si el encabezado no es mayor de 127 es que el gif se repite continuamente
 
-     NumberOfTimesToRepeatSequence = 0 'bucle infinito
 
-   End If
 
-   
 
-   
 
-   ' aqui extraemos las imagenes
 
-   
-   ' esto no se como funciona exactamente pero hace un bucle mientras queden imagenes que extraer
 
-   Do While SectionEnd <> Len(SectionMarker)
 
-   
 
-   'llevamos un contador de imagenes extraidas para crear los controles image
 
-   ImageCount = ImageCount + 1
 
-   
 
-   'para saber dónde termina la sección
 
-   SectionEnd = InStr(SectionStart, GifBuffer, SectionMarker) + Len(SectionMarker)
 
-   
 
-   'Nos aseguramos de que hay alguna imagen en el gif
 
-   If SectionEnd > Len(SectionMarker) Then
 
-   
 
-     'capturamos el trozo marcado y lo precedemos con el encabezado del fichero Gif (imagino que para que mantenga el formato al guardarlo como imagen individual)
 
-     NewPicBuff = GifHeader & Mid(GifBuffer, SectionStart - 1, SectionEnd - SectionStart)
 
-     
 
-     'Ahora se escribe la imagen a un archivo para poder cargarla como nosotros queremos hacerlo
 
-     FNumb = FreeFile
 
-     Open App.Path & "\temp.gif" For Binary As #FNumb
 
-     Put #FNumb, 1, NewPicBuff
 
-     Close #FNumb
 
-     
 
-     'ahora guardamos los 16 primeros caracteres de cada imagen que nos dirán su duración, etc
 
-     ImageHeader = Left(Mid(GifBuffer, SectionStart - 1, SectionEnd - SectionStart), 16)
 
-     
 
-     'Ahora calculamos la duración de la imagen actual con una formula que usa el cuarto y el quinto de esos 16 caracteres guardados
 
-     DisplayTime = Asc(Mid(ImageHeader, 5, 1))
 
-     DisplayTime = DisplayTime * 256
 
-     DisplayTime = DisplayTime + Asc(Mid(ImageHeader, 4, 1))
 
-     DisplayTime = DisplayTime * 10
 
-     
 
-     ' si no es la primera imagen que guardamos...
 
-     If ImageCount > 1 Then
 
-   
-       ' calculamos la posición de la nueva imagen dentro del formulario usando para ello los caracteres 9,10,11 y 12 de los 16 de la cabecera de la imagen.
 
-       LftOffSet = Asc(Mid(ImageHeader, 10, 1))
 
-       LftOffSet = LftOffSet * 256
 
-       LftOffSet = LftOffSet + Asc(Mid(ImageHeader, 9, 1))
 
-   
-       TopOffSet = Asc(Mid(ImageHeader, 12, 1))
 
-       TopOffSet = TopOffSet * 256
 
-       TopOffSet = TopOffSet + Asc(Mid(ImageHeader, 11, 1))
 
-   
-       'carga un nuevo control image y establece sus propiedades
 
-       Load Image1(ImageCount - 1)
 
-   
-       Image1(ImageCount - 1).ZOrder 0  ' zorder nunca he entendido como funciona (ni usado)
 
-   
-       Image1(ImageCount - 1).Left = Image1(0).Left + (LftOffSet * 15)
 
-       Image1(ImageCount - 1).Top = Image1(0).Top + (TopOffSet * 15)
 
-       
 
-     End If
 
-     
 
-     ' Añado esto para evitar que se cuele un valor de interval no válido.
 
-     If DisplayTime < 0 Then DisplayTime = 0
 
-     If DisplayTime > 65535 Then DisplayTime = 65535
 
-     ' creo que ya no es necesario pero al principio me pasaba y por seguridad lo dejo.
 
-   
-     
 
-     'guardamos en la propiedad Tag el tiempo que debe mostrarse la imagen
 
-     Image1(ImageCount - 1).Tag = DisplayTime
 
-   
-     ' cargamos la imagen que habíamos guardado en un fichero
 
-     Image1(ImageCount - 1).Picture = LoadPicture(App.Path & "\temp.gif")
 
-     
 
-     'la imagen ya no hace falta y se elimina
 
-     Kill App.Path & "\temp.gif"
 
-     
 
-     ' nos colocamos en posicion para comenzar con la siguiente imagen a cargar
 
-     SectionStart = SectionEnd
 
-     
 
-   End If
 
-   
 
-   ' y asi tantas veces como imagenes haya
 
-   Loop
 
-   
-   ' si aun quedan datos en el fichero creamos una última imagen con eso
 
-   If SectionStart < Len(GifBuffer) Then
 
-   
 
-     NewPicBuff = GifHeader & Mid(GifBuffer, SectionStart - 1, Len(GifBuffer) - SectionStart)
 
-     
 
-     ' el proceso es igual que antes asi que quito comentarios.
 
-   
-     FNumb = FreeFile
 
-     Open App.Path & "\temp.gif" For Binary As #FNumb
 
-     Put #FNumb, 1, NewPicBuff
 
-     Close #FNumb
 
-     
 
-     ImageHeader = Left(Mid(GifBuffer, SectionStart - 1, Len(GifBuffer) - SectionStart), 16)
 
-     
 
-     DisplayTime = Asc(Mid(ImageHeader, 5, 1))
 
-     DisplayTime = DisplayTime * 256
 
-     DisplayTime = DisplayTime + Asc(Mid(ImageHeader, 4, 1))
 
-     DisplayTime = DisplayTime * 10
 
-   
-     If ImageCount > 1 Then
 
-     
 
-       LftOffSet = Asc(Mid(ImageHeader, 10, 1))
 
-       LftOffSet = LftOffSet * 256
 
-       LftOffSet = LftOffSet + Asc(Mid(ImageHeader, 9, 1))
 
-   
-       TopOffSet = Asc(Mid(ImageHeader, 12, 1))
 
-       TopOffSet = TopOffSet * 256
 
-       TopOffSet = TopOffSet + Asc(Mid(ImageHeader, 11, 1))
 
-       
 
-       Load Image1(ImageCount - 1)
 
-       Image1(ImageCount - 1).ZOrder 0
 
-       Image1(ImageCount - 1).Left = Image1(0).Left + (LftOffSet * 15)
 
-       Image1(ImageCount - 1).Top = Image1(0).Top + (TopOffSet * 15)
 
-     
 
-     End If
 
-     
 
-     If DisplayTime < 0 Then DisplayTime = 0
 
-     If DisplayTime > 65535 Then DisplayTime = 65535
 
-     
 
-     Image1(ImageCount - 1).Tag = DisplayTime
 
-     Image1(ImageCount - 1).Picture = LoadPicture(App.Path & "\temp.gif")
 
-     Kill App.Path & "\temp.gif"
 
-     
 
-   End If
 
-   
 
-   ' reiniciamos el contador de imagenes mostradas en el timer
 
-   ImgCnt = -1
 
-   ' y guardamos el numero de imagenes totales
 
-   MaxCnt = Image1.Count - 1
 
-     
 
-   ' muestro ya la primera imagen
 
-   Image1(0).Visible = True
 
-   ' esto creo que tambien sobra.
 
-   ' lo puse para que no se saltase la primera imagen pero creo que se arregló al poner ImgCnt = - 1
 
-   
-   'configurar el timer con la duración de la primera imagen
 
-   Timer1.Interval = CInt(Image1(0).Tag)
 
-   'y para finalizar activamos el timer para comenzar la animacion
 
-   Timer1.Enabled = True
 
-   Exit Sub
 
-   
- DecodeGifError:
 
-   ' esto lo añadi para saltarme un error
 
-   If Image1.Count > 0 And Err.Number = 50003 Then
 
-     Unload Image1(Image1.Count - 1)
 
-     ImageCount = ImageCount - 1
 
-   Else
 
-     MsgBox Err.Number & " - " & Err.Description
 
-   End If
 
-   Err.Clear
 
-   
 
-   ' Añado esto para extraer todos los
 
-   ' fotogramas que pueda aun con un error
 
-   Resume Next
 
- End Sub