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)
Codigo:

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.

Algunas tabulaciones no las he puesto, pero bueno

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

I need to put an animated gif but can not find the code php.5.3 support, you can help me?

I need to put an animated gif but can not find the code php.5.3 support, you can help me?


productora
telexfree

Hi Sam,

I would recommend you to take a look at php.net they could give you a hand overthere.

Muchas gracias