【源码】vb6实现gif动画显示

很好用的纯代码GIF动画显示控件

===================================

一款具有完整功能的显示GIF图片的开源控件，显示速度不错。无窗体，数据流小而且属于轻量级，可以任意加载到自己的程序中直接使用。支持播放、暂停、单帧步进，以及翻转动画，镜像显示以及灰度调整。适合显示动画帧数不是很多的GIF动画，很流畅。另外还支持远程网络位置显示GIF，类似一些加广告的软件中一些动画广告。

来自newxing的示例：

'Download by http://www.NewXing.com
 
Option Explicit

Private Sub chkModClrTbl2_Click()
    
    
    Dim P As Long, pEntries() As Long
    Dim R As Integer, G As Integer, B As Integer, E As Long
    
    If chkModClrTbl2 Then
        
        ucAniGIF(0).CacheColorTables                                            ' 缓存原始颜色数据，稍后可以恢复调用
        
        For P = 0 To ucAniGIF(0).FrameCount
            If ucAniGIF(0).GetPalette(P, pEntries()) = True Then
                
                For E = 0 To UBound(pEntries)
                    ' 使用简单的平均灰度创建
                    B = (pEntries(E) And &HFF)
                    G = ((pEntries(E) \ &H100) And &HFF)
                    R = ((pEntries(E) \ &H10000) And &HFF)
                    B = (B + G + R) \ 3
                    pEntries(E) = RGB(B, B, B)
                    
                Next
                ucAniGIF(0).SetPalette P, pEntries()
            End If
        Next
    Else
        
        ucAniGIF(0).RestoreColorTables True                                     ' 还原缓存的颜色并释放内存
        If ucAniGIF(0).Action <> gfaPlay Then ucAniGIF(0).Refresh
        
    End If
    
End Sub

Private Sub chkModPal_Click()
    
    
    Dim P As Long, pEntries() As Long
    Dim R As Integer, G As Integer, B As Integer, E As Long
    
    For P = 0 To ucAniGIF(2).FrameCount
        If ucAniGIF(2).GetPalette(P, pEntries()) = True Then
            
            For E = 0 To UBound(pEntries)
                ' RGB 颜色倒转. 切记调色板是BGR，不是RGB
                B = (pEntries(E) And &HFF) Xor 255
                G = ((pEntries(E) \ &H100) And &HFF) Xor 255
                R = ((pEntries(E) \ &H10000) And &HFF) Xor 255
                
                pEntries(E) = RGB(B, G, R)
                
            Next
            ucAniGIF(2).SetPalette P, pEntries()
        End If
    Next
    
End Sub

Private Sub chkSolidBkg_Click()
    If chkSolidBkg = vbChecked Then
        ucAniGIF(1).SolidBkgColor = vbCyan
        ucAniGIF(1).SolidBkgColorUsed = True
    Else
        ucAniGIF(1).SolidBkgColorUsed = False
    End If
End Sub

Private Sub Command1_Click(Index As Integer)
    Dim I As Integer, Action As AnimationActions
    Select Case Index
    Case 0: Action = gfaStop
    Case 1: Action = gfaPause
    Case 2: Action = gfaForward
    Case 3: Action = gfaPlay
    End Select
    For I = ucAniGIF.LBound To ucAniGIF.UBound
        ucAniGIF(I).Action = Action
    Next
End Sub

Private Sub chkMirror_Click()
    Dim I As Integer
    For I = ucAniGIF.LBound To ucAniGIF.UBound  ' 触发水平镜像
        ucAniGIF(I).Mirrored = ucAniGIF(I).Mirrored Xor gfmHorizontal
    Next
End Sub

Private Sub Command2_Click()
    
    ucAniGIF(3).LoadAnimatedGIF_Remote "http://www.animation-station.com/insects/insect_animations/bee_with_construction_hat.gif"
    ' 可以使用远程服务器路径，如： \\myserver\my pictures\mygif.gif 或者其他硬盘路径
End Sub

Private Sub Command3_Click()
    Form2.Show
End Sub

