PARA DAVID EL GRANDE (PONER GIF ACÁ TE DEJO COMO SE HACE :p)

[aldo1982]

Iniciado por LeandroA

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

exelente aporte, si fera vos lo pondria en las FAQs mas hayá de con el control ocx se escribe menos código :P