Hola BenRu
El problema es q no puedo utilizarlo en este proyecto en concreto, por lo q es un gran problema q todvia no sé cómo solucionar.
Habia visto un programa tuyo simulando el anigif, pero no lo entendí. No suelo trabajar con archivos binarios y lo q haces leyendo Strings de una imagen en binario, sinceramente no lo entiendo, aunque si pudieses explicarme t lo agradecería.
No necesito q el gif se anime con el tiempo, sino q yo lo controle indicandole cuando ha de pasar de un frame a otro.
El programa q encontré y q no entiendo es :
Se usa un control Image (con Index = 0 - previamente establecido para crear un array) y un Timer.
Código:
Dim RepeatTimes&
Dim RepeatCount&
Private Sub Form_Load()
LoadAniGif App.Path & "\Ejemplo.Gif", Image1 'El Gif a reproducir en el mismo directorio del programa
End Sub
Private Sub LoadAniGif(xFile As String, xImgArray)
Dim F1, F2
Dim Image1s() As String
Dim imgHeader As String
Static buf$, picbuf$
Dim fileHeader As String
Dim imgCount
Dim i&, j&, xOff&, yOff&, TimeWait&
Dim GifEnd
GifEnd = Chr(0) & "!ù"
Timer1.Enabled = False
For i = 1 To xImgArray.Count - 1
Unload xImgArray(i)
Next i
F1 = FreeFile
On Error GoTo badFile:
Open xFile For Binary Access Read As F1
buf = String(LOF(F1), Chr(0))
Get #F1, , buf
Close F1
i = 1
imgCount = 0
j = (InStr(1, buf, GifEnd) + Len(GifEnd)) - 2
fileHeader = Left(buf, j)
i = j + 2
RepeatTimes& = Asc(Mid(fileHeader, 126, 1)) + (Asc(Mid(fileHeader, 127, 1)) * 256)
Do
imgCount = imgCount + 1
j = InStr(i, buf, GifEnd) + Len(GifEnd)
If j > Len(GifEnd) Then
F2 = FreeFile
Open "tmp.gif" For Binary As F2
picbuf = String(Len(fileHeader) + j - i, Chr(0))
picbuf = fileHeader & Mid(buf, i - 1, j - i)
Put #F2, 1, picbuf
imgHeader = Left(Mid(buf, i - 1, j - i), 16)
Close F2
TimeWait = ((Asc(Mid(imgHeader, 4, 1))) + (Asc(Mid(imgHeader, 5, 1)) * 256)) * 10
If imgCount > 1 Then
xOff = Asc(Mid(imgHeader, 9, 1)) + (Asc(Mid(imgHeader, 10, 1)) * 256)
yOff = Asc(Mid(imgHeader, 11, 1)) + (Asc(Mid(imgHeader, 12, 1)) * 2561)
Load xImgArray(imgCount - 1)
xImgArray(imgCount - 1).ZOrder 0
xImgArray(imgCount - 1).Left = xImgArray(0).Left + (xOff * 15)
xImgArray(imgCount - 1).Top = xImgArray(0).Top + (yOff * 15)
End If
xImgArray(imgCount - 1).Tag = TimeWait
xImgArray(imgCount - 1).Picture = LoadPicture("tmp.gif")
Kill ("tmp.gif")
i = j
End If
Loop Until j = Len(GifEnd)
If i < Len(buf) Then
F2 = FreeFile
Open "tmp.gif" For Binary As F2
picbuf = String(Len(fileHeader) + Len(buf) - i, Chr(0))
picbuf = fileHeader & Mid(buf, i - 1, Len(buf) - i)
Put #F2, 1, picbuf
imgHeader = Left(Mid(buf, i - 1, Len(buf) - i), 16)
Close F2
TimeWait = ((Asc(Mid(imgHeader, 4, 1))) + (Asc(Mid(imgHeader, 5, 1)) * 256)) * 10
If imgCount > 1 Then
xOff = Asc(Mid(imgHeader, 9, 1)) + (Asc(Mid(imgHeader, 10, 1)) * 256)
yOff = Asc(Mid(imgHeader, 11, 1)) + (Asc(Mid(imgHeader, 12, 1)) * 2561)
Load xImgArray(imgCount - 1)
xImgArray(imgCount - 1).ZOrder 0
xImgArray(imgCount - 1).Left = xImgArray(0).Left + (xOff * 15)
xImgArray(imgCount - 1).Top = xImgArray(0).Top + (yOff * 15)
End If
xImgArray(imgCount - 1).Tag = TimeWait
xImgArray(imgCount - 1).Picture = LoadPicture("tmp.gif")
Kill ("tmp.gif")
End If
On Error GoTo badTime
Timer1.Interval = CInt(xImgArray(0).Tag)
badTime:
Timer1.Enabled = True
Exit Sub
badFile:
MsgBox "File not found.", vbExclamation, "File Error"
End Sub
Private Sub Timer1_Timer()
For i = 0 To Image1.Count
If i = Image1.Count Then
If RepeatTimes > 0 Then
RepeatCount = RepeatCount + 1
If RepeatCount > RepeatTimes Then
Timer1.Enabled = False
Exit Sub
End If
End If
For j = 1 To Image1.Count - 1
Image1(j).Visible = False
Next j
On Error GoTo badTime
Timer1.Interval = CLng(Image1(0).Tag)
badTime:
Exit For
End If
If Image1(i).Visible = False Then
Timer1.Interval = CLng(Image1(i).Tag)
On Error GoTo badTime2
Image1(i).Visible = True
badTime2:
Exit For
End If
Next i
End Sub