voy a colocar el código que había descargado antes de que lo borraran.
Insertar en el un formulario 2 commandbuton un timer y un image1(0) (matriz de control para ello en la propidedad index del image poner 0)
Código:
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 Declare Function SendMessage Lib "user32" _ Alias "SendMessageA" _ (ByVal hwnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ lParam As Any) As Long Private TotalFrames As Long Private RepeatTimes As Long Private Sub Command1_Click() Dim nFrames As Long '-------Remplazar la ruta del gif animado-------- nFrames = LoadGif("D:\Mis documentos\Visual Basic Proyectos\Otros\giff\a005_093.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 'magic string signifying end of 'header and end of a gif frame 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 'load the gif into a string buffer 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 'create a temporary file in the current directory hFile = FreeFile Open "temp.gif" For Binary As hFile 'split out each frame of the gif, and 'write each the frame to the temporary file. 'Then load an image control for the frame, 'and load the temp file into that control. Do 'increment counter nImgCount = nImgCount + 1 'locate next frame end j = InStr(i, sBuff, sGifMagic) + 3 'another check If j > Len(sGifMagic) Then 'pad an output string, fill with the 'frame info, and write to disk. A header 'needs to be added as well, to assure 'LoadPicture recognizes it as a gif. 'Since VB's LoadPicture command ignores 'header info and loads animated gifs as 'static, we can safely reuse the header 'extracted above. sPicsBuff = String(Len(sFileHeader) + j - i, Chr$(0)) sPicsBuff = sFileHeader & Mid(sBuff, i - 1, j - i) Put #hFile, 1, sPicsBuff 'The first part of the 'extracted data is frame info sImgHeader = Left(Mid(sBuff, i - 1, j - i), 16) 'embedded in the frame info is a 'field that represents the frame delay TimeWait = ((Asc(Mid(sImgHeader, 4, 1))) + _ (Asc(Mid(sImgHeader, 5, 1)) * 256&)) * 10& 'assign the data. If nImgCount > 1 Then 'if this is the second or later 'frame, load an image control 'for the frame Load aImg(nImgCount - 1) 'the frame header also contains 'the x and y offsets of the image 'in relation to the first (0) image. xOff = Asc(Mid(sImgHeader, 9, 1)) + _ (Asc(Mid(sImgHeader, 10, 1)) * 256&) yOff = Asc(Mid(sImgHeader, 11, 1)) + _ (Asc(Mid(sImgHeader, 12, 1)) * 256&) 'position the image controls at 'the required position aImg(nImgCount - 1).Left = aImg(0).Left + _ (xOff * Screen.TwipsPerPixelX) aImg(nImgCount - 1).Top = aImg(0).Top + _ (yOff * Screen.TwipsPerPixelY) End If 'use each control's .Tag property to 'store the frame delay period, and 'load the picture into the image control. aImg(nImgCount - 1).Tag = TimeWait aImg(nImgCount - 1).Picture = LoadPicture("temp.gif") 'update pointer i = j End If 'when the j = Instr() command above returns 0, '3 is added, so if j = 3 there was no more 'data in the header. We're done. Loop Until j = 3 'close and nuke the temp file 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
porfa, organícenlo bien.