[讨论]关于gif文件

egxsun 2003-10-09 12:53:41

下面是从网上找的读取gif文件并在图片框（数组）中显示的函数代码，在代码中用GifEnd = Chr(0) & Chr(33) & Chr(249)分割，结果不对。请那位帮我分析并修改一下。

'In Module

Option Explicit
Public RepeatTimes As Long
Public TotalFrames As Long
Public Function LoadGif(sFile As String, aImg As Variant) As Boolean
LoadGif = False
If Dir$(sFile) = "" Or sFile = "" Then
MsgBox "File " & sFile & " not found", 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 'Get GIF File into buffer
Close fNum

i = 1
imgCount = 0
j = InStr(1, buf, GifEnd) + 1
fileHeader = Left(buf, j)
If UCase(Left$(fileHeader, 3)) <> "GIF" Then
MsgBox "This file is not a *.gif file", 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 ' Split GIF Files at separate pictures
' and load them into Image Array
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
' Use .Tag Property to save TimeWait interval for separate Image
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 there are one more Image - Load it
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 & " when reading file", vbCritical
LoadGif = False
On Error GoTo 0
End Function

'In form
Dim FrameCount As Long

Private Sub Command1_Click()
Timer1.Enabled = False
If LoadGif(Text1.Text, 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"
'Text1.Text = App.Path & IIf(Right(App.Path, 1) = "\", "", "\") & "clip.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

...全文