很好用的纯代码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: 34