Siempre me ha gustado no depender de ocx. Ya que las mismas deben ser registradas y encontrarse en la pc que se ejecute la aplicación. Y he dedicado parte de mi tiempo en busca de códigos que me quiten de encima las famosas ocx que tanto usamos en nuestros programas. Y en la búsqueda encontré este código para reproducir un gif.
Controles.
----------------------------------
1- Image con la propiedad name=AnimatedGIF y con Index=0
2-CommandButton con la propiedad name=btnPlay
3-Timer con la propiedad name=AnimationTimer
4-TextBox con la propiedad name=txFile
Copiar este codigo:
---------------------------
Dim RepeatTimes&
Dim RepeatCount&
Private Sub btnPlay_Click()
Call LoadAniGif(txFile.Text, AnimatedGIF)
End Sub
Sub LoadAniGif(xFile As String, xImgArray)
If Not IIf(Dir$(xFile) = "", False, True) Or xFile = "" Then
MsgBox "File not found.", vbExclamation, "File Error"
Exit Sub
End If
Dim F1, F2
Dim AnimatedGIFs() 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) & "!ù"
AnimationTimer.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 '+ 1
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
AnimationTimer.Interval = CInt(xImgArray(0).Tag)
badTime:
AnimationTimer.Enabled = True
Exit Sub
badFile:
MsgBox "File not found.", vbExclamation, "File Error"
End Sub
Private Sub AnimationTimer_Timer()
For i = 0 To AnimatedGIF.Count
If i = AnimatedGIF.Count Then
If RepeatTimes > 0 Then
RepeatCount = RepeatCount + 1
If RepeatCount > RepeatTimes Then
AnimationTimer.Enabled = False
Exit Sub
End If
End If
For j = 1 To AnimatedGIF.Count - 1
AnimatedGIF(j).Visible = False
Next j
On Error GoTo badTime
AnimationTimer.Interval = CLng(AnimatedGIF(0).Tag)
badTime:
Exit For
End If
If AnimatedGIF(i).Visible = False Then
AnimationTimer.Interval = CLng(AnimatedGIF(i).Tag)
On Error GoTo badTime2
AnimatedGIF(i).Visible = True
badTime2:
Exit For
End If
Next i
End Sub
Private Sub Form_Load()
Call LoadAniGif(txFile.Text, AnimatedGIF)
End Sub