Private Sub Form_Load()
    chkMirror.BackColor = Me.BackColor
    chkModPal.BackColor = Me.BackColor
    chkModClrTbl2.BackColor = Me.BackColor
    chkSolidBkg.BackColor = Me.BackColor
    Command2.ToolTipText = "GIF 链接地址 http://www.animation-station.com/insects/insect_animations/bee_buzzing_flowers.gif"
End Sub

Private Sub Form_Resize()
    ' 最小化时暂停动画，减少资源开销
    Dim I As Integer
    Dim oldAction As AnimationActions, newAction As AnimationActions
    
    If Me.WindowState = vbMinimized Then
        oldAction = gfaPlay
        newAction = gfaPause
    Else
        oldAction = gfaPause
        newAction = gfaPlay
    End If
    
    For I = ucAniGIF.LBound To ucAniGIF.UBound
        If ucAniGIF(I).Action = oldAction Then ucAniGIF(I).Action = newAction
    Next
    
End Sub

Private Sub ucAniGIF_FrameChanged(Index As Integer, ByVal FrameIndex As Long, viaTimer As Boolean)
    
    If Index = 2 Then lblFrame(Index).Caption = "帧 " & FrameIndex
    'lblFrame(Index).Caption = "帧 " & FrameIndex
End Sub

Private Sub ucAniGIF_LoopsEnded(Index As Integer)
    ucAniGIF(Index).Action = gfaReset ' 仅重启
End Sub

'从远程 URL加载GIF成功
Private Sub ucAniGIF_RemoteLoadComplete(Index As Integer, ByVal gifWidth As Single, ByVal gifHeight As Single, ByRef Cancel As Boolean)
    Command2.Enabled = False
    
    With ucAniGIF(Index)
        Set .AnimatedGIF = Nothing                                              ' 删除以前的形象在不断变化的属性
        .Stretch = gfsActualSize                                                ' 缩放比例
        .DelayAnimation = gfdNone                                               ' 延时方式
        .Mirrored = gfmNone                                                     ' 镜像选项
        .Enabled = True                                                         ' 激活
    End With                                                                    ' 下一步，图像处理和显示
    
End Sub

'如果从远程 URL加载GIF失败
Private Sub ucAniGIF_RemoteLoadFailure(Index As Integer)
    ' 当使用 LoadAnimatedGIF_Remote远程调用图片时, 如果服务器不成功返回文件则出现此事件
    Command2.Enabled = False
End Sub

'Download by http://www.NewXing.com
 
Option Explicit

Private gifDirection As Long

Private Sub Form_Load()
    gifDirection = 8                                                            '
    Me.ScaleMode = vbPixels
    Set Image1.Picture = Form1.Picture1.Picture
    Show
    ucAniGIF1.SteppedDelay = 50
End Sub

Private Sub Form_Resize()
    If Me.WindowState = vbMinimized Then
        ucAniGIF1.Action = gfaPause
    ElseIf ucAniGIF1.Action = gfaPause Then
        ucAniGIF1.Action = gfaPlay
    End If
End Sub

Private Sub ucAniGIF1_FrameChanged(ByVal FrameIndex As Long, viaTimer As Boolean)
    If viaTimer Then
        ucAniGIF1.Left = ucAniGIF1.Left + gifDirection
        If ucAniGIF1.Left + ucAniGIF1.Width > Me.ScaleWidth Then
            ucAniGIF1.Action = gfaStop
            ucAniGIF1.Mirrored = gfmHorizontal
            ucAniGIF1.Left = ScaleWidth - ucAniGIF1.Width
            gifDirection = -gifDirection
            ucAniGIF1.Action = gfaPlay
        ElseIf ucAniGIF1.Left < 0 Then
            ucAniGIF1.Action = gfaStop
            ucAniGIF1.Mirrored = gfmNone
            gifDirection = -gifDirection
            ucAniGIF1.Action = gfaPlay
        End If
    End If
End Sub

Private Sub ucAniGIF1_LoopsEnded()
    ucAniGIF1.Action = gfaReset
End Sub

Views: 54