i'm using VB6 in UC section.
my animated gif code isn't good, is why i'm update it:
Code:
Option Explicit
Private MyPath As String
Public TotalFrames As Long
Public LogicalWidth As Long, LogicalHeight As Long
Public myBackColor As Long
Public sGifMagic As String, Trailer As String
Public TimeSpeed As Long 'used in UC
Private Type BITMAPFILEHEADER '14 bytes
bfType As Integer
bfSize(3) As Byte 'Long
'bfSize As Long
bfReserved1 As Integer
bfReserved2 As Integer
'bfOffBits As Long
bfOffBits(3) As Byte
End Type
Private Declare Function GetTempFileName _
Lib "KERNEL32" Alias "GetTempFileNameA" _
(ByVal lpszPath As String, _
ByVal lpPrefixString As String, _
ByVal wUnique As Long, _
ByVal lpTempFileName As String) As Long
Private Function GetUniqueFilename(Optional Path As String = "", _
Optional Prefix As String = "", _
Optional UseExtension As String = "") _
As String
' Input strings must be NULL terminated.
Dim wUnique As Long
Dim lpTempFileName As String
Dim lngRet As Long
Dim FileHeader As BITMAPFILEHEADER
wUnique = 0
If Path = "" Then Path = CurDir
lpTempFileName = Space(255)
lngRet = GetTempFileName(Path, Prefix, _
wUnique, lpTempFileName)
lpTempFileName = Left(lpTempFileName, _
InStr(lpTempFileName, Chr(0)) - 1)
Call Kill(lpTempFileName)
If Len(UseExtension) > 0 Then
lpTempFileName = Left(lpTempFileName, Len(lpTempFileName) - 3) & UseExtension
End If
GetUniqueFilename = lpTempFileName
End Function
Private Sub AddDirSep(strPathName As String)
If Right$(RTrim$(strPathName), 1) <> "\" Then
strPathName = RTrim$(strPathName) & "\"
End If
End Sub
Public Function LoadGif(sFile As String, aImg As Variant) As Boolean
On Error Resume Next
Dim i As Long
Dim lngFind As Long, lngPreviousFind As Long, strTempFile As String
Dim hFile As Long
Dim sFileHeader As String, strTemp As String
Dim sBuff As String
Dim sPicsBuff As String
Dim TimeWait As Long
Dim bolDoLastImage As Boolean
TotalFrames = 0
If Dir$(sFile) = "" Or sFile = "" Then
Exit Function
End If
MyPath = App.Path
AddDirSep MyPath
If aImg.Count > 1 Then
For i = 1 To aImg.Count - 1
Unload aImg(i)
Next i
End If
'load the gif into a string buffer
hFile = FreeFile
Open sFile For Binary Access Read As hFile
sBuff = String(LOF(hFile), Chr(0))
Get #hFile, , sBuff
Close #hFile
'find size of color table
If Asc(Mid(sBuff, 11, 1)) And 128 Then
lngFind = Asc(Mid(sBuff, 11, 1)) And 7
lngFind = 3 * (2 ^ (lngFind + 1))
End If
lngFind = lngFind + 13
sFileHeader = Left(sBuff, lngFind)
'GIF?
If Left$(sFileHeader, 3) <> "GIF" Then Exit Function
'logical dimensions
LogicalWidth = Asc(Mid(sBuff, 7, 1)) + Asc(Mid(sBuff, 8, 1)) * 256&
LogicalHeight = Asc(Mid(sBuff, 9, 1)) + Asc(Mid(sBuff, 10, 1)) * 256&
'temporary file
hFile = FreeFile
strTempFile = GetUniqueFilename(MyPath, "p" & Chr(0), "GIF")
Open strTempFile For Binary As hFile
'locate start of a frame
lngFind = InStr(Len(sFileHeader) + 1, sBuff, sGifMagic) + 1
'first image
If lngFind > 1 Then
sPicsBuff = sFileHeader & Mid(sBuff, Len(sFileHeader) + 1, lngFind - (Len(sFileHeader) + 1)) & Trailer
Put #hFile, 1, sPicsBuff
Load aImg(1)
aImg(1).Visible = True
aImg(1).Tag = "10"
aImg(1).Picture = LoadPicture(strTempFile)
If aImg(1).Picture.handle <> 0 Then
TotalFrames = 1
Else
Unload aImg(1)
End If
lngPreviousFind = lngFind
lngFind = InStr(lngPreviousFind + 1, sBuff, sGifMagic) + 1
Else
'only one image
lngPreviousFind = Len(sFileHeader) + 1
lngFind = Len(sBuff)
bolDoLastImage = True
End If
'search next image
Do While lngFind > 1
TotalFrames = TotalFrames + 1
Load aImg(TotalFrames)
aImg(TotalFrames).Visible = True
strTemp = Mid(sBuff, lngPreviousFind, lngFind - lngPreviousFind)
sPicsBuff = sFileHeader & strTemp & Trailer
Put #hFile, 1, sPicsBuff
'redraw?
aImg(TotalFrames).DrawStyle = (Asc(Mid(strTemp, 4, 1)) And 28) / 4
'load picture
aImg(TotalFrames).Picture = LoadPicture(strTempFile)
If bolDoLastImage Then
If aImg(TotalFrames).Picture.handle = 0 Then
Unload aImg(TotalFrames)
TotalFrames = TotalFrames - 1
Exit Do
End If
End If
'frame delay
TimeWait = ((Asc(Mid(strTemp, 5, 1))) + (Asc(Mid(strTemp, 6, 1)) * 256&)) * 10&
If TimeWait = 0 Then TimeWait = 1
If TimeWait > 65535 Then TimeWait = 65535
TimeSpeed = CStr(TimeWait)
'position
If TotalFrames > 1 Then
aImg(TotalFrames).Left = aImg(1).Left + Asc(Mid(strTemp, 10, 1)) + (Asc(Mid(strTemp, 11, 1)) * 256&)
aImg(TotalFrames).Top = aImg(1).Top + Asc(Mid(strTemp, 12, 1)) + (Asc(Mid(strTemp, 13, 1)) * 256&)
End If
lngPreviousFind = lngFind
lngFind = InStr(lngPreviousFind + 1, sBuff, sGifMagic) + 1
'last image
If lngFind <= 1 Then
If Not bolDoLastImage Then
lngFind = Len(sBuff)
bolDoLastImage = True
End If
End If
Loop
If TotalFrames > 1 Then
LoadGif = True
Else
LoadGif = False
End If
Close #hFile
Kill strTempFile
On Error GoTo 0
End Function
and heres how i use it(here is ok, before update animated gif code):
Code:
Public Property Let FileName(New_FileName As String)
If blnDestroyed = True Then Exit Property
Dim i As Integer
strFileName = New_FileName
tmrAnimation.Enabled = False
On Error Resume Next
If (Dir(strFileName) = "" Or ValidFile(UCase(strFileName)) = False) Then
UserControl.Picture = Nothing
UserControl.MaskPicture = Nothing
UserControl.MaskColor = Null
UserControl.Cls
Strip.Activate = False
StripsActivate = Strip.Activate
lngActualSubImage = 0
lngTotalSubImages = 0
aniAnimation = AnimationStopped
Exit Property
End If
If PicAnimation.Count > 1 Then
For i = 1 To PicAnimation.Count - 1
Unload PicAnimation(i)
If shpSubImage.Count > 1 Then
Unload shpSubImage(i)
End If
Next i
End If
If (UCase(strFileName) Like "*.GIF") Then
If LoadGif(strFileName, PicAnimation) = True Then
If PicAnimation.Count = 1 Then
PicAnimation(0).Picture = LoadPicture(strFileName)
Else
lngChangeImageTime = TimeSpeed
tmrAnimation.Interval = lngChangeImageTime
End If
End If
UserControl.Width = PicAnimation(0).ScaleWidth * Screen.TwipsPerPixelX
UserControl.Height = PicAnimation(0).ScaleHeight * Screen.TwipsPerPixelY
ElseIf (UCase(strFileName) Like "*.ANI") Or (UCase(strFileName) Like "*.CUR") Then
If AnimatedCursor(strFileName, PicAnimation) Then
If PicAnimation.Count > 1 Then tmrAnimation.Interval = lngChangeImageTime
UserControl.Width = PicAnimation(0).ScaleWidth * Screen.TwipsPerPixelX
UserControl.Height = PicAnimation(0).ScaleHeight * Screen.TwipsPerPixelY
End If
Else
tmrAnimation.Enabled = False
PicAnimation(0).Picture = LoadPicture(strFileName)
End If
lngActualSubImage = 0
lngTotalSubImages = IFF(Strip.Activate = True, PicAnimation.Count - 1, PicAnimation.Count)
If Strip.Activate = True Then
UserControl.Width = PicAnimation(1).ScaleWidth * Screen.TwipsPerPixelX
UserControl.Height = PicAnimation(1).ScaleHeight * Screen.TwipsPerPixelY
Else
UserControl.Width = PicAnimation(0).ScaleWidth * Screen.TwipsPerPixelX
UserControl.Height = PicAnimation(0).ScaleHeight * Screen.TwipsPerPixelY
End If
If lngTotalSubImages = 1 Then
If Strip.Activate = True Then
UserControl.Picture = PicAnimation(1).Image
UserControl.BackColor = PicAnimation(1).BackColor
Else
UserControl.Picture = PicAnimation(0).Image
UserControl.BackColor = PicAnimation(0).BackColor
End If
Else
If Strip.Activate = True Then
UserControl.Picture = PicAnimation(1).Image
UserControl.BackColor = PicAnimation(1).BackColor
Else
UserControl.Picture = PicAnimation(0).Image
UserControl.BackColor = PicAnimation(0).BackColor
End If
aniAnimation = AnimationPlay
tmrAnimation.Enabled = Ambient.UserMode
End If
Col.Height = Extender.Height
Col.Left = Extender.Left
Col.Top = Extender.Top
Col.Width = Extender.Width
StripsActivate = Strip.Activate
Call ShowImage
PropertyChanged "FileName"
End Property
when i try use the new animated gif code the VB6 block then i must close it severy....
can anyone try to see what isn't write?
(if is need, i can put the original updated code)
thanks
Can you explain better? I don't understand what you are saying above.
hi Lavolte...
now i sod 1 error isn't "write", but "right"...
the 1st code is my new updated module for read animated gif files(because the other code that i have don't read very well some files). i found it in web(in AnimatedGifControl project)... i updated for be compativel with my project, but well i execute the code or go to form teste the VB6 crashes and for exit i must use ctrl+alt+delete keys.
my problem is that i don't understand the function code( LoadGif() function)...
from these function i need recive the boolean(for tell me if is or not animated gif file and put the subimages(with right size in a picturebox array)...
can you help me correct the errors?
thanks
The reason why your app is crashing is simple. I have experienced this in the past. When a GIF file is not correctly written to file and LoadPicture() is used, VB may crash.
There are some logic issues I would be concerned with.
1. The user is reading binary & converting to String. Then when writing to the file, they are writing string and not binary. This could be a problem.
2. I think this is a major problem: All GIF images must end with a single byte which is an EOF flag; a single byte that = 59. I don't see the code ensuring this is written. It is probably the Trailer variable, but I don't see where that variable is being assigned to anything.
Insomnia is just a byproduct of, "It can't be done"
The reason why your app is crashing is simple. I have experienced this in the past. When a GIF file is not correctly written to file and LoadPicture() is used, VB may crash.
There are some logic issues I would be concerned with.
1. The user is reading binary & converting to String. Then when writing to the file, they are writing string and not binary. This could be a problem.
2. I think this is a major problem: All GIF images must end with a single byte which is an EOF flag; a single byte that = 59. I don't see the code ensuring this is written. It is probably the Trailer variable, but I don't see where that variable is being assigned to anything.
here the original(what i found in net) project...
his from these project that i change the module and the function.
Note: if you whant i can put the other function, but these function works fine. but don't read well some animated gif files.
thanks
Last edited by joaquim; Nov 10th, 2008 at 01:16 PM.
"Do you have these? If not, you will need them. Add them to your LoadGIF routine:
sGifMagic = Chr$(0) & Chr$(&H21) & Chr$(&HF9)
Trailer = Chr(59)"
ok now works fine, but i found a problem... the function don't start(in picturebox array) by 0, but 1. can you help?
"There are better GIF controls and parsers out there."
i think so, but i need put the code in my UC.
thanks
i don't resolve the problem by start in 0 instead 1.
but i sod 1 thing: the results continue the same...
if you test the AnimatedGifControl you can see the images perfectly, but in my UC i don't i don't understand why...
i will give you my old code(i founc in net too, but starts in 0 instead 1...
Code:
Option Explicit
Public RepeatTimes As Long 'This one calculates,
' but don't use in this sample. If You need, You
' can add simple checking at Timer1_Timer Procedure
Public FrameCount As Long
Public TimeSpeed As Long
'These function is for extract the file name in file name with folder path with or not extension
Private Function FileName(Folder As String, Optional Extension As Boolean = True) As String
Dim i As Integer
Dim strFileName As String
For i = Len(Folder) To 0 Step -1
If Mid(Folder, i, 1) = "\" Then
strFileName = Right(Folder, Len(Folder) - i)
Exit For
End If
Next i
If Extension = True Then
FileName = strFileName
Else
FileName = Left(strFileName, Len(strFileName) - 4)
End If
End Function
'Read an animated gif file and put the subimage(s) in a picturebox
Public Function LoadGif(sFile As String, aImg As Variant) As Boolean
Dim strFileName As String
FrameCount = 0
strFileName = "C:\" & FileName(sFile, False)
LoadGif = False
On Error Resume Next
Dim fNum As Integer
Dim imgHeader As String, fileHeader As String
Dim buf$, picbuf$
Dim imgCount As Integer
Dim i&, j&, xOff&, yOff&, TimeWait&
Dim GifEnd As String
GifEnd = Chr(0) & Chr(33) & Chr(249)
fNum = FreeFile
Open sFile For Binary Access Read As fNum
buf = String(LOF(fNum), Chr(0))
Get #fNum, , buf 'Get GIF File into buffer
Close fNum
i = 1
imgCount = 0
j = InStr(1, buf, GifEnd) + 1
fileHeader = Left(buf, j)
LoadGif = True
i = j + 2
If Len(fileHeader) >= 127 Then
RepeatTimes& = Asc(Mid(fileHeader, 126, 1)) + (Asc(Mid(fileHeader, 127, 1)) * 256&)
Else
RepeatTimes = 0
End If
Do ' Split GIF Files at separate pictures
' and load them into Image Array
imgCount = imgCount + 1
j = InStr(i, buf, GifEnd) + 3
If j > Len(GifEnd) Then
fNum = FreeFile
Open strFileName & "1.gif" For Binary As fNum
picbuf = String(Len(fileHeader) + j - i, Chr(0))
picbuf = fileHeader & Mid(buf, i - 1, j - i)
Put #fNum, 1, picbuf
imgHeader = Left(Mid(buf, i - 1, j - i), 16)
Close fNum
TimeWait = ((Asc(Mid(imgHeader, 4, 1))) + (Asc(Mid(imgHeader, 5, 1)) * 256&)) * 10&
If imgCount > 1 Then
xOff = Asc(Mid(imgHeader, 9, 1)) + (Asc(Mid(imgHeader, 10, 1)) * 256&)
yOff = Asc(Mid(imgHeader, 11, 1)) + (Asc(Mid(imgHeader, 12, 1)) * 256&)
Load aImg(imgCount - 1)
aImg(imgCount - 1).Left = aImg(0).Left + (xOff * Screen.TwipsPerPixelX)
aImg(imgCount - 1).Top = aImg(0).Top + (yOff * Screen.TwipsPerPixelY)
End If
' Use .Tag Property to save TimeWait interval for separate Image
aImg(imgCount - 1).Tag = TimeWait
TimeSpeed = TimeWait
aImg(imgCount - 1).Picture = LoadPicture(strFileName & "1.gif")
Kill (strFileName & "1.gif")
i = j
End If
DoEvents
Loop Until j = 3
' If there are one more Image - Load it
If i < Len(buf) Then
fNum = FreeFile
Open strFileName & "1.gif" For Binary As fNum
picbuf = String(Len(fileHeader) + Len(buf) - i, Chr(0))
picbuf = fileHeader & Mid(buf, i - 1, Len(buf) - i)
Put #fNum, 1, picbuf
imgHeader = Left(Mid(buf, i - 1, Len(buf) - i), 16)
Close fNum
TimeWait = ((Asc(Mid(imgHeader, 4, 1))) + (Asc(Mid(imgHeader, 5, 1)) * 256)) * 10
If imgCount > 1 Then
xOff = Asc(Mid(imgHeader, 9, 1)) + (Asc(Mid(imgHeader, 10, 1)) * 256)
yOff = Asc(Mid(imgHeader, 11, 1)) + (Asc(Mid(imgHeader, 12, 1)) * 256)
Load aImg(imgCount - 1)
aImg(imgCount - 1).Left = aImg(0).Left + (xOff * Screen.TwipsPerPixelX)
aImg(imgCount - 1).Top = aImg(0).Top + (yOff * Screen.TwipsPerPixelY)
End If
aImg(imgCount - 1).Tag = TimeWait
aImg(imgCount - 1).Picture = LoadPicture(strFileName & "1.gif")
Kill (strFileName & "1.gif")
End If
End Function
these code works, but some images don't show perfetly... can you tell me why?
-the 1st image is the result(in these function and other(that we was working, the result is the same)(forget the picturebox, see my UC);
-the 2nd image is the original animated gif.
thanks
Last edited by joaquim; Nov 10th, 2008 at 03:02 PM.
Why don't some images work correctly? I think I can answer that.
GIF frames have flags (called disposal codes) that tell a coder how to erase the frame before the next frame is drawn. These flags can be categorized into 3 cases. Canvas is the hDC. If your project does not account for these disposal codes, then not all gifs will draw as intended.
Case 0,1. Do nothing, this means that the canvas must be left unchanged.
Case 2. Erase just the canvas area of the frame, leaving everything else the same.
Case 3. Get the previous canvas, what it looked like before this frame was drawn.
Looking at your Halloween gif, every frame has a disposal code of #1. This means that none of the previous image controls should be made invisible until after the last one is drawn. You can verify this. Instead of making the previous control invisible, leave it visible. Run your gif for only 1 cycle and see if it draws ok. To get these disposal codes, you may not be able to use the code in your LoadGif routine. The disposal code must be parsed out and your code doesn't appear to have the ability to do that easily.
Last edited by LaVolpe; Nov 11th, 2008 at 02:23 PM.
Insomnia is just a byproduct of, "It can't be done"
Why don't some images work correctly? I think I can answer that.
GIF frames have flags (called disposal codes) that tell a coder how to erase the frame before the next frame is drawn. These flags can be categorized into 3 cases. Canvas is the hDC. If your project does not account for these disposal codes, then not all gifs will draw as intended.
Case 1. Do nothing, this means that the canvas must be left unchanged.
Case 2. Erase just the canvas area of the frame, leaving everything else the same.
Case 3. Get the previous canvas, what it looked like before this frame was drawn.
Looking at your Halloween gif, every frame has a disposal code of #1. This means that none of the previous image controls should be made invisible until after the last one is drawn. You can verify this. Instead of making the previous control invisible, leave it visible. Run your gif for only 1 cycle and see if it draws ok. To get these disposal codes, you may not be able to use the code in your LoadGif routine. The disposal code must be parsed out and your code doesn't appear to have the ability to do that easily.
honestly i don't understand both functions, but can you help me fix the problem?
(i'm sorry if i'm bored, but i need some help here)
thanks
Do what I asked first. Just run the halloween gif one time. Do not make the previous frame invisible. Do not set aImg(x).Visible=False. Did the gif draw correctly?
Insomnia is just a byproduct of, "It can't be done"
Do what I asked first. Just run the halloween gif one time. Do not make the previous frame invisible. Do not set aImg(x).Visible=False. Did the gif draw correctly?
i'm speak about last animated code that is using the 0(in array), in #9...
i have try test like you said, and the results that i have is: the function don't draw correctly the subimages...
in a timer i use the visible property(because the subimages are in same positon)...
thanks
I guess you didn't understand me. I know what the images look like. I have a GIF parser where I can look at each frame by itself. That GIF is suppose to be drawn like this.
aImg(0).Visible=True
aImg(1).Visible=True
aImg(2).Visible=True
aImg(3).Visible=True
aImg(4).Visible=True
aImg(5).Visible=True
For that gif, do not set .Visible=False. Now how does it look?
Insomnia is just a byproduct of, "It can't be done"
I guess you didn't understand me. I know what the images look like. I have a GIF parser where I can look at each frame by itself. That GIF is suppose to be drawn like this.
aImg(0).Visible=True
aImg(1).Visible=True
aImg(2).Visible=True
aImg(3).Visible=True
aImg(4).Visible=True
aImg(5).Visible=True
For that gif, do not set .Visible=False. Now how does it look?
help me in these calcule, please:
Code:
For i = 1 To PicAnimation.Count
PicAnimation(i).Top = (PicAnimation(i - 1).Top + PicAnimation(i - 1).Height) * (i + 1)
PicAnimation(i).Visible = True
Next i
is for put every images in vertical position(the 0 is in right position)...
thanks
You cannot treat every gif the same. The disposal code within the gif tells you what to do with the frame when the next frame is to be drawn. Your LoadGif routine needs to be tweaked to find and extract the disposal code, then your animation loop needs to handle all 3 disposal codes. You will have to do some rewriting.
Last edited by LaVolpe; Nov 11th, 2008 at 12:07 AM.
Insomnia is just a byproduct of, "It can't be done"
Try this. I modified the code from your first post. The modified code in your #9 post was not correct, you were making too many assumptions that could lead to invalid gif parsing.
Even the code in the 1st post is not perfect. For example, I don't see it parsing all GIF87a formats correctly. But luckily enough, the 87a format is not very common.
Here is the 1st post modified. It should handle all 3 disposal codes correctly.
Code:
Option Explicit
Private MyPath As String
Public TotalFrames As Long
Public LogicalWidth As Long, LogicalHeight As Long
Public myBackColor As Long
Public sGifMagic As String, Trailer As String
Public TimeSpeed As Long 'used in UC
Private Type BITMAPFILEHEADER '14 bytes
bfType As Integer
bfSize(3) As Byte 'Long
'bfSize As Long
bfReserved1 As Integer
bfReserved2 As Integer
'bfOffBits As Long
bfOffBits(3) As Byte
End Type
Private Declare Function GetTempFileName _
Lib "KERNEL32" Alias "GetTempFileNameA" _
(ByVal lpszPath As String, _
ByVal lpPrefixString As String, _
ByVal wUnique As Long, _
ByVal lpTempFileName As String) As Long
Private DisposalCode() As Byte
Private currentFrame As Long
Private LoopCount As Long
Private Function GetUniqueFilename(Optional Path As String = "", _
Optional Prefix As String = "", _
Optional UseExtension As String = "") _
As String
' Input strings must be NULL terminated.
Dim wUnique As Long
Dim lpTempFileName As String
Dim lngRet As Long
Dim FileHeader As BITMAPFILEHEADER
wUnique = 0
If Path = "" Then Path = CurDir
lpTempFileName = Space(255)
lngRet = GetTempFileName(Path, Prefix, _
wUnique, lpTempFileName)
lpTempFileName = Left(lpTempFileName, _
InStr(lpTempFileName, Chr(0)) - 1)
Call Kill(lpTempFileName)
If Len(UseExtension) > 0 Then
lpTempFileName = Left(lpTempFileName, Len(lpTempFileName) - 3) & UseExtension
End If
GetUniqueFilename = lpTempFileName
End Function
Private Sub AddDirSep(strPathName As String)
If Right$(RTrim$(strPathName), 1) <> "\" Then
strPathName = RTrim$(strPathName) & "\"
End If
End Sub
Public Function LoadGif(sFile As String, aImg As Variant) As Boolean
On Error Resume Next
Dim I As Long
Dim lngFind As Long, lngPreviousFind As Long, strTempFile As String
Dim hFile As Long
Dim sFileHeader As String, strTemp As String
Dim sBuff As String
Dim sPicsBuff As String
Dim TimeWait As Long
Dim bSkipImage As Boolean
TotalFrames = 0
If Dir$(sFile) = "" Or sFile = "" Then
Exit Function
End If
MyPath = App.Path
AddDirSep MyPath
If aImg.Count > 1 Then
For I = 1 To aImg.Count - 1
Unload aImg(I)
Next I
End If
sGifMagic = Chr$(0) & Chr$(&H21) & Chr$(&HF9)
Trailer = Chr$(0) & Chr$(59)
'load the gif into a string buffer
hFile = FreeFile
Open sFile For Binary Access Read As hFile
sBuff = String(LOF(hFile), Chr(0))
Get #hFile, , sBuff
Close #hFile
'find size of color table
If Asc(Mid(sBuff, 11, 1)) And 128 Then
lngFind = Asc(Mid(sBuff, 11, 1)) And 7
lngFind = 3 * (2 ^ (lngFind + 1))
End If
lngPreviousFind = lngFind + 13
sFileHeader = Left(sBuff, lngPreviousFind)
'GIF?
If Left$(sFileHeader, 3) <> "GIF" Then Exit Function
'temporary file
hFile = FreeFile
strTempFile = GetUniqueFilename(MyPath, "p" & Chr(0), "GIF")
Open strTempFile For Binary As hFile
'locate start of a frame
lngPreviousFind = InStr(lngPreviousFind + 1, sBuff, sGifMagic)
If lngPreviousFind = 0& Then lngPreviousFind = Len(sFileHeader)
Do
lngFind = InStr(lngPreviousFind + 1, sBuff, sGifMagic)
If lngFind = 0& Then lngFind = Len(sBuff) + 1
sPicsBuff = Mid(sBuff, lngPreviousFind + 1, lngFind - lngPreviousFind - 1) & Trailer
Put #hFile, 1, sFileHeader & sPicsBuff
If TotalFrames = 0 Then
aImg(0).Visible = False
aImg(0).Picture = LoadPicture(strTempFile)
If aImg(0).Picture.Handle = 0 Then bSkipImage = True
Else
Load aImg(TotalFrames)
aImg(TotalFrames).ZOrder
aImg(TotalFrames).Picture = LoadPicture(strTempFile)
If aImg(TotalFrames).Picture.Handle = 0 Then
Unload aImg(TotalFrames)
bSkipImage = True
Else
bSkipImage = False
End If
End If
If bSkipImage = False Then
ReDim Preserve DisposalCode(0 To TotalFrames)
DisposalCode(TotalFrames) = ((Asc(Mid$(sBuff, lngFind + 4, 1)) \ 4) And 3)
'frame delay
TimeWait = ((Asc(Mid(sPicsBuff, 5, 1))) + (Asc(Mid(sPicsBuff, 6, 1)) * 256&)) * 10&
If TimeWait < 30 Then TimeWait = 30 'set a minimum delay time here
If TimeWait > 65535 Then TimeWait = 65535
aImg(TotalFrames).Tag = TimeWait
'position
If TotalFrames > 0 Then
aImg(TotalFrames).Left = aImg(0).Left + Asc(Mid(sPicsBuff, 10, 1)) + (Asc(Mid(sPicsBuff, 11, 1)) * 256&)
aImg(TotalFrames).Top = aImg(0).Top + Asc(Mid(sPicsBuff, 12, 1)) + (Asc(Mid(sPicsBuff, 13, 1)) * 256&)
End If
lngPreviousFind = lngFind
TotalFrames = TotalFrames + 1
End If
Loop Until lngPreviousFind > Len(sBuff)
Close #hFile
Kill strTempFile
LoopCount = 1
If aImg(0).Picture.Handle <> 0& Then
TotalFrames = aImg.Count + 1
If TotalFrames > 1 Then
' look for the loop count identified by Block Introducer 33 & Identifier of 255 followed by 11 bytes
lngFind = InStr(Len(sFileHeader) + 1, sBuff, Chr$(33) & Chr$(255) & Chr$(11))
If lngFind Then
If LCase(Mid$(sBuff, lngFind + 3, 11)) = "netscape2.0" Then
If Asc(Mid$(sBuff, lngFind + 14)) = 3 Then
LoopCount = Asc(Mid$(sBuff, lngFind + 16, 1)) + (Asc(Mid$(sBuff, lngFind + 17, 1))) * 256&
If LoopCount = 0 Then LoopCount = 1
End If
End If
End If
End If
LoadGif = True
Else
TotalFrames = 0
End If
On Error GoTo 0
End Function
Private Sub Command1_Click()
If LoadGif("C:\Program Files\Microsoft Visual Studio\VB98\Projects\aniGIFctrl\_2216016.gif", picAnimation) = True Then
If picAnimation.Count = 1 Then
picAnimation(0).Visible = True
Else
currentFrame = picAnimation.Count - 1
Timer1.Interval = 1
End If
End If
End Sub
Private Sub Form_Load()
Me.ScaleMode = vbPixels
End Sub
Private Sub Timer1_Timer()
Timer1.Interval = 0&
Dim I As Integer
If currentFrame = picAnimation.Count - 1 Then
For I = 1 To currentFrame
picAnimation(I).Visible = False
Next
currentFrame = -1
Else
Select Case DisposalCode(currentFrame)
Case 2: ' remove all previous frames
For I = 0 To currentFrame
picAnimation(I).Visible = False
Next
Case 3: ' remove last frame only
picAnimation(I).Visible = False
End Select
End If
currentFrame = currentFrame + 1
picAnimation(currentFrame).Visible = True
Timer1.Interval = Val(picAnimation(currentFrame).Tag)
End Sub
Last edited by LaVolpe; Nov 11th, 2008 at 08:17 AM.
Insomnia is just a byproduct of, "It can't be done"
If you put what I posted into a new form and add these objects, you should have no drawing problems. I used your halloween gif and had no problems at all.
Add 1 Command button, named Command1
Add 1 Timer, named Timer1
Add 1 image control, named picAnimation. Change its Index value to 0
Change the path/file name to your halloween gif & run the project. What drawing problems do you have?
Insomnia is just a byproduct of, "It can't be done"
If you put what I posted into a new form and add these objects, you should have no drawing problems. I used your halloween gif and had no problems at all.
Add 1 Command button, named Command1
Add 1 Timer, named Timer1
Add 1 image control, named picAnimation. Change its Index value to 0
Change the path/file name to your halloween gif & run the project. What drawing problems do you have?
ok i test it and works fine... but i have a question: if here is working fine, why in my UC isn't draw right(i have seen it in others projects, like that i give you)?
(did you want my groupproject?)
thanks
No. It sounds like you are having the problems changing the code. Take your time and change it as you need to. If it works in one project, then you are making errors when you move/modify it to your other project. Take your time and do it correctly. I already fixed what you posted in #1.
Insomnia is just a byproduct of, "It can't be done"
No. It sounds like you are having the problems changing the code. Take your time and change it as you need to. If it works in one project, then you are making errors when you move/modify it to your other project. Take your time and do it correctly. I already fixed what you posted in #1.
what is the DisposalCode()?
i'm sorry but it's dificulty understand the code..
what is the DisposalCode()?
i'm sorry but it's dificulty understand the code..
Disposal Code is a value between 0 and 3, one disposal code for each frame. It must be parsed out for your GIFs to draw correctly. You will see how it is used in the Timer1 event of the code I posted. In my previous posts, I described what the disposal codes mean. A disposal code tells you what you need to do with the frame when the next frame is ready to be drawn.
Insomnia is just a byproduct of, "It can't be done"
Private Sub tmrAnimation_Timer()
Dim X As Long
Dim Y As Long
Dim I As Integer
If blnDestroyed = True Then
tmrAnimation.Enabled = False
Exit Sub
End If
On Error Resume Next
If Animation = AnimationPause Or Animation = AnimationStopped Then
tmrAnimation.Enabled = False
Exit Sub
End If
If UCase(strFileName) Like "*.GIF" And lngTotalSubImages > 1 Then
tmrAnimation.Interval = 0&
If lngActualSubImage = PicAnimation.Count - 1 Then
For I = 1 To lngActualSubImage
PicAnimation(I).Visible = False
Next
lngActualSubImage = -1
Else
Select Case DisposalCode(lngActualSubImage)
Case 2: ' remove all previous frames
For I = 0 To lngActualSubImage
PicAnimation(I).Visible = False
Next
Case 3: ' remove last frame only
PicAnimation(I).Visible = False
End Select
End If
lngActualSubImage = lngActualSubImage + 1
PicAnimation(currentFrame).Visible = True
tmrAnimation.Interval = Val(PicAnimation(lngActualSubImage).Tag)
Else
If lngActualSubImage < PicAnimation.Count - 1 Then
lngActualSubImage = lngActualSubImage + 1
Else
If Strip.Activate = True Then
lngActualSubImage = 1
Else
lngActualSubImage = 0
End If
End If
End If
Call ShowImage
End Sub
the showimage procedure is for draw the image in UC, but see the code... then tell me what isn't right.
thanks
Before the timer starts, set lngActualSubImage = PicAnimation.Count - 1
Or change the following line so your routine knows to reset all controls Visible=False when the animation starts over
If lngActualSubImage = PicAnimation.Count - 1 Then
Walk thru your code and see what is wrong. Place a Stop in the timer, and press F8 to continue one line at a time.
Insomnia is just a byproduct of, "It can't be done"
"So where is your LoadGif function? Is it the one in mdlAnimatedGifs.bas?"
the #1 code is in module1.bas(is in moment in grouproject, and the mdlAnimatedGifs.bas isn't use for now
"If so where is the code I posted?"
in UC, in tmrAnimation...
thanks
"So where is your LoadGif function? Is it the one in mdlAnimatedGifs.bas?"
the #1 code is in module1.bas(is in moment in grouproject, and the mdlAnimatedGifs.bas isn't use for now
"If so where is the code I posted?"
in UC, in tmrAnimation...
thanks
No, I meant where is the LoadGif function I fixed? I spent a little time fixing that for you. If you don't want to use that code or at least modify it to work for you, then I can't help you. I am not going to fix your newer version of LoadGif, you will have to do that.
Insomnia is just a byproduct of, "It can't be done"
No, I meant where is the LoadGif function I fixed? I spent a little time fixing that for you. If you don't want to use that code or at least modify it to work for you, then I can't help you. I am not going to fix your newer version of LoadGif, you will have to do that.
i'm sorry, yes is the function that you fix me...
when you enter in groupproject you have the mdlAnimatedGifs module in pjtSprite.
(forget the other function, like i did)
thanks
You have to look more at your code. You have to be able to modify your transparency routines to create masks that will also blend to the images drawn on the uc's DC, not just blend to the uc's backcolor.
To see what I mean,
1. In your uc's Show event, add this before you activate the timer
lngActualSubImage = PicAnimation.Count - 1
2. In the timer event, place a breakpoint/stop on this line
tmrAnimation.Interval = Val(PicAnimation(lngActualSubImage).Tag)
3. Each time the code stops on that line, look at your usercontrol. Then press F5. Look at the uc again, etc, etc.
The pictureboxes are not designed to blend to the image that was already drawn. It appears the code was written assuming that every time a frame is drawn it completely erases the previous frame first. Unfortunately, that is not true.
There is no way I can spend the time needed to help you fix the project. It may take a lot of effort.
Insomnia is just a byproduct of, "It can't be done"
You have to look more at your code. You have to be able to modify your transparency routines to create masks that will also blend to the images drawn on the uc's DC, not just blend to the uc's backcolor.
To see what I mean,
1. In your uc's Show event, add this before you activate the timer
lngActualSubImage = PicAnimation.Count - 1
2. In the timer event, place a breakpoint/stop on this line
tmrAnimation.Interval = Val(PicAnimation(lngActualSubImage).Tag)
3. Each time the code stops on that line, look at your usercontrol. Then press F5. Look at the uc again, etc, etc.
The pictureboxes are not designed to blend to the image that was already drawn. It appears the code was written assuming that every time a frame is drawn it completely erases the previous frame first. Unfortunately, that is not true.
There is no way I can spend the time needed to help you fix the project. It may take a lot of effort.
honestly, i must say: THANKS FOR HELP ME.
ok.. i will see better the code... but i need ask you 1 thing(i'm sorry if i'm ask you again): you sod the animatedgifcontrol project, right?
what i did was only copy the loadgif function, but without results(only with your help)... i don't understand why...
anotherthing i can read very animated gif files, but why with these image and others is doing these draw error?
honestly is confuse for me...
i will see better the code.
thank you very much for help me... thanks
honestly, i must say: THANKS FOR HELP ME.
ok.. i will see better the code... but i need ask you 1 thing(i'm sorry if i'm ask you again): you sod the animatedgifcontrol project, right?
what i did was only copy the loadgif function, but without results(only with your help)... i don't understand why...
anotherthing i can read very animated gif files, but why with these image and others is doing these draw error?
honestly is confuse for me...
i will see better the code.
thank you very much for help me... thanks
Reading animated gifs is one thing. Drawing them correctly is another thing.
I don't know if you can use my animated gif control, if you can you are welcome to it. http://www.vbforums.com/showthread.php?t=546480
Insomnia is just a byproduct of, "It can't be done"
Reading animated gifs is one thing. Drawing them correctly is another thing.
I don't know if you can use my animated gif control, if you can you are welcome to it. http://www.vbforums.com/showthread.php?t=546480
i'm sorry LaVolte, but the draw problem can be fixed in function(when the subimages are drawed)?
(i'm realy sorry if i'm bored you with these problem)
thanks
Hi LaVolte
i found 1 thing in animated gif files: some gif don't show entire image, they plus 2 images(i don't know if you try to tell me these). how can i see if i need plus the images?
is the DisposalCode variable that give me that information?
i'm sorry and thanks
Hi LaVolte
i found 1 thing in animated gif files: some gif don't show entire image, they plus 2 images(i don't know if you try to tell me these). how can i see if i need plus the images?
is the DisposalCode variable that give me that information?
i'm sorry and thanks
Yes, the disposal code.
Many GIFs don't include the entire frame. They may just be part of the overall picture. See post #10 above.
honestly, the problem can be resolved in function(these lines are in end of the function):
Code:
Load aImg(aImg.Count)
For I = 0 To aImg.Count - 2 'test every frames(the last picturebox is for change the image, for put the right frame in picturebox I)
Select Case DisposalCode(I)
Case 2:
aImg(aImg.Count - 1).Cls
aImg(aImg.Count - 1).Picture = aImg(I - 1).Image
TransparentBlt aImg(aImg.Count - 1).hdc, 0, 0, aImg(I).Width, aImg(I).Height, aImg(I).hdc, 0, 0, aImg(I).Width, aImg(I).Height, GetPixel(aImg(I).hdc, 0, 0)
aImg(I).Picture = aImg(aImg.Count - 1).Image
End Select
Next I
Unload aImg(aImg.Count - 1)
isn't complete, because i continue confuse with what you said about that cases(i'm sorry)...
thanks
Last edited by joaquim; Nov 21st, 2008 at 06:32 PM.
Disposal Method - Indicates the way in which the graphic is to
be treated after being displayed.
Values : 0 - No disposal specified. The decoder is
not required to take any action.
1 - Do not dispose. The graphic is to be left
in place.
2 - Restore to background color. The area used by the
graphic must be restored to the background color.
3 - Restore to previous. The decoder is required to
restore the area overwritten by the graphic with
what was there prior to rendering the graphic.
4-7 - To be defined.
Insomnia is just a byproduct of, "It can't be done"
Reply With Quote
Originally Posted by joaquim
