Ver Mensaje Individual
  #2 (permalink)  
Antiguo 01/09/2009, 21:43
ingenius
 
Fecha de Ingreso: agosto-2009
Mensajes: 19
Antigüedad: 9 años, 1 mes
Puntos: 0
Respuesta: ¿Como puedo ingresar una imagen GIF en visual basic?

teniendo en el formulario
un timer
un control image con index en 0
y un boton

pega este 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 TotalFrames As Long
Private RepeatTimes As Long

Private Sub Command1_Click()
Dim nFrames As Long
nFrames = LoadGif("C:\Imagen.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

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

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

hFile = FreeFile
Open "temp.gif" For Binary As hFile

Do

nImgCount = nImgCount + 1

j = InStr(i, sBuff, sGifMagic) + 3

If j > Len(sGifMagic) Then

sPicsBuff = String(Len(sFileHeader) + j - i, Chr$(0))
sPicsBuff = sFileHeader & Mid(sBuff, i - 1, j - i)
Put #hFile, 1, sPicsBuff

sImgHeader = Left(Mid(sBuff, i - 1, j - i), 16)

TimeWait = ((Asc(Mid(sImgHeader, 4, 1))) + _
(Asc(Mid(sImgHeader, 5, 1)) * 256&)) * 10&

If nImgCount > 1 Then
Load aImg(nImgCount - 1)
xOff = Asc(Mid(sImgHeader, 9, 1)) + _
(Asc(Mid(sImgHeader, 10, 1)) * 256&)

yOff = Asc(Mid(sImgHeader, 11, 1)) + _
(Asc(Mid(sImgHeader, 12, 1)) * 256&)

aImg(nImgCount - 1).Left = aImg(0).Left + _
(xOff * Screen.TwipsPerPixelX)
aImg(nImgCount - 1).Top = aImg(0).Top + _
(yOff * Screen.TwipsPerPixelY)

End If

aImg(nImgCount - 1).Tag = TimeWait
aImg(nImgCount - 1).Picture = LoadPicture("temp.gif")

i = j
End If
Loop Until j = 3

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