Show Animated Gif without the webbrowser contol 3

[vb5prgrmr]

Ok, here a version of some code that I found at PSC and I was thinking of making this a FAQ for this forum.

This VB6 code has been tested on...
Win95 Version B VB6 SP5 (AMD 200Mhz)
WinNT4 SP6 VB6 SP5 (AMD 1Ghz)
Win2k Server VB6 SP5 .NET 2002 (AMD 1Ghz)
Win2k Pro SP3 VB6 SP5 .NET 2002 SP1 and .NET 2003 (P3 750Mhz)

it seems to work fine on all machines except the old one at the top. It has a flicker between frames.

Please note that this is by no means a perfect solution but with the decoding of the gif done there are many ways to improve this code to include double buffering (to get rid of that flicker on older machines).

[tt]
'to use this demo you will need a timer and an image control along with the path of the animated gif file
'once you have added the image control (Image1) set its index to zero (0)
Option Explicit

Dim NumberOfTimesToRepeatSequence As Long, RepeatedCount As Long
Dim MaxCnt As Integer, ImgCnt As Integer

Private Sub Form_Load()

On Error GoTo Form_LoadError

Me.Width = 8000
Image1(0).Left = 0
Image1(0).Top = 0

'place the path to the gif you want to animate here
Call DecodeGif("place the path to the gif you want to animate here&quot

Exit Sub
Form_LoadError:

MsgBox Err.Description

End Sub

Private Sub DecodeGif(PathToGifFile As String)

On Error GoTo DecodeGifError

'declare procedural variables
Dim FNumb As Integer, GifBuffer As String, GifHeader As String, SectionStart As Long, SectionEnd As Long, SectionMarker As String
Dim ImageCount As Integer, I As Integer
Dim NewPicBuff As String, ImageHeader As String, DisplayTime As Long
Dim LftOffSet As Long, TopOffSet As Long

'make sure we have something to work with
If Dir(PathToGifFile) = vbNullString Then
MsgBox "Wheres the GIF!?"
Exit Sub
End If

'disable timer
Timer1.Enabled = False

'if you were to change this demo so other gifs could be displayed in this array then you would need to unload all but the origional
For I = 1 To Image1.Count - 1
Unload Image1(I)
Next I

'set value(s)
SectionMarker = Chr(0) & "!ù"
SectionStart = 1

'open our gif, read it in, close it out
FNumb = FreeFile
Open PathToGifFile For Binary As #FNumb
GifBuffer = Input(FileLen(PathToGifFile), #FNumb)
Close #FNumb

'get where this (the header info) ends
SectionEnd = InStr(SectionStart, GifBuffer, SectionMarker) + Len(SectionMarker) - 2

'retrieve the header
GifHeader = Left(GifBuffer, SectionEnd)

'set where the next section starts at
SectionStart = SectionEnd + 2

'check the length of the header for extended information
If Len(GifHeader) > 127 Then
NumberOfTimesToRepeatSequence = Asc(Mid(GifHeader, 126, 1)) + (Asc(Mid(GifHeader, 127, 1)) * 256)
Else
NumberOfTimesToRepeatSequence = 0 'infinit loop
End If

'now run through file an decode each frame
Do While SectionEnd <> Len(SectionMarker)

'increase the count of images we have by 1
ImageCount = ImageCount + 1

'find out where the next section ends
SectionEnd = InStr(SectionStart, GifBuffer, SectionMarker) + Len(SectionMarker)

'check to make sure we have some information to use
If SectionEnd > Len(SectionMarker) Then

'create a single frame gif from this information
NewPicBuff = GifHeader & Mid(GifBuffer, SectionStart - 1, SectionEnd - SectionStart)

'now write it to file so we can use the load picture function on it
FNumb = FreeFile
Open App.Path & &quot;\temp.gif&quot; For Binary As #FNumb
Put #FNumb, 1, NewPicBuff
Close #FNumb

'now extract some information about the file we just saved
ImageHeader = Left(Mid(GifBuffer, SectionStart - 1, SectionEnd - SectionStart), 16)

'now calcualte the time that the image we just saved is to be displayed
DisplayTime = ((Asc(Mid(ImageHeader, 4, 1))) + (Asc(Mid(ImageHeader, 5, 1)) * 256)) * 10

'check to see if we have more than one image
If ImageCount > 1 Then

'retrieve offsets
LftOffSet = Asc(Mid(ImageHeader, 9, 1)) + (Asc(Mid(ImageHeader, 10, 1)) * 256)
TopOffSet = Asc(Mid(ImageHeader, 11, 1)) + (Asc(Mid(ImageHeader, 12, 1)) * 256)

'load a new control and set its properties
Load Image1(ImageCount - 1)
Image1(ImageCount - 1).ZOrder 0
Image1(ImageCount - 1).Left = Image1(0).Left + (LftOffSet * 15)
Image1(ImageCount - 1).Top = Image1(0).Top + (TopOffSet * 15)

End If

'set the amount of time that this frame of the gif image is to be displayed for and load the image
Image1(ImageCount - 1).Tag = DisplayTime
Image1(ImageCount - 1).Picture = LoadPicture(App.Path & &quot;\temp.gif&quot

'don't need it anymore so kill it
Kill App.Path & &quot;\temp.gif&quot;

SectionStart = SectionEnd

End If

Loop

If SectionStart < Len(GifBuffer) Then

'create a single frame gif from this information
NewPicBuff = GifHeader & Mid(GifBuffer, SectionStart - 1, Len(GifBuffer) - SectionStart)

'now write it to file so we can use the load picture function on it
FNumb = FreeFile
Open App.Path & &quot;\temp.gif&quot; For Binary As #FNumb
Put #FNumb, 1, NewPicBuff
Close #FNumb

'now extract some information about the file we just saved
ImageHeader = Left(Mid(GifBuffer, SectionStart - 1, Len(GifBuffer) - SectionStart), 16)

'now calcualte the time that the image we just saved is to be displayed
DisplayTime = ((Asc(Mid(ImageHeader, 4, 1))) + (Asc(Mid(ImageHeader, 5, 1)) * 256)) * 10

'check to see if we have more than one image
If ImageCount > 1 Then

'retrieve offsets
LftOffSet = Asc(Mid(ImageHeader, 9, 1)) + (Asc(Mid(ImageHeader, 10, 1)) * 256)
TopOffSet = Asc(Mid(ImageHeader, 11, 1)) + (Asc(Mid(ImageHeader, 12, 1)) * 256)

'load a new control and set its properties
Load Image1(ImageCount - 1)
Image1(ImageCount - 1).ZOrder 0
Image1(ImageCount - 1).Left = Image1(0).Left + (LftOffSet * 15)
Image1(ImageCount - 1).Top = Image1(0).Top + (TopOffSet * 15)

End If

'set the amount of time that this frame of the gif image is to be displayed for and load the image
Image1(ImageCount - 1).Tag = DisplayTime
Image1(ImageCount - 1).Picture = LoadPicture(App.Path & &quot;\temp.gif&quot

'don't need it anymore so kill it
Kill App.Path & &quot;\temp.gif&quot;

End If

'set our variables that we will use to keep track of which frame of the animation we are on
ImgCnt = 0
MaxCnt = Image1.Count - 1

'set up the timer
Timer1.Interval = CInt(Image1(0).Tag)
Timer1.Enabled = True

Exit Sub
DecodeGifError:

MsgBox Err.Description

End Sub

Private Sub Timer1_Timer()

On Error GoTo Timer1_TimerError

'increment,show, and set the next timers interval
ImgCnt = ImgCnt + 1
Image1(ImgCnt).Visible = True
Timer1.Interval = CInt(Image1(ImgCnt).Tag)

'for gifs that have a moving animation each frame is offset from the first frame by some amount so you need to make sure that the old frame is not
'shown because you would get one image overlaid on another (or in some cases next to each other).
If ImgCnt = 0 Then

'for images with offsets you need to do this
Image1(MaxCnt).Visible = False

Else

'for images with offsets you need to do this
Image1(ImgCnt - 1).Visible = False

'check to see if we have reached the end of the animation
If ImgCnt = MaxCnt Then

'reset the counter to before the first element since the first thing we do when we enter this sub is to increment the element counter
ImgCnt = -1

'this can be removed for continious play but since it was decoded above...
If NumberOfTimesToRepeatSequence = 0 Then

DoEvents

Else

'increment the number of times this animation has played and then check to see if we have reached the limit and if we have then disable the timer
RepeatedCount = RepeatedCount + 1
If RepeatedCount > NumberOfTimesToRepeatSequence Then Timer1.Enabled = False

End If

End If

Exit Sub
Timer1_TimerError:

MsgBox Err.Description

End Sub
[/tt]

So what do you think???

 

[vb5prgrmr]

Ok, so no one has any thoughts?

 

[chiph]

They're probably in shock.

I'm not sure how many people are still on machines as slow as your AMD 200MHz, so I kindof doubt it's worth the effort to code a double-buffer algorithm. But sure, post it as a FAQ.

Chip H.

 

[ca8msm]

The potential of it looks good apart from

1) The code does seem to be fairly slow
2) the image was not displayed correctly i.e. it looked like it had been inverted.

The reasons for it looking inverted may be something to do with my form or image I suppose so there may be a solution for this.

I'm sure with a few modifications this would turn into an excellent function.

 

[strongm]

To be honest I'm of the opinion that, having got the web browser control, I already have a way of reliably displaying animated gifs so why reinvent the wheel?

Having said that, I know some people have an odd aversion to using any controls apart from the one's included in VB by default, or are in an environment win which they cannot guarantee that the necessary browser is available.

 

[vb5prgrmr]

ca8msm, what is the url of the page and gif

strongm, I agree with both sides but it seems that every semester this forum gets bombarded with pretty much the same questions, so this is an attempt to keep from looking up those disappearing threads and having to keep from digging up our personal archives. Also if this does become a faq I would like your code (in thread?????) to become a faq also so there will be with and without.

 

[strongm]

Something like the following (which is primarily designed for the DHTML Edit controls, but the commented out bits are there for those who prefer the web browser):
[tt]
Private Function DHTMLLoadPicture(strPicFile As String, Optional StretchToFit As Boolean = False) As Picture
Dim tmpPic As Picture
Dim OldScale As Long

Set tmpPic = LoadPicture(strPicFile)

OldScale = Form1.ScaleMode
Form1.ScaleMode = vbMillimeters
DHTMLEdit1.Appearance = DEAPPEARANCE_FLAT
DHTMLEdit1.ScrollBars = False

If StretchToFit Then
DHTMLEdit1.Width = tmpPic.Width / 100 ' Picture width and height are returned in HiMetric units
DHTMLEdit1.Height = tmpPic.Height / 100 ' so convert to millimeters
' Webbrowser control version
' WebBrowser1.Width = tmpPic.Width / 100
' WebBrowser1.Height = tmpPic.Height / 100
End If
DHTMLEdit1.DocumentHTML = &quot;<body topmargin='0' leftmargin='0'><p><img src='&quot; + strPicFile + &quot;'></p></body>&quot;
' Webbrowser control version
' WebBrowser1.Navigate &quot;about:blank&quot;
' WebBrowser1.Document.write &quot;<html><head><style type='text/css'><!--body { overflow:hidden; }--></style></head><body topmargin='0' leftmargin='0'><p><img border='0' src='&quot; + strPicFile + &quot;'></p></body></html>&quot;

Form1.ScaleMode = OldScale
Set DHTMLLoadPicture = tmpPic
End Function

 

[Hypetia]

Although the method was a bit bulky, but the results were surprising. I agree ca8msm that after some improvements, this function will become a useful programmers' resource.
...And do post it as a FAQ.

You deserve a star for this useful work.

 

[vb5prgrmr]

Hypetia,

I agree (split, stdPicture,...), and thanks...

strongm

There you go out doing yourself again!!! have you posted it as a FAQ???

chiph,

Yeah I use it to see just how long the code will take on older machines and if it does take too long, wellll ... thennn, I try to make it faster.

and to all let me point out once again a version of some code that I found at PSC, I just tried to make it more readable and commented it up.

 

[ca8msm]

Sorry I took so long to reply but I'll explain what happened anyway.

The gif that I used had a transparent background so I guess this is what caused the problem. As the form was the defualt colour, I guess the transparency showed up as the colour of the form and therefore made it look &quot;inverted&quot;. The gif was just on my machine but I'll upload it somewhere if anyone wants to see the results.

The webbrowser option seems easier to use and I think personally I would go with this, but both options are useful and it would make a good FAQ.

 

[vb5prgrmr]

Actually I would ca8msm because I have tested it with gifs that used transparency and have not had a problem.

strongm, may I suggest one enhancement to your code (now that I think of it with the discussion being or transparency). The enhancement would be to make the background of the control (webbrowser/dhtmledit) the same as its container.

 

[strongm]

I leave that as an exercise to the interested reader. It just needs a little more HTML added to the DocumentHTML string...oh, how about this, then:

Private Declare Function GetSysColor Lib &quot;user32&quot; (ByVal nIndex As Long) As Long


Private Function DHTMLLoadPicture(strPicFile As String, Optional ParentBackColor As Boolean = True, Optional StretchToFit As Boolean = False) As Picture
Dim tmpPic As Picture
Dim OldScale As Long
Dim NewBackColor As String

Set tmpPic = LoadPicture(strPicFile)

OldScale = Form1.ScaleMode
Form1.ScaleMode = vbMillimeters
DHTMLEdit1.Appearance = DEAPPEARANCE_FLAT
DHTMLEdit1.ScrollBars = False

If StretchToFit Then

DHTMLEdit1.Width = tmpPic.Width / 100 ' Picture width and height are returned in HiMetric units
DHTMLEdit1.Height = tmpPic.Height / 100 ' so convert to millimeters
' Webbrowser control version
' WebBrowser1.Width = tmpPic.Width / 100
' WebBrowser1.Height = tmpPic.Height / 100
End If
NewBackColor = &quot;&quot;
If ParentBackColor Then
NewBackColor = &quot;bgcolor='#&quot;
If (DHTMLEdit1.Container.BackColor And &H80000000) Then
NewBackColor = NewBackColor + CStr(Hex(GetSysColor(DHTMLEdit1.Container.BackColor Xor &H80000000))) & &quot;'&quot;
Else
NewBackColor = NewBackColor + CStr(Hex(DHTMLEdit1.Container.BackColor)) & &quot;'&quot;
End If
End If
DHTMLEdit1.DocumentHTML = &quot;<body &quot; & NewBackColor & &quot; topmargin='0' leftmargin='0'><p><img src='&quot; + strPicFile + &quot;'></p></body>&quot;
' Webbrowser control version
' WebBrowser1.Navigate &quot;about:blank&quot;
' WebBrowser1.Document.write &quot;<html><head><style type='text/css'><!--body { overflow:hidden; }--></style></head><body &quot; & NewBackColor & &quot; topmargin='0' leftmargin='0'><p><img border='0' src='&quot; + strPicFile + &quot;'></p></body></html>&quot;

Form1.ScaleMode = OldScale
Set DHTMLLoadPicture = tmpPic
End Function

 

[ca8msm]

I've uploaded the image so here is the one I used:

so see if the same happens when you run it. I guess it is the tarnsparency but i could be wrong...

 

[vb5prgrmr]

ca8msm, ummm, somethings wrong with the url/hosting website at this point in time but I got it via properties of the object and I see what you mean...

Ok, I have played with it for a couple of minutes and have found that this gif uses an &quot;overlay&quot; method. Meaning that each frame is dependent upon the previous frames information. So in the timer event you would remove/comment out the two lines of where the code makes the Image1 controls invisible and then use a for loop from 1 to the count of images when ImgCnt = MaxCnt to reset the frames. This fixes the &quot;inverted&quot; look you mentioned but this gifs frame play time is so short that I belive the code would need to be enhanced with a &quot;double buffer&quot; because of once again that damn flicker...

 

[ZOR]

Is the gif89 dll now dufunct, or wrong in a vb animated picture?

 

[strongm]

...and of course it works fine in the DHTMLEdit/Webbrowser solution... ;-)

 

[vb5prgrmr]

Never used it. Where do you get it from? What are its copy rights, royalties, and licensing?

This thread is just a bad attempt to start to create a FAQ about using animated gifs in vb. So far I have posted some code that I have found at PSC that uses all code, and stromgm has enhanced his webbrowser control code to include the DHTMLEdit contol and blending the background of either control to its container.

 

[ZOR]

Do a search on google.com for vb gif89 or just gif89. I last used it in an Access application, but it must work in vb I would have thought?

 

[ZOR]

I did a search,

http://www.martin2k.co.uk/vb6/vb6download.php

If you scroll down to the OCX and Runtime files, the gif89 is there. Don't know if there is any data on it.

 

[vb5prgrmr]

I found it at a different site with it's limited documentation and it is an activex dll/control. It is simple to use and is freely distributable. Not a bad control except that it will not display ca8msm's gif correctly. It did do fine with a couple of other gifs that I tested it with though.