BETA V3.3 Bug Fix by TCARI(Thomas) -Fixes resource leak and Fixed bug where current frame being rendered was processed with the wrong timer interval.

This update now handles Local Color Tables with separate Transparency colors for each frame. This Code is BETA and has not been cleaned up yet. I have been sitting on it for 6 months and just cannot seem to find the time to go back and clean it up. You go ahead and clean it!<grin> AnimatedGifLocalColorTables.zip

Version 2.5 - DO NOT USE THIS VERSION. USE 3.3 Above

Here's a complete rewrite of the Animated Gif Player. It is now a Class written completely in VB6, no 3'rd party DLL's required. For ease of use I have wrapped the Class in a UserControl. It only uses the BackColor and Device Context Handle props of the UserControl so you can easily substitute a PictureBox control if you wish. This Zip includes the Full VB6 source. Unfortunately, because of an Access BUG with Timers on a UserControl you cannot use this ActiveX control as is on an Access Form. Try it and everything works fine until you start moving your Mouse around. I just need to use the Access Form Timer instead of the Timer control I plonked on the UserControl. I've been stuck debugging this thing for a week because of an OS bug concerning DIBS,  OLE and the Standard Picture object. I'm going to take a break and work on some JPEG stuff. I'll come back and rewrite an Access specific version in a few weeks.

Version 2.0

Where's the Access  Source Code? 

Well here's the Visual Basic 6 Source code for now. I had to pick between the Access or the VB Source code to cleanup. I chose the VB code because now I can move ahead and create an Access friendly ActiveX Animated Gif Player. This VB source is not an ActiveX control. It's straight code to play Animated Gif files directly in a VB PictureBox Control. I will try and get the ActiveX Control done shortly.

AnimatedGifVB6Source.zip

NEW Ver 2  AnimatedGif.zip is a database containing a Class to allow for the playback of Animated Gif files in a standard Access Image Control. No  ActiveX controls or external DLL's are required.

This is a Version 2 release. Some Animated Gif files will not playback properly, particularly those with the Disposal Method of "restore to previous". I will add this later in the week. I'm storing the individual Gif frames as StdPicture objects so it is no problem to re-render the previous Frame.

Version Updates 2.0

Removes dependency for OLE reference

Handles Transparent Backgounds

Allows User defined BackColor and Frame Delay

Cleaner GUI interface

Ready(almost) for insertion as a Class module in a VB6 ActiveX control.

Here's the very RAW code that parses the Animated Gif file.

Public Function fGifBreakOutFrames() As Boolean
' Break an Animated Gif file up into the seperate GIF frames
' that make up the entire animation.
'******************************


Const Pathlen = 256

' GIF Block Extension Label Values
Const ExtensionIntroducer = &H21
Const ApplicationExtension = &HFF
Const CommentExtension = &HFE
Const GraphicControlExtension = &HF9
Const ImageDescriptor = &H2C
Const PlainTextExtension = &H1
Const Trailer = &H3B
' Intel Byte ordering
Const GIF89 = &H38464947

' Length of Logical Screen Descriptor Block
Const lenLogicalScreenDescriptor = 7

' Length of Graphic Control Extension Block
Const lenGraphicControlExtension = 7

' Length of Image Descriptor Block
Const lenImageDescriptor = 10

' Generally use Hex values but
' Decimal is clearer for educational purposes.
Const Bit8 = 128
Const Bit7 = 64
Const Bit6 = 32
Const Bit5 = 16
Const Bit4 = 8
Const Bit3 = 4
Const Bit2 = 2
Const Bit1 = 1

' Length of Gif File Header
Const lenGifHeader = 6

' Temp var to check our Constants against
Dim varTemp As Variant

' Need Flag so we can init arrays properly
' first time through loops
Dim blFirstTime As Boolean
blFirstTime = True

' Saves typing and necessary logic to
' init and Redim our storage arrays
' Loop Counter
Dim lc As Long

Dim strPath As String * Pathlen
Dim strPathandFileName As String


Dim lngStartLocalColorTable As Long
Dim lngStartGlobalColorTable As Long
Dim lngNewTransparent As Long
Dim lngIndexDuplicate As Long
Dim lngMax As Long
Dim lngMaxPrevious As Long

Dim Fnum As Integer
' Length of file
Dim FLength As Long


' Initialize our Class arrays
' Most importantly we release all of our handles
' to the StdPicture objects that were created the
' last time we ran this function.
CleanUp

' Get next avail file handle
Fnum = FreeFile

If Len(strGifFileName & vbNullString) < 1 Then
MsgBox "Please select an Animated Gif File!"
Call SGetGifFileName
End If

' Second Time is Cancel then exit
If Len(strGifFileName & vbNullString) < 1 Then
'MsgBox "Please select an Animated Gif File!"
'Call SGetGifFileName
Exit Function
End If


Open strGifFileName For Binary As Fnum
FLength = LOF(Fnum)
' Animated Gifs are relatively Small
' Read in Entire File!
ReDim bArray(1 To FLength)
Get Fnum, , bArray
Close Fnum

' Current Position in our Byte Array
Dim lngCurPosition As Long

' Starting offset to current GIF frame
Dim lngGifStart As Long

' Ending offset to current GIF Frame
Dim lngGifEnd As Long



' We need to handle the PackedFlags array seperately
' since it is the only array used in this part of the function
ReDim PackedFields(0)

' Let's check and make sure we are an Animated Gif!
apiCopyMemory lngRet, bArray(1), 4 ' was 5 FIX THIS
If lngRet <> GIF89 Then GoTo err_NoGif

' OK let's fill in our variables we derive from
' The Logical Screen Descriptor Block that always follows
' the 6 byte File Header with the GIF Signature
apiCopyMemory LogWidth, bArray(lenGifHeader + 1), 2
apiCopyMemory LogHeight, bArray(lenGifHeader + 3), 2
apiCopyMemory PackedFields(0), bArray(lenGifHeader + 5), 1
apiCopyMemory BackgroundColorIndex, bArray(lenGifHeader + 6), 1
apiCopyMemory PixelASpectRatio, bArray(lenGifHeader + 7), 1


' update our current position in the buffer
lngCurPosition = lngCurPosition + lenGifHeader + lenLogicalScreenDescriptor



' Let's derive our props from the packed Bit fields
If PackedFields(0) And Bit8 Then GlobalColorTableFlag = True
' ColorResolution variable is a Byte with really only 3 bits significant
If PackedFields(0) And Bit7 Then ColorResolution = Bit3
If PackedFields(0) And Bit6 Then ColorResolution = ColorResolution Or Bit2
If PackedFields(0) And Bit5 Then ColorResolution = ColorResolution Or Bit1

If PackedFields(0) And Bit4 Then GSortFlag = True

' SizeOfGlobalColorTable variable is a Byte with really only 3 bits significant
' SizeOfGlobalColorTable variable is a Byte with really only 3 bits significant
' clear out first in case Bit 3 is still set from last time!!!!!!!!!
' Geeze this logic took me 2 hours to figure out. :-(
SizeOfGlobalColorTable = 0
If PackedFields(0) And Bit3 Then SizeOfGlobalColorTable = Bit3
If PackedFields(0) And Bit2 Then SizeOfGlobalColorTable = SizeOfGlobalColorTable Or Bit2
If PackedFields(0) And Bit1 Then SizeOfGlobalColorTable = SizeOfGlobalColorTable Or Bit1

' is there a Global Color Table?
If GlobalColorTableFlag Then
' Calculate size of Global Color Table
' to calculate offset to jump to start of next Block
' Color Table = RGB Triple, 3 bytes per entry
' Copy the Color Table to its storage array
' Just changed line below to fix problem of starting
' to copy color table 2 bytes to soon
' 1 byte was index on array other is lngcurposition
apiCopyMemory GlobalColorTable(0), bArray(lngCurPosition + 1), (3 * (2 ^ (SizeOfGlobalColorTable + 1)))
lngStartGlobalColorTable = lngCurPosition + 1
lngCurPosition = lngCurPosition + (3 * (2 ^ (SizeOfGlobalColorTable + 1)))
End If
' Problem arises for Gif's that specify a Transparent Index
' that refers to the same RGB color used in more than
' one slot. IE Black for the background at Slot 1 and
' Black for Text at Slot 16. This causes problems with the
' Transparent Blit function that masks an Entire RGB color value.
' Since Gif's are a max of 8 bits we are working with
' pallets(indexes) and Bitplanes. This means its very possible to have
' the situation I described above, One color value existing in
' 2 different pallet indexes. I need a function to check for
' this. FOr now I'll do it quick and dirty. If 4 bits and Black is
' the 16th color change from RGB 000 to RGB 001.

'******************
' It seems that it is always the very last palette position
' that is set to the duplicate Transparent color, usually black
' So let's just set the last RGB of any palette to 1
' This might screw up on small 4 bit palettes but its s short term
' soluition
' Make sure we clear temp var
lngRet = 0
'If SizeOfGlobalColorTable = 3 Then
' apiCopyMemory lngRet, GlobalColorTable(15 * 3), 3
' If lngRet = 0 Then
' No, need to work on barray arrayGlobalColorTable(47) = 1
'bArray((lngCurPosition - (3 * (2 ^ (SizeOfGlobalColorTable + 1)))) + 1) = 1 'bArray(lngCurPosition-) + 1
' bArray(14) = 1
'End If
'End If
'if globalcolortable(


' Can't do this here because we have not read the Transparent Flag yet.
'Will have to do this later while decoding theproper block.


' Reset starting point for this Gif
' update our current position in the buffer
lngCurPosition = lngCurPosition + 1
' Every temp Gif will have File header above and
' Global Color Table if it exists
lngGifStart = lngCurPosition

' Check to make sure we are not at the end of the file
'If bArray(lngCurPosition) <> Trailer Then
' If lngCurPosition < FLength Then

'Initialize Loop counter for first time through
lc = 0
' Clear out our array of Standard Picture handles
Erase hStdPicture()

Do While lngCurPosition <= FLength
' Now are building the guts for each indiviual Gif frame
' of the Animated Gif file.
' Let's Redim our storage arrays


ReDim Preserve PackedFields(lc)
ReDim Preserve ImageLeft(lc)
ReDim Preserve ImageTop(lc)
ReDim Preserve ImageWidth(lc)
ReDim Preserve ImageHeight(lc)
ReDim Preserve LSortFlag(lc)
ReDim Preserve LocalColorTableFlag(lc)
ReDim Preserve InterLaceFlag(lc)
ReDim Preserve SizeOfLocalColorTable(lc)

ReDim Preserve LZWMinimumCodeSize(lc)
ReDim Preserve DelayTime(lc)
ReDim Preserve TransparentColorIndex(lc)
ReDim Preserve DisposalMethod(lc)
ReDim Preserve UserInputFlag(lc)
ReDim Preserve TransparentColorFlag(lc)

'ReDim Preserve arrayLocalColorTables(lc)

' Let's see what the next Block is.
' We'll keep moving forward until we hit the
' Image Descriptor Block.
' Immediately following this Block is the actual
' Image data. We will copy from the start of the Gif until the
' end of the Image Data to a temporary Disk file.
' We will then load this temp GIF file(frame) into an Image Control.

Do While bArray(lngCurPosition) <> ImageDescriptor

' Usually we find next an Image Descriptor or the Netscape Application Extension Block
' Let's check for all Blocks that have are proceeded
' by the ExtensionInducer value
If bArray(lngCurPosition) = ExtensionIntroducer Then

Select Case bArray(lngCurPosition + 1)

Case ApplicationExtension
' This needs to check and see if it is
' the Netscape App Ext to read the value
' for the number of itinerations the loop
' should be executed to display the GIF

' Jump to start of Application Data Sub Blocks
lngCurPosition = lngCurPosition + 14 'bArray(lngCurPosition + 14)
lngCurPosition = lngCurPosition + bArray(lngCurPosition)

' if Next byte is 0 then this is the Block terminator
'If bArray(lngCurPosition + 1) <> 0 Then
' Keep reading Comment Blocks until done
Do While bArray(lngCurPosition + 1) <> 0
lngCurPosition = lngCurPosition + bArray(lngCurPosition + 1)
Loop
lngCurPosition = lngCurPosition + 1

Case CommentExtension
' Jump length of first Comment Data Sub Block
' First Byte of this Data block is always the Size
' not including this Byte!
lngCurPosition = lngCurPosition + 2
lngCurPosition = lngCurPosition + bArray(lngCurPosition)
' if Next byte is 0 then this is the Block terminator
'If bArray(lngCurPosition + 1) <> 0 Then
' Keep reading Comment Blocks until done
Do While bArray(lngCurPosition + 1) <> 0
lngCurPosition = lngCurPosition + bArray(lngCurPosition + 1)
Loop
'End If
lngCurPosition = lngCurPosition + 1

' **** ERROR
' ** Sharing PackedFields with GraphicControl and ImageDescriptor
' No harm done becasue I store the derived vars from Packed fields individually.
Case GraphicControlExtension
' Here we can derive key props concerning the
' playback of the GIF.
' OK let's fill in our variables we derive from this block
apiCopyMemory PackedFields(lc), bArray(lngCurPosition + 2 + 1), 1
apiCopyMemory DelayTime(lc), bArray(lngCurPosition + 2 + 2), 2
apiCopyMemory TransparentColorIndex(lc), bArray(lngCurPosition + 2 + 4), 1

' SizeOfGlobalColorTable variable is a Byte with really only 3 bits significant
If PackedFields(lc) And Bit5 Then DisposalMethod(lc) = Bit3
If PackedFields(lc) And Bit4 Then DisposalMethod(lc) = DisposalMethod(lc) Or Bit2
If PackedFields(lc) And Bit3 Then DisposalMethod(lc) = DisposalMethod(lc) Or Bit1

If PackedFields(lc) And Bit2 Then UserInputFlag(lc) = True

If PackedFields(lc) And Bit1 Then TransparentColorFlag(lc) = True
lngCurPosition = lngCurPosition + lenGraphicControlExtension


Case PlainTextExtension
' Jump to start of Plain Text Data Sub Blocks
lngCurPosition = lngCurPosition + bArray(lngCurPosition + 14)
' if Next byte is 0 then this is the Block terminator
'If bArray(lngCurPosition + 1) <> 0 Then
' Keep reading Comment Blocks until done
Do While bArray(lngCurPosition + 1) <> 0
lngCurPosition = lngCurPosition + bArray(lngCurPosition + 1)
Loop
'End If

Case Else
End Select

' If not a Block starting with ExtensionIntroducer
' we fall through to here
End If

' Update our position to continue in loop
lngCurPosition = lngCurPosition + 1


' Check to make sure we are not at the end of the file
'If bArray(lngCurPosition) = Trailer Then Exit Do
If lngCurPosition >= FLength Then Exit Do


' It seems that it is always the very last palette position
' that is set to the duplicate Transparent color, usually black
' So let's just set the last RGB of any palette to 1
' This might screw up on small 4 bit palettes but its s short term
' soluition
' Make sure we clear temp var
lngRet = 0
'If SizeOfGlobalColorTable = 3 Then
' apiCopyMemory lngRet, GlobalColorTable(15 * 3), 3
' If lngRet = 0 Then
' No, need to work on barray arrayGlobalColorTable(47) = 1
'bArray((lngCurPosition - (3 * (2 ^ (SizeOfGlobalColorTable + 1)))) + 1) = 1 'bArray(lngCurPosition-) + 1
' bArray(14) = 1
'End If
'End If
'if globalcolortable(
'If TransparentColorFlag Then
' Is Transparent Color same as any other color
' It's usually a problem when its Black
'transparentcolorindex



Loop

' OK if we get to here than we are at the start of the Image Descriptor Block
' or we are all done processing the individual GIf Frames.


' Check to make sure we are not at the end of the file
'If bArray(lngCurPosition) = Trailer Then Exit Do
If lngCurPosition >= FLength Then Exit Do


' OK let's jump over Image Descriptor Block
' and the actual Image Data so we can copy this
' Gif Frame to a Temp file.
' Here we can derive key props concerning the
' playback of this Specific GIF Frame.
' OK let's fill in our variables we derive from this block.
apiCopyMemory ImageLeft(lc), bArray(lngCurPosition + 1), 2
apiCopyMemory ImageTop(lc), bArray(lngCurPosition + 3), 2
apiCopyMemory ImageWidth(lc), bArray(lngCurPosition + 5), 2
apiCopyMemory ImageHeight(lc), bArray(lngCurPosition + 7), 2
apiCopyMemory PackedFields(lc), bArray(lngCurPosition + 9), 1




' Let's derive our props from the packed Bit fields
If PackedFields(lc) And Bit8 Then LocalColorTableFlag(lc) = True
If PackedFields(lc) And Bit7 Then InterLaceFlag(lc) = True
If PackedFields(lc) And Bit6 Then LSortFlag(lc) = True

' SizeOfLocalColorTable variable is a Byte with really only 3 bits significant
If PackedFields(lc) And Bit3 Then SizeOfLocalColorTable(lc) = Bit3
If PackedFields(lc) And Bit2 Then SizeOfLocalColorTable(lc) = SizeOfLocalColorTable(lc) Or Bit2
If PackedFields(lc) And Bit1 Then SizeOfLocalColorTable(lc) = SizeOfLocalColorTable(lc) Or Bit1

' is there a Local Color Table?
If LocalColorTableFlag(lc) Then
' Calculate size of Local Color Table
' to calculate offset to jump to start of next Block
' Color Table = RGB Triple, 3 bytes per entry
' Just changed line below to fix problem of starting
' to copy color table 2 bytes to soon
' 1 byte was index on array other is lngcurposition
apiCopyMemory LocalColorTable(0), bArray(lngCurPosition + 1), (3 * (2 ^ (SizeOfLocalColorTable(lc) + 1)))
' Copy over this LocalColorTable to our
' array of LocalColorTables. I forgot that I
' need to store an array of Local Color Tables.
' This is my quick fix until I can come back and
' redo the code for the next version!
' apiCopyMemory arrayLocalColorTables(0), LocalColorTable(0), (3 * (2 ^ (SizeOfLocalColorTable(lc) + 1)))

lngStartLocalColorTable = lngCurPosition + 1


'*****************
'Normal logic resumes here leave alone!!!!!!!!!!!

' Skip over length of our Local Color Table
lngCurPosition = lngCurPosition + (3 * (2 ^ (SizeOfLocalColorTable(lc) + 1)))
End If

' Add on length of this Image Descriptor Block
lngCurPosition = lngCurPosition + lenImageDescriptor

' Let's jump to First Byte of Image Data
' This is the LZW Minimum Code Size
'lngCurPosition = lngCurPosition + 1
apiCopyMemory LZWMinimumCodeSize(lc), bArray(lngCurPosition), 1

' For Image Data Block there is no ZERO Block Terminator
' Like there is for the Control Blocks
' So we need to Check the first byte of the
' Data Block which is the Size field
' to find out when we are done reading
' Now we need to skip over Image Data Sub Blocks
'lngCurPosition = lngCurPosition + 1
Do While bArray(lngCurPosition + 1) <> 0
lngCurPosition = lngCurPosition + bArray(lngCurPosition + 1)
lngCurPosition = lngCurPosition + 1
Loop


' Finally our lngCurPosition is now at end of
' this individual GIF Frame
' We'll need to add one more byte to allow for TRAILER(&H3B)
' that we need to place at end of the file.
lngCurPosition = lngCurPosition + 1
lngGifEnd = lngCurPosition





' **** START OF REPLACE DUPLICATE TRANSPARENT RGB VALUES ****


'*******************************************************************
' Let's make sure that if there is a Transparent Color it is
' not the same value as any Color in the Bitmap.

' The reasone the TransparentColorIndex value works is that
' this sindex is ZERO based. This means even when the last palette
' index is specified as the Transparent index value we are in effect
' using this ined and pointing to a position 3 bytes before the
'end of the ColorTable

If TransparentColorFlag(lc) Then
lngIndexDuplicate = -1
If LocalColorTableFlag(lc) Then
apiCopyMemory bTransparentarray(0), LocalColorTable(TransparentColorIndex(lc) * 3), 3
For x = 0 To (3 * (2 ^ (SizeOfLocalColorTable(lc) + 1))) - 3 Step 3
apiCopyMemory bTemparray(0), LocalColorTable(x), 3
' Let's store last highest value we've seen through this loop.
' When done this will be the second largest value in the palette
'lngMaxPrevious = lngMax
If RGB(bTemparray(0), bTemparray(1), bTemparray(2)) = RGB(bTransparentarray(0), bTransparentarray(1), bTransparentarray(2)) Then
' check and ensure we are bot matching up with our Transparent Index itself!!
If (TransparentColorIndex(lc) * 3) <> x Then lngIndexDuplicate = x
End If
Next x
' We are done loop.

Else

apiCopyMemory bTransparentarray(0), GlobalColorTable(TransparentColorIndex(lc) * 3), 3
For x = 0 To (3 * (2 ^ (SizeOfGlobalColorTable + 1))) - 3 Step 3
apiCopyMemory bTemparray(0), GlobalColorTable(x), 3
' Let's store last highest value we've seen through this loop.
' When done this will be the second largest value in the palette
'lngMaxPrevious = lngMax
If RGB(bTemparray(0), bTemparray(1), bTemparray(2)) = RGB(bTransparentarray(0), bTransparentarray(1), bTransparentarray(2)) Then
' check and ensure we are bot matching up with our Transparent Index itself!!
If (TransparentColorIndex(lc) * 3) <> x Then lngIndexDuplicate = x
End If

Next x
' We are done loop.
End If

' Was there a duplicate value
If lngIndexDuplicate <> -1 Then
' Now let's compare Transparent color to rest of color table
'If TransparentColorFlag(lc) Then
' Call our function. ByRef return on byte array we pass.
'lngBool = fCheckTransparent(bTemparray)
' Find the largest RGB value
lngMax = 0
If LocalColorTableFlag(lc) Then
For x = 0 To (3 * (2 ^ (SizeOfLocalColorTable(lc) + 1))) - 3 Step 3
apiCopyMemory bTemparray(0), LocalColorTable(x), 3
' Let's store last highest value we've seen through this loop.
' When done this will be the second largest value in the palette
If RGB(bTemparray(0), bTemparray(1), bTemparray(2)) > lngMax Then
lngMaxPrevious = lngMax
lngMax = RGB(bTemparray(0), bTemparray(1), bTemparray(2))
Else
If RGB(bTemparray(0), bTemparray(1), bTemparray(2)) > lngMaxPrevious Then lngMaxPrevious = RGB(bTemparray(0), bTemparray(1), bTemparray(2))
End If
Next x
' We are done loop. Let's calculate a new RGB value for
' the Transparency Color. We'll make it halfway between the
' second and the largest RGB values
lngNewTransparent = lngMax - ((lngMax - lngMaxPrevious / 2))
' Store this value back in the appropriate ColorTable array
' and the raw byte array that will be written
' to the disk as a temp Gif file.
' Write to ColorTable

'TransparentColorIndex(lc) * 3)
LocalColorTable(3 * TransparentColorIndex(lc)) = (lngNewTransparent And &HFF)
LocalColorTable((3 * TransparentColorIndex(lc)) + 1) = (lngNewTransparent And &HFF00&) \ &H100
LocalColorTable((3 * TransparentColorIndex(lc)) + 2) = (lngNewTransparent And &HFF0000) \ &H10000

' Write to raw byte array
bArray(lngStartLocalColorTable + (3 * TransparentColorIndex(lc))) = (lngNewTransparent And &HFF)
bArray(lngStartLocalColorTable + (3 * TransparentColorIndex(lc)) + 1) = (lngNewTransparent And &HFF00&) \ &H100
bArray(lngStartLocalColorTable + (3 * TransparentColorIndex(lc)) + 2) = (lngNewTransparent And &HFF0000) \ &H10000

Else
lngMax = 0
For x = 0 To (3 * (2 ^ (SizeOfGlobalColorTable + 1))) - 3 Step 3
apiCopyMemory bTemparray(0), GlobalColorTable(x), 3
' Let's store last highest value we've seen through this loop.
' When done this will be the second largest value in the palette

If RGB(bTemparray(0), bTemparray(1), bTemparray(2)) > lngMax Then
lngMaxPrevious = lngMax
lngMax = RGB(bTemparray(0), bTemparray(1), bTemparray(2))

Else
If RGB(bTemparray(0), bTemparray(1), bTemparray(2)) > lngMaxPrevious Then lngMaxPrevious = RGB(bTemparray(0), bTemparray(1), bTemparray(2))
End If

Next x
' We are done loop. Let's calculate a new RGB value for
' the Transparency Color. We'll make it halfway between the
' second and the largest RGB values
lngNewTransparent = lngMax - ((lngMax - lngMaxPrevious / 2))
' Store this value back in the appropriate ColorTable array
' and the raw byte array that will be written
' to the disk as a temp Gif file.
' Write to ColorTable
GlobalColorTable(3 * TransparentColorIndex(lc)) = (lngNewTransparent And &HFF)
GlobalColorTable((3 * TransparentColorIndex(lc)) + 1) = (lngNewTransparent And &HFF00&) \ &H100
GlobalColorTable((3 * TransparentColorIndex(lc)) + 2) = (lngNewTransparent And &HFF0000) \ &H10000

' Write to raw byte array
bArray(lngStartGlobalColorTable + (3 * TransparentColorIndex(lc))) = (lngNewTransparent And &HFF)
bArray(lngStartGlobalColorTable + (3 * TransparentColorIndex(lc)) + 1) = (lngNewTransparent And &HFF00&) \ &H100
bArray(lngStartGlobalColorTable + (3 * TransparentColorIndex(lc)) + 2) = (lngNewTransparent And &HFF0000) \ &H10000

End If

End If


End If
' **** END OF REPLACE DUPLICATE TRANSPARENT RGB VALUES ****





' *******START LOOP *************
'Resize all of our storage arrays each time we come through
' this main loop.
' Is this the very first time through the loop?
If blFirstTime Then
'
ReDim mGifStart(0)
ReDim mGifEnd(0)


blFirstTime = False

Else
ReDim Preserve mGifStart(UBound(mGifStart) + 1)
ReDim Preserve mGifEnd(UBound(mGifEnd) + 1)
End If

'Debug.Print "Gif Start:" & lngGifStart
' Let's store the actual values we generated in this loop
mGifStart(UBound(mGifStart)) = lngGifStart
mGifEnd(UBound(mGifEnd)) = lngGifEnd


' Advance Current Position to start lookin for the NEXT GIF FRAME!
lngCurPosition = lngCurPosition + 1
' Reset start of next GIF Frame
lngGifStart = lngCurPosition
'WriteTemp Gif
' Loop and continue
' *******************

' Check to make sure we are not at the end of the file
If bArray(lngCurPosition) = Trailer Then Exit Do
' If lngCurPosition < FLength Then

' Increment our Loop Counter
lc = lc + 1
Loop


' Now we need to
' If we get here then we have should have some
' GIF Frame pointers in our Arrays

' Let's take the start and end offsets for our
' individual Gif Frames and get a StdPic object
' by using LoadPicture
' We can then use this Handle directly as a hBitmap!
' No kidding!<bg>



' For System Temp Folder
' and temp unique filename
'Const Pathlen = 255

'Dim strPath As String * Pathlen
Dim strFixed As String * Pathlen
'Dim strPathandFileName As String
'Dim FileHeader As BITMAPFILEHEADER

Dim sec As SECURITY_ATTRIBUTES
Dim lngBytesWritten As Long
'Dim Fnum As Integer
Dim hFile As Long


Dim GifLoop As Long

GifLoop = 0
'For GifLoop = 1 To 5 '00
'DoEvents



' Reset Index for array of Start/Stop points
ctr = 0

For ctr = 0 To UBound(mGifStart)

' Get the Systems Temp path
' Returns Length of path(num characters in path)
lngRet = GetTempPath(Pathlen, strPath)
' Chop off NULLS and trailing "\"
strPath = Left(strPath, lngRet) & Chr(0)

' Now need a unique Filename
' locked from a previous aborted attemp.
strPathandFileName = GetUniqueFilename(strPath, Str(ctr) & Chr(0), "GIF")


sec.bInheritHandle = True
sec.lpSecurityDescriptor = 0
sec.nLength = Len(sec)

hFile = CreateFile(strPathandFileName, GENERIC_WRITE, 0&, sec, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)

'ctr = gifstart(ctr)
' Write Common Gif File Header
' From start of File until Start of First Gif frame
lngRet = WriteFile(hFile, bArray(1), mGifStart(0) - 1, lngBytesWritten, 0)
' Write out entire GIf Frame
' This will start at our stored start point.
' The length will be our stored ending point minus
' the starting point. Think about it!<bg>
lngRet = WriteFile(hFile, bArray(mGifStart(ctr)), mGifEnd(ctr) - mGifStart(ctr), lngBytesWritten, 0)
' Write Block Terminator - ZERO
lngRet = WriteFile(hFile, 0, 1, lngBytesWritten, 0)

' Write DUMMY Control Block
' Some programs depend on seeing the next Control Block to
' know the previous data block is done!!!!
lngRet = WriteFile(hFile, &HF921, 2, lngBytesWritten, 0)


' Write the Trailer Block
lngRet = WriteFile(hFile, Trailer, 1, lngBytesWritten, 0)
'Debug.Print "ctr:" & ctr & "Start:" & mGifStart(ctr) & " :" & strPathandFileName
' Close the Temp GIF file
CloseHandle (hFile)


' Need as many StdPicture objects as there are Gif Frames
' hStdPicture is declared at the module level.
ReDim Preserve hStdPicture(ctr)
' Load in the Frame we just saved to disk.
Set hStdPicture(ctr) = LoadPicture(strPathandFileName)

' DELETE the TEMP GIF FILE
Kill strPathandFileName

' Loop and create next Frame until done
Next

' ** All done splitting Gif into its constituent frames **


' Let's load the first Frame of the Animated Gif
' into the Image Control. We do this by simply
' loading the original Animated Gif file into the
' Image control as we would normally.
mImageCtl.Picture = strGifFileName

' Now we need to Create a DibSection matching the
' properties of this Animated GIf
fCreateDib



exit_Gif:
Exit Function

' We now have an array of
err_NoGif:
' File is not an Animated Gif
MsgBox "Sorry, not an Animated Gif file", vbOKOnly, "Not a Valid Animated Gif File!"
Resume exit_Gif

End Function