| una forma de ver giff animados sin utilizar ocx,y mediante codigo:
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:
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 |