Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/animat3a/frmanigi.frm

Visual Basic Form | 1999-10-17 | 5.7 KB | 166 lines

VERSION 5.00
Begin VB.Form frmMain
   Caption         =   "Animated GIF"
   ClientHeight    =   1905
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6195
   LinkTopic       =   "Form1"
   ScaleHeight     =   1905
   ScaleWidth      =   6195
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox txFile
      Height          =   330
      Left            =   165
      TabIndex        =   1
      Top             =   150
      Width           =   3780
   End
   Begin VB.Timer AnimationTimer
      Interval        =   1000
      Left            =   195
      Top             =   555
   End
   Begin VB.CommandButton btnPlay
      Caption         =   "PLAY"
      Height          =   465
      Left            =   4200
      TabIndex        =   0
      Top             =   105
      Width           =   1380
   End
   Begin VB.Image AnimatedGIF
      Appearance      =   0  'Flat
      Height          =   900
      Index           =   0
      Left            =   855
      Top             =   615
      Width           =   1500
   End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim RepeatTimes&
Dim RepeatCount&
Private Sub btnPlay_Click()

    Call LoadAniGif(txFile.Text, AnimatedGIF)
End Sub
Sub LoadAniGif(xFile As String, xImgArray)
    If Not IIf(Dir$(xFile) = "", False, True) Or xFile = "" Then
        MsgBox "File not found.", vbExclamation, "File Error"
        Exit Sub
    End If

    Dim F1, F2
    Dim AnimatedGIFs() As String
    Dim imgHeader As String
    Static buf$, picbuf$
    Dim fileHeader As String
    Dim imgCount
    Dim i&, j&, xOff&, yOff&, TimeWait&
    Dim GifEnd
    GifEnd = Chr(0) & "!
    AnimationTimer.Enabled = False
    For i = 1 To xImgArray.Count - 1
        Unload xImgArray(i)
    Next i
    F1 = FreeFile
On Error GoTo badFile:
    Open xFile For Binary Access Read As F1
        buf = String(LOF(F1), Chr(0))
        Get #F1, , buf
    Close F1
    i = 1
    imgCount = 0
    j = (InStr(1, buf, GifEnd) + Len(GifEnd)) - 2
    fileHeader = Left(buf, j)
    i = j + 2
    RepeatTimes& = Asc(Mid(fileHeader, 126, 1)) + (Asc(Mid(fileHeader, 127, 1)) * 256)
    Do
        imgCount = imgCount + 1
        j = InStr(i, buf, GifEnd) + Len(GifEnd)
        If j > Len(GifEnd) Then
            F2 = FreeFile
            Open "tmp.gif" For Binary As F2
                picbuf = String(Len(fileHeader) + j - i, Chr(0))
                picbuf = fileHeader & Mid(buf, i - 1, j - i)
                Put #F2, 1, picbuf
                imgHeader = Left(Mid(buf, i - 1, j - i), 16)
            Close F2

            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)) * 2561)
                Load xImgArray(imgCount - 1)
                xImgArray(imgCount - 1).ZOrder 0
                xImgArray(imgCount - 1).Left = xImgArray(0).Left + (xOff * 15)
                xImgArray(imgCount - 1).Top = xImgArray(0).Top + (yOff * 15)
            End If
            xImgArray(imgCount - 1).Tag = TimeWait
            xImgArray(imgCount - 1).Picture = LoadPicture("tmp.gif")
            Kill ("tmp.gif")

            i = j '+ 1
        End If
    Loop Until j = Len(GifEnd)
    If i < Len(buf) Then
        F2 = FreeFile
        Open "tmp.gif" For Binary As F2
            picbuf = String(Len(fileHeader) + Len(buf) - i, Chr(0))
            picbuf = fileHeader & Mid(buf, i - 1, Len(buf) - i)
            Put #F2, 1, picbuf
            imgHeader = Left(Mid(buf, i - 1, Len(buf) - i), 16)
        Close F2
        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)) * 2561)
            Load xImgArray(imgCount - 1)
            xImgArray(imgCount - 1).ZOrder 0
            xImgArray(imgCount - 1).Left = xImgArray(0).Left + (xOff * 15)
            xImgArray(imgCount - 1).Top = xImgArray(0).Top + (yOff * 15)
        End If
        xImgArray(imgCount - 1).Tag = TimeWait
        xImgArray(imgCount - 1).Picture = LoadPicture("tmp.gif")
        Kill ("tmp.gif")
    End If
On Error GoTo badTime
    AnimationTimer.Interval = CInt(xImgArray(0).Tag)
badTime:
    AnimationTimer.Enabled = True
Exit Sub
badFile:
    MsgBox "File not found.", vbExclamation, "File Error"
End Sub
Private Sub AnimationTimer_Timer()
    For i = 0 To AnimatedGIF.Count
        If i = AnimatedGIF.Count Then
            If RepeatTimes > 0 Then
                RepeatCount = RepeatCount + 1
                If RepeatCount > RepeatTimes Then
                    AnimationTimer.Enabled = False
                    Exit Sub
                End If
            End If
            For j = 1 To AnimatedGIF.Count - 1
                AnimatedGIF(j).Visible = False
            Next j
On Error GoTo badTime
            AnimationTimer.Interval = CLng(AnimatedGIF(0).Tag)
badTime:
            Exit For
        End If
        If AnimatedGIF(i).Visible = False Then
            AnimationTimer.Interval = CLng(AnimatedGIF(i).Tag)
On Error GoTo badTime2
            AnimatedGIF(i).Visible = True
badTime2:
            Exit For
        End If
    Next i
End Sub