Animación gif en una aplicación

[pkj]

He encontrado otro método para hacerlo sin WebBrowser ni librerias externas, pero el resultado no es muy profesional.
Se extraen todos los fotogramas del gif, se crean tantos controles image como hagan falta y se cargan los fotogramas.
Con un Timer los vá mostrando/ocultando para simular la animación.
Problemas:
1 - Un parpadeo cuando acaba una secuencia y vuelve a empezar.
2 - Los gifs con transparencias o imágenes de diferentes tamaños no se reproducen bien.

Las pruebas que he hecho demuestran que, dependiendo del gif cargado, la visualización puede ser desde muy mala hasta perfecta, pasando por todas las demás calificaciones.

De momento os dejo esta versión que al menos funciona. La version original me daba error en alguna línea y haciendo lo mismo en 4 líneas no lo dá. Aún no lo he llegado a entender. ¡Ah! y le faltaba un End If a la sub del timer

He incluido los comentarios, si no del creador al menos de quien la publicó, en inglés y con traducción google para que mas o menos os entereis.

Hay que crear un formulario con 2 cosas:
Un control Image (Image1) CON EL VALOR INDEX = 0
osea una matriz de controles Image con el nombre Image1
Un Timer (Timer1)

Y como código ponemos esto:
NOTA: Del código solo hay que cambiar el camino y nombre del gif que quieres cargar.
NOTA2: No se me permite un mensaje tan largo. La Sub del Timer1 la pondré en otro mensaje a continuación.

Código :

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
 
'place the path to the gif you want to animate here
'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
 
Private Sub DecodeGif(PathToGifFile As String)
On Error GoTo DecodeGifError
 
'declare procedural variables
'Declarar variables de procedimiento
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
 
'make sure we have something to work with
'asegurarnos de que tenemos algo con que trabajar
If Dir(PathToGifFile) = vbNullString Then
  MsgBox "Dónde está el GIF!?"
  Exit Sub
End If
 
'disable timer
'temporizador desactivar
Timer1.Enabled = False
 
'if you were to change this demo so other gifs could be displayed in this array then you would need to unload all but the origional
'Si tuviera que cambiar esta demostración para que los gifs otras podrían ser mostradas en esta matriz, entonces usted tendría que descargar todos, pero el original
For I = 1 To Image1.Count - 1
  Unload Image1(I)
Next I
 
'set value(s)
'valor de referencia (s)
SectionMarker = Chr(0) & "!ù"
SectionStart = 1
 
'open our gif, read it in, close it out
'abrir nuestro gif, leído en, cerca de fuera
FNumb = FreeFile
Open PathToGifFile For Binary As #FNumb
GifBuffer = Input(FileLen(PathToGifFile), #FNumb)
Close #FNumb
 
'get where this (the header info) ends
'llegar a donde esta (la información de encabezado) termina
SectionEnd = InStr(SectionStart, GifBuffer, SectionMarker) + Len(SectionMarker) - 2
 
'retrieve the header
'recuperar la cabecera
GifHeader = Left(GifBuffer, SectionEnd)
 
'set where the next section starts at
'establecida en la siguiente sección se inicia en
SectionStart = SectionEnd + 2
 
'check the length of the header for extended information
'control de la longitud de la cabecera de información ampliada
If Len(GifHeader) > 127 Then
  NumberOfTimesToRepeatSequence = Asc(Mid(GifHeader, 127, 1))
  NumberOfTimesToRepeatSequence = NumberOfTimesToRepeatSequence * 256
  NumberOfTimesToRepeatSequence = NumberOfTimesToRepeatSequence + Asc(Mid(GifHeader, 126, 1))
Else
  NumberOfTimesToRepeatSequence = 0 'bucle infinito
End If
 
'now run through file an decode each frame
'ahora se ejecutan a través de un archivo de decodificar cada fotograma
Do While SectionEnd <> Len(SectionMarker)
 
'increase the count of images we have by 1
'aumentar el recuento de las imágenes que tenemos antes del 1 de
ImageCount = ImageCount + 1
 
'find out where the next section ends
'saber dónde termina la sección siguiente
SectionEnd = InStr(SectionStart, GifBuffer, SectionMarker) + Len(SectionMarker)
 
'check to make sure we have some information to use
'Asegúrese de que tenemos algo de información para uso
If SectionEnd > Len(SectionMarker) Then
 
  'create a single frame gif from this information
  'crear un gif solo cuadro de esta información
  NewPicBuff = GifHeader & Mid(GifBuffer, SectionStart - 1, SectionEnd - SectionStart)
  
  'now write it to file so we can use the load picture function on it
  'Ahora escribe a un archivo para que podamos usar la función de imagen de carga en ella
  FNumb = FreeFile
  Open App.Path & "\temp.gif" For Binary As #FNumb
  Put #FNumb, 1, NewPicBuff
  Close #FNumb
  
  'now extract some information about the file we just saved
  'ahora extraer alguna información sobre el archivo que acaba de guardar
  ImageHeader = Left(Mid(GifBuffer, SectionStart - 1, SectionEnd - SectionStart), 16)
  
  
  'now calcualte the time that the image we just saved is to be displayed
  'Ahora calcualte el momento en que la imagen que acaba de guardar se mostrará
  DisplayTime = Asc(Mid(ImageHeader, 5, 1))
  DisplayTime = DisplayTime * 256
  DisplayTime = DisplayTime + Asc(Mid(ImageHeader, 4, 1))
  DisplayTime = DisplayTime * 10
  
  'check to see if we have more than one image
  'verificación para ver si tenemos más de una imagen
  If ImageCount > 1 Then
  
    'retrieve offsets
    'Recuperar las compensaciones
    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 a new control and set its properties
    'carga un nuevo control y establecer sus propiedades
    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
  
  'set the amount of time that this frame of the gif image is to be displayed for and load the image
  'establecer la cantidad de tiempo que este marco de la imagen GIF es que se muestra a favor y cargar la imagen de
  Image1(ImageCount - 1).Tag = DisplayTime
  Image1(ImageCount - 1).Picture = LoadPicture(App.Path & "\temp.gif")
  
  'don't need it anymore so kill it
  'No lo necesitamos más y lo eliminamos
  Kill App.Path & "\temp.gif"
  
  SectionStart = SectionEnd
  
End If
 
Loop
 
If SectionStart < Len(GifBuffer) Then
 
  'create a single frame gif from this information
  'crear un gif solo cuadro de esta información
  NewPicBuff = GifHeader & Mid(GifBuffer, SectionStart - 1, Len(GifBuffer) - SectionStart)
  
  'now write it to file so we can use the load picture function on it
  'Ahora escribe a un archivo para que podamos usar la función de imagen de carga en ella
  FNumb = FreeFile
  Open App.Path & "\temp.gif" For Binary As #FNumb
  Put #FNumb, 1, NewPicBuff
  Close #FNumb
  
  'now extract some information about the file we just saved
  'ahora extraer alguna información sobre el archivo que acaba de guardar
  ImageHeader = Left(Mid(GifBuffer, SectionStart - 1, Len(GifBuffer) - SectionStart), 16)
  
  'now calcualte the time that the image we just saved is to be displayed
  'Ahora calcualte el momento en que la imagen que acaba de guardar se mostrará
  DisplayTime = Asc(Mid(ImageHeader, 5, 1))
  DisplayTime = DisplayTime * 256
  DisplayTime = DisplayTime + Asc(Mid(ImageHeader, 4, 1))
  DisplayTime = DisplayTime * 10
  
  'check to see if we have more than one image
  'verificación para ver si tenemos más de una imagen
  If ImageCount > 1 Then
  
    'retrieve offsets
    'Recuperar las compensaciones
    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 a new control and set its properties
    'carga un nuevo control y establecer sus propiedades
    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
  
  'set the amount of time that this frame of the gif image is to be displayed for and load the image
  'establecer la cantidad de tiempo que este marco de la imagen GIF es que se muestra a favor y cargar la imagen de
  Image1(ImageCount - 1).Tag = DisplayTime
  Image1(ImageCount - 1).Picture = LoadPicture(App.Path & "\temp.gif")
  
  'don't need it anymore so kill it
  'No lo necesitamos más y lo eliminamos
  Kill App.Path & "\temp.gif"
  
End If
 
'set our variables that we will use to keep track of which frame of the animation we are on
'conjunto nuestras variables que vamos a utilizar para hacer un seguimiento de qué fotograma de la animación que estamos en
ImgCnt = 0
MaxCnt = Image1.Count - 1
 
'set up the timer
'configurar el reloj
Timer1.Interval = CInt(Image1(0).Tag)
Timer1.Enabled = True
 
Exit Sub
DecodeGifError:
 
MsgBox Err.Description
 
End Sub
 

continuará...