一步一步教你DIY属于自己的GIF控件

我们使用GDI+来绘图，其实方法很简单。


首先，先新建一个ActiveX控件工程，因为套用了M$预置的模板，直接一个控件界面出现在我们的眼前了。


我们的控件是不需要焦点的，我们先把CanGetFocus设为False，再把AutoDraw打开，此时你发现，能获取focus的控件都不能用了别担心，我们就在“控件”本身绘图就足够了。然后把scaleMode改成像素。


接下来是工程图标，我小小的做了一个，大概可能不太好看




OK接下来就是写代码了。
双击控件打开代码框。
既然要用GDI+，首先得申明API吧
声明如下API：
Private Declare Function CLSIDFromString Lib "ole32.dll" (ByVal lpszProgID As Long, pCLSID As CLSID) As Long
Private Declare Function GdiplusStartup Lib "gdiplus" (Token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As GpStatus
Private Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal Token As Long)
Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hdc As Long, graphics As Long) As GpStatus
Private Declare Function GdipLoadImageFromFile Lib "gdiplus" (ByVal filename As String, image As Long) As GpStatus
Private Declare Function GdipGetImageWidth Lib "gdiplus" (ByVal image As Long, Width As Long) As GpStatus
Private Declare Function GdipGetImageHeight Lib "gdiplus" (ByVal image As Long, Height As Long) As GpStatus
Private Declare Function GdipImageGetFrameCount Lib "gdiplus" (ByVal image As Long, dimensionID As CLSID, count As Long) As GpStatus
Private Declare Function GdipGetPropertyItemSize Lib "gdiplus" (ByVal image As Long, ByVal propId As Long, size As Long) As GpStatus
Private Declare Function GdipGetPropertyItem Lib "gdiplus" (ByVal image As Long, ByVal propId As Long, ByVal propSize As Long, buffer As PropertyItem) As GpStatus
Private Declare Function GdipImageSelectActiveFrame Lib "gdiplus" (ByVal image As Long, dimensionID As CLSID, ByVal frameIndex As Long) As GpStatus
Private Declare Function GdipDrawImageRectI Lib "gdiplus" (ByVal graphics As Long, ByVal image As Long, ByVal x As Long, ByVal y As Long, ByVal Width As Long, ByVal Height As Long) As GpStatus
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As GpStatus
Private Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal graphics As Long) As GpStatus
Private Declare Function GdipGetImageEncodersSize Lib "gdiplus" (numEncoders As Long, size As Long) As GpStatus
Private Declare Function GdipGetImageEncoders Lib "gdiplus" (ByVal numEncoders As Long, ByVal size As Long, encoders As Any) As GpStatus
Private Declare Function GdipGetImageDecodersSize Lib "gdiplus" (numDecoders As Long, size As Long) As GpStatus
Private Declare Function GdipGetImageDecoders Lib "gdiplus" (ByVal numDecoders As Long, ByVal size As Long, decoders As Any) As GpStatus
Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function lstrlenW Lib "kernel32" (ByVal psString As Any) As Long
Private Declare Function lstrlenA Lib "kernel32" (ByVal psString As Any) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)


要用到的常数：
Private Const PropertyTagTypeByte = 1
Private Const PropertyTagTypeUndefined = 7
Private Const PropertyTagTypeASCII = 2
Private Const PropertyTagTypeShort = 3
Private Const PropertyTagTypeLong = 4
Private Const PropertyTagTypeRational = 5
Private Const PropertyTagTypeSLONG = 9
Private Const PropertyTagTypeSRational = 10
Private Const PropertyTagFrameDelay = &H5100
Private Const FrameDimensionTime As String = "{6AEDBD6D-3FB5-418A-83A6-7F45229DC872}"


要用到的结构及枚举


Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long 
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type


Private Type CLSID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type


Private Type PropertyItem
propId As Long 
length As Long
type As Integer
value As Long 
End Type


Private Enum GpStatus
Ok = 0
GenericError = 1
InvalidParameter = 2
OutOfMemory = 3
ObjectBusy = 4
InsufficientBuffer = 5
NotImplemented = 6
Win32Error = 7
WrongState = 8
Aborted = 9
FileNotFound = 10
ValueOverflow = 11
AccessDenied = 12
UnknownImageFormat = 13
FontFamilyNotFound = 14
FontStyleNotFound = 15
NotTrueTypeFont = 16
UnsupportedGdiplusVersion = 17
GdiplusNotInitialized = 18
PropertyNotFound = 19
PropertyNotSupported = 20
End Enum


Private Enum ImageCodecFlags
ImageCodecFlagsEncoder = &H1
ImageCodecFlagsDecoder = &H2
ImageCodecFlagsSupportBitmap = &H4
ImageCodecFlagsSupportVector = &H8
ImageCodecFlagsSeekableEncode = &H10
ImageCodecFlagsBlockingDecode = &H20


ImageCodecFlagsBuiltin = &H10000
ImageCodecFlagsSystem = &H20000
ImageCodecFlagsUser = &H40000
End Enum


Private Type ImageCodecInfo
ClassID As CLSID
FormatID As CLSID
CodecName As Long 
DllName As Long 
FormatDescription As Long 
FilenameExtension As Long
MimeType As Long 
flags As ImageCodecFlags 
Version As Long
SigCount As Long
SigSize As Long
SigPattern As Long
SigMask As Long
End Type




声明完成后，就开始编写啦。


找到UserControl的Initialize和Terminate事件，我们要在这两个事件中加载和释放资源，创建和销毁GDI+的绘图对象。

 

同理在Terminate事件中，加载了什么，就要释放什么

 

那么这个控件的雏形就已经有了，接下来就是填充功能的时候了，我们要播放GIF，首先要载入GIF对吧，载入GIF使用GdipLoadImageFromFile。
我们写一个方法，载入图像

是不是觉得有点重复的代码在里面？我们把判断返回值的语句做成一个过程吧。

（因为这个不需要开发者使用，就用private声明）
OK，既然载入图像了，肯定有图像大小和容器长宽不符的情况，我们写两个过程，并添加一个属性，来自动缩放控件。属性的话，用property来声明。
使用GdipGetImageWidth/Height来获取，我只写了长度的，宽度的复制粘贴了一下啦。

 

既然要缩放控件，那么，做一个stretch属性。
当然，我们要在控件内部声明一个private的bool，来保存设定的属性。
Private bStretch as Boolean

其中Let是开发者给Stretch属性赋值的时候，触发的过程。Get是在获取Stretch的时候触发的过程。
既然要缩放，那么，我们要写控件的Resize事件

到现在，我们已经可以开始绘图了。
就写一个StartPlay事件吧。
要绘制GIF动画，我们要获取到他的帧和帧与帧之间的间隔。
首先我们要获取到gif的帧数，于是，写一个FrameCount属性吧。
声明一个CLSID，用来获取帧间隔。
Private gFrameCLSID As CLSID
然后在控件Init的事件中初始化这个CLSID
加入如下代码：

然后继续写我们的FrameCount，使用GdipImageGetFrameCount来获得

如果要播放，肯定是要获取到帧间隔的。


那么写个内部的sub获取帧间隔，然后写属性property让外部也可以获取到。
帧与帧之间的数据，GDI+已经帮我们读出来了，大可不必担心。
如果读取一个GIF文件，肯定是要准备好帧数据，那么，我们在之前写的LoadGIF中，写帧数据获取。
我们申明帧数据是一个数组，帧之间的延时是一个数组
Private gImageProp() As PropertyItem
Private lngDelay() As Long
=======================================

 

其中由于图像中存得有各种数据，所以需要一一分析。GetPropValue我在这里贴源代码吧。
Private Function PtrToStrA(ByVal lpsz As Long) As String
Dim sOut As String
Dim lLen As Long

lLen = lstrlenA(lpsz)
If (lLen > 0) Then
sOut = String$(lLen, vbNullChar)
Call CopyMemory(ByVal sOut, ByVal lpsz, lLen)
PtrToStrA = sOut
End If
End Function


Private Function PtrToStrW(ByVal lpsz As Long) As String
Dim sOut As String
Dim lLen As Long

lLen = lstrlenW(lpsz)
If (lLen > 0) Then
sOut = StrConv(String$(lLen, vbNullChar), vbUnicode)
Call CopyMemory(ByVal sOut, ByVal lpsz, lLen * 2)
PtrToStrW = StrConv(sOut, vbFromUnicode)
End If
End Function


Private Function GetPropValue(item As PropertyItem) As Variant
If item.value = 0 Or item.Length = 0 Then Err.Raise 5, "GetPropValue"

Select Case item.type
Case PropertyTagTypeByte, PropertyTagTypeUndefined:
Dim bte() As Byte: ReDim bte(1 To item.Length)
CopyMemory bte(1), ByVal item.value, item.Length
GetPropValue = bte
Erase bte

Case PropertyTagTypeASCII:
GetPropValue = PtrToStrA(item.value)

Case PropertyTagTypeShort:
Dim short() As Integer: ReDim short(1 To (item.Length / 2))
CopyMemory short(1), ByVal item.value, item.Length
GetPropValue = short
Erase short

Case PropertyTagTypeLong, PropertyTagTypeSLONG:
Dim lng() As Long: ReDim lng(1 To (item.Length / 4))
CopyMemory lng(1), ByVal item.value, item.Length
GetPropValue = lng
Erase lng

Case PropertyTagTypeRational, PropertyTagTypeSRational:
Dim lngpair() As Long: ReDim lngpair(1 To (item.Length / 8), 1 To 2)
CopyMemory lngpair(1, 1), ByVal item.value, item.Length
GetPropValue = lngpair
Erase lngpair

Case Else: Exit Function
End Select
End Function


还要写一个获取帧与帧之间属性的属性，就叫NextFramesDelay吧，写属性

 

 

差不多了，接下来就是绘制具体的帧啦，我们用GdipImageSelectActiveFrame和GdipDrawImageRectI来绘制。
我们写一个过程，叫PlayOnce来绘制，由于没啥返回值，就用Sub，还要做一个开关，叫
bPlayStatus。和一个long来存储当前帧
Private bPlayStatus as Boolean
Private lngNowFrame as long
这样一来，播放控制也有了。

这就是所有播放代码啦
如果想切换某一帧，那么可以写一个属性或者是方法。比如说作为一个属性：

如果还想在播放完之后触发事件，或者播放每一帧就触发事件，那么就：
首先要申明事件：

 

原文地址：http://tieba.baidu.com/p/3084272727

 

转载于:https://www.cnblogs.com/Matedo/p/4009139.html