> ' Play all the images of a GIF animation once.
> Private Sub PlayGIF()
> Dim graphics As Long, img As Long, dID As CLSID
> Dim frameCount As Long, arDelay() As Long, delay As Long
> Dim lngHeight As Long, lngWidth As Long
> Dim i As Long, item() As PropertyItem, totalBufferSize As Long
> ' Initializations
> Call GdipCreateFromHDC(Me.hdc, graphics) ' Create a graphics
> object for drawing
> Call GdipLoadImageFromFile(....., img)
> ' Get the image height and width
> Call GdipGetImageHeight(img, lngHeight)
> Call GdipGetImageWidth(img, lngWidth)
> ' Load all of the needed information
> ' NOTE: Since GIF images are animations, they are stored in the Time
> dimension
> GetDimensionGUID FrameDimensionTime, dID ' Get the GUID of the frame
> dimension we will be looking at
> Call GdipImageGetFrameCount(img, dID, frameCount)
> ' Get the frame delay counts
> ' To get the delay times, we must delve into the property items.
> ' I'm going to over-dim the PropertyItem array instead of some fancy
> malloc type API or a Byte array and CopyMemory.
> ' See if the buffer size retrieval went well.
> If GdipGetPropertyItemSize(img, PropertyTagFrameDelay, totalBufferSize)
> <> Ok Then
> MsgBox "Image file not found, could not get the property buffer
size,
> or property not found. Cannot continue!"
> Else
> ' Allocate the number of structures we need
> ' NOTE: The totalBufferSize does not usually equal (Len(PropertyItem
)
> * numProperties)!
> ReDim item(0) ' We need this to calculate the size of each
> PropertyItem.
> ' Determine how many items we need. Note that the value is rounded
> down.
> ' NOTE: Could also use Len(), but I was getting a higher number of
> structures which were not used for some reason...
> i = totalBufferSize / LenB(item(0))
> ' NOTE: Since 0 is the lowest array index in this function, we need
> not add an extra one to the
> ' result due to the way VB handles arrays.
> ReDim item(0 To i)
> ' NOTE: You should check the resulting status codes for errors.
> Call GdipGetPropertyItem(img, PropertyTagFrameDelay,
totalBufferSize,
> item(0))
> ' Save the delay times
> ' The returned array will be one-based...ugh - no uniformity!
> arDelay = GetPropValue(item(0))
> End If
> ' Display the number of frames for fun
> Debug.Print "Frames: " & frameCount
> ' Loop through the frames
> ' NOTE: We are assuming all frames are in this one dimension, as there
> can be several dimensions.
> ' ALSO: The frames are zero-based, while the count we retrieved is
> one-based.
> For i = 0 To frameCount - 1
> ' Select the current frame into the image object
> Call GdipImageSelectActiveFrame(img, dID, i)
> ' Now draw that frame
> Call GdipDrawImageRectI(graphics, img, 0, 0, lngWidth, lngHeight)
> ' Delay
> ' NOTE: You should use the Multimedia Timer Functions for production
> apps.
> delay = GetTickCount
> Do While GetTickCount < delay + arDelay(i + 1)
> DoEvents ' This is probably not the best stalling technique
> Loop
> Next
> ' Cleanup
> Erase arDelay
> Erase item
> Call GdipDisposeImage(img)
> Call GdipDeleteGraphics(graphics)
> End Sub
> '---------------------------------------------------------------------
> ' Might want to place the below in a module
> '---------------------------------------------------------------------
> ' CLSIDs (aka GUIDs) used with some Frame APIs:
> ' NOTE: You won't find this enum in the GDI+ Docs. It was created as
> ' part of the workaround for the constant GUID problem.
> Public Enum FrameDimensionGUIDs
> FrameDimensionTime
> FrameDimensionResolution
> FrameDimensionPage
> End Enum
> ' This function was created as a workaround to the problem of not being
> ' able to declare the GUID constants for the FrameDimension GUIDs.
> ' If there is a better way, let me know and/or fix it!
> Public Sub GetDimensionGUID(ByVal GUIDType As FrameDimensionGUIDs, GUID As
> CLSID)
> Select Case GUIDType
> Case FrameDimensionTime:
> GUID.Data1 = &H6AEDBD6D
> GUID.Data2 = &H3FB5
> GUID.Data3 = &H418A
> GUID.Data4(0) = &H83
> GUID.Data4(1) = &HA6
> GUID.Data4(2) = &H7F
> GUID.Data4(3) = &H45
> GUID.Data4(4) = &H22
> GUID.Data4(5) = &H9D
> GUID.Data4(6) = &HC8
> GUID.Data4(7) = &H72
> Case FrameDimensionResolution:
> GUID.Data1 = &H84236F7B
> GUID.Data2 = &H3BD3
> GUID.Data3 = &H428F
> GUID.Data4(0) = &H8D
> GUID.Data4(1) = &HAB
> GUID.Data4(2) = &H4E
> GUID.Data4(3) = &HA1
> GUID.Data4(4) = &H43
> GUID.Data4(5) = &H9C
> GUID.Data4(6) = &HA3
> GUID.Data4(7) = &H15
> Case FrameDimensionPage:
> GUID.Data1 = &H7462DC86
> GUID.Data2 = &H6180
> GUID.Data3 = &H4C7E
> GUID.Data4(0) = &H8E
> GUID.Data4(1) = &H3F
> GUID.Data4(2) = &HEE
> GUID.Data4(3) = &H73
> GUID.Data4(4) = &H33
> GUID.Data4(5) = &HA7
> GUID.Data4(6) = &HA4
> GUID.Data4(7) = &H83
> End Select
> End Sub
> ' This should hopefully simplify property item value retrieval
> ' NOTE: We are raising errors in this function; ensure the caller has
error
> handing code.
> ' The resulting arrays are using a base of one.
> Public Function GetPropValue(item As PropertyItem) As Variant
> ' We need a valid pointer and length
> If item.value = 0 Or item.length = 0 Then Err.Raise 5, "GetPropValue"
> Select Case item.type
> ' We'll make Undefined types a Btye array as it seems the safest
> choice...
> 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: Err.Raise 461, "GetPropValue"
> End Select
> End Function
> '-----------------------------------------------------------------------
> I hate that GUID function retrieval thing, but alas! No one ever told
me
> a better way... This is probably a very bad example, but hopefully you'll
> get something out of it. If you are using the declarations in the example
> you mentioned, you should be able to paste all of the above somewhere and
> get it working after you declare the GetTickCount API and fill in the
> filename.
> Hope this helps,
> Avery
> > I wonder if anyone can give me some examples showing how to play
animated
> > GIF file in VB using pure GDI+. This is very hard for me that I don't
know
> > how to translate the C-style declarations to VB even though I have
already
> > studied the documentations from MSDN. I have seen some examples like the
> > "Use GDI+ ( aka GDIPlus ) with VB6!"
http://www.planetsourcecode.com/vb/scripts/ShowCode.asp?txtCodeId=375... > > Id=1 but this is just a graphic coding example, not the one I concern.
> > Thanks for yours helping