Bạn tạo một Form rồi tạo các đối tượng có trong đoạn code sau:(Đưa đường dẫn đến tập tin Gif cần chạy vào trong text box)
Dim FrameCount As Long
Private Sub Command1_Click()
Timer1.Enabled = False
If LoadGif(Text1, Image1) 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 Command3_Click()
Timer1.Enabled = True
End Sub
Private Sub Form_Load()
Text1.Text = App.Path & IIf(Right(App.Path, 1) = ``\``, ````, ``\``) & ``ball.gif``
Timer1.Enabled = False
End Sub
Private Sub Timer1_Timer()
If FrameCount < TotalFrames Then
Image1(FrameCount).Visible = False
FrameCount = FrameCount + 1
Image1(FrameCount).Visible = True
Timer1.Interval = CLng(Image1(FrameCount).Tag)
Else
FrameCount = 0
For i = 1 To Image1.Count - 1
Image1(i).Visible = False
Next i
Image1(FrameCount).Visible = True
Timer1.Interval = CLng(Image1(FrameCount).Tag)
End If
End Sub
Bạn tạo một Module rồi Paste đoạn code:
Option Explicit
Public TotalFrames As Long
Public Function LoadGif(sFile As String, aImg As Variant) As Boolean
LoadGif = False
If Dir$(sFile) = ```` Or sFile = ```` Then
MsgBox ``Tập tin `` & sFile & ``không tìm thấy.``, vbCritical
Exit Function
End If
On Error GoTo ErrHandler
Dim fNum As Integer
Dim imgHeader As String, fileHeader As String
Dim buf$, picbuf$
Dim imgCount As Integer
Dim i&, j&, xOff&, yOff&, TimeWait&
Dim GifEnd As String
GifEnd = Chr(0) & Chr(33) & Chr(249)
For i = 1 To aImg.Count - 1
Unload aImg(i)
Next i
fNum = FreeFile
Open sFile For Binary Access Read As fNum
buf = String(LOF(fNum), Chr(0))
Get #fNum, , buf 'Nạp tập tin vào trong Buffer
Close fNum
i = 1
imgCount = 0
j = InStr(1, buf, GifEnd) + 1
fileHeader = Left(buf, j)
If Left$(fileHeader, 3) <> ``GIF`` Then
MsgBox ``Đây không phải là tập tin dạng GIF``, vbCritical
Exit Function
End If
LoadGif = True
i = j + 2
If Len(fileHeader) >= 127 Then
RepeatTimes& = Asc(Mid(fileHeader, 126, 1)) + (Asc(Mid(fileHeader, 127, 1)) * 256&)
Else
RepeatTimes = 0
End If
Do ' Cắt ra thành từng frame
imgCount = imgCount + 1
j = InStr(i, buf, GifEnd) + 3
If j > Len(GifEnd) Then
fNum = FreeFile
Open ``temp.gif`` For Binary As fNum
picbuf = String(Len(fileHeader) + j - i, Chr(0))
picbuf = fileHeader & Mid(buf, i - 1, j - i)
Put #fNum, 1, picbuf
imgHeader = Left(Mid(buf, i - 1, j - i), 16)
Close fNum
TimeWait = ((Asc(Mid(imgHeader, 4, 1))) + (Asc(Mid(imgHeader, 5, 1)) * 256&)) * 10&
If imgCount > 1 Then
xOff = Asc(Mid(imgHeader, 9, 1)) + (Asc(Mid(imgHeader, 10, 1)) * 256&)
yOff = Asc(Mid(imgHeader, 11, 1)) + (Asc(Mid(imgHeader, 12, 1)) * 256&)
Load aImg(imgCount - 1)
aImg(imgCount - 1).Left = aImg(0).Left + (xOff * Screen.TwipsPerPixelX)
aImg(imgCount - 1).Top = aImg(0).Top + (yOff * Screen.TwipsPerPixelY)
End If
aImg(imgCount - 1).Tag = TimeWait
aImg(imgCount - 1).Picture = LoadPicture(``temp.gif``)
Kill (``temp.gif``)
i = j
End If
DoEvents
Loop Until j = 3
If i < Len(buf) Then
fNum = FreeFile
Open ``temp.gif`` For Binary As fNum
picbuf = String(Len(fileHeader) + Len(buf) - i, Chr(0))
picbuf = fileHeader & Mid(buf, i - 1, Len(buf) - i)
Put #fNum, 1, picbuf
imgHeader = Left(Mid(buf, i - 1, Len(buf) - i), 16)
Close fNum
TimeWait = ((Asc(Mid(imgHeader, 4, 1))) + (Asc(Mid(imgHeader, 5, 1)) * 256)) * 10
If imgCount > 1 Then
xOff = Asc(Mid(imgHeader, 9, 1)) + (Asc(Mid(imgHeader, 10, 1)) * 256)
yOff = Asc(Mid(imgHeader, 11, 1)) + (Asc(Mid(imgHeader, 12, 1)) * 256)
Load aImg(imgCount - 1)
aImg(imgCount - 1).Left = aImg(0).Left + (xOff * Screen.TwipsPerPixelX)
aImg(imgCount - 1).Top = aImg(0).Top + (yOff * Screen.TwipsPerPixelY)
End If
aImg(imgCount - 1).Tag = TimeWait
aImg(imgCount - 1).Picture = LoadPicture(``temp.gif``)
Kill (``temp.gif``)
End If
TotalFrames = aImg.Count - 1
Exit Function
ErrHandler:
MsgBox ``Error No. `` & Err.Number & `` khi đang đọc tập tin``, vbCritical
LoadGif = False
On Error GoTo 0
End Function