End of
GCE Data
4 Bytes of |
GCE Data | Image
| | Descriptor
GCE | Byte: | | UL Corner
Indicator | X1 X2 X3 X4 | | of Image Width Height
| | | | | | | | X Y | |
| 21 F9 | 04 | 05 32 00 09 00 | 2C | 00 00 00 00 | 13 00 | 19 00 |
i can convert the values... i know do that for catch the results. but i know theres more speed than a 2 for's cycle's
can you tell me how can i calculate these and the Image Decriptor - Packed Field?
(seems that every Packed Field have it's own calculation, that i don't know where i found them)
thanks for all
To show you how easy it is to extract the frames from a GIF file just download this simple little app and run it
Anything I post is an example only and is not intended to be the only solution, the total solution nor the final solution to your request nor do I claim that it is. If you find it useful then it is entirely up to you to make whatever changes necessary you feel are adequate for your purposes.
i can convert the values... i know do that for catch the results. but i know theres more speed than a 2 for's cycle's
can you tell me how can i calculate these and the Image Decriptor - Packed Field?
(seems that every Packed Field have it's own calculation, that i don't know where i found them)
thanks for all
Bytes X2 and X3 are the delay speed of the image
See post #80
Anything I post is an example only and is not intended to be the only solution, the total solution nor the final solution to your request nor do I claim that it is. If you find it useful then it is entirely up to you to make whatever changes necessary you feel are adequate for your purposes.
Just make sure you completely understand the LZW Compression algorithm used to compress the image data
Anything I post is an example only and is not intended to be the only solution, the total solution nor the final solution to your request nor do I claim that it is. If you find it useful then it is entirely up to you to make whatever changes necessary you feel are adequate for your purposes.
Just make sure you completely understand the LZW Compression algorithm used to compress the image data
something for share: http://www.matthewflickinger.com/lab..._and_bytes.asp
and for Packed Fields, if i will have problems, i will use the slow way lol convert decimal to binary and then i catch what i need and convert it to decimal
thanks for all
wow.. i forget 1 important thing on code
ok... now i did it:
"'Special thanks to jmsrickland from www.VBForums.com"
thanks for everything my friend... thanks
can you explain better some methods?
0 - we ignore it and show the animation normal;
1 - ActualFrame = PreviousFrame + TransparentActualFrame;
2 - ActualFrame = PreviousFrameBackColor + ActualFrame;
3 - ActualImage = PreviousImage + NextImage????
correct me if i don't have right... but the method 3.... i don't belive that it's correct
can you explain better some methods?
0 - we ignore it and show the animation normal;
1 - ActualFrame = PreviousFrame + TransparentActualFrame;
2 - ActualFrame = PreviousFrameBackColor + ActualFrame;
3 - ActualImage = PreviousImage + NextImage????
correct me if i don't have right... but the method 3.... i don't belive that it's correct
can you explain better some methods?
0 - we ignore it and show the animation normal;
1 - ActualFrame = PreviousFrame + TransparentActualFrame;
2 - ActualFrame = PreviousFrameBackColor + ActualFrame; 3 - ActualImage = PreviousImage + NextImage????
correct me if i don't have right... but the method 3.... i don't belive that it's correct
No, you do not have it right. You are interpreting the meaning incorrectly. It doesn't tell you to use the previous image; it tells you to restore the previous state
Disposal Method
0 Means not required to take any action; in otherwords you can just leave it as is
or discard it - it's your choice.
1 Means to leave the image in place and draw the next image on top of it if there is a next image. This value is meaningless on the last frame and should not occur. If the animation starts over again then the entire area is cleared as it was before the first frame was rendered.
2 The area (canvas) should be restored to the background color (as indicated by the logical screen descriptor).
3 Means to restore the area (canvas) to its previous state before this frame is rendered. This value is meaningless on the first frame and should not occur.
Then scroll down till you find these links and click on them. They are in same order as I list them here
Creating Animated GIFs (Web Design in a Nutshell, 2nd Edition)
GIF Animation and Disposal Methods - GIF Animation Studio ...
Animated GIF's
Last edited by jmsrickland; Aug 17th, 2012 at 06:48 PM.
Anything I post is an example only and is not intended to be the only solution, the total solution nor the final solution to your request nor do I claim that it is. If you find it useful then it is entirely up to you to make whatever changes necessary you feel are adequate for your purposes.
No, you do not have it right. You are interpreting the meaning incorrectly. It doesn't tell you to use the previous image; it tells you to restore the previous state
Disposal Method
0 Means not required to take any action; in otherwords you can just leave it as is
or discard it - it's your choice.
1 Means to leave the image in place and draw the next image on top of it if there is a next image. This value is meaningless on the last frame and should not occur. If the animation starts over again then the entire area is cleared as it was before the first frame was rendered.
2 The area (canvas) should be restored to the background color (as indicated by the logical screen descriptor).
3 Means to restore the area (canvas) to its previous state before this frame is rendered. This value is meaningless on the first frame and should not occur.
i don't know why a can't see the text, only selected lol
what means: "leave it up to the Browser/Viewer"?
is for i ignore the method?
Sorry, I do not understand your statement.
Anything I post is an example only and is not intended to be the only solution, the total solution nor the final solution to your request nor do I claim that it is. If you find it useful then it is entirely up to you to make whatever changes necessary you feel are adequate for your purposes.
It's the same thing as I stated for Method 0 in my post #90
Disposal Method
0 Means [Browser, GIF Viewer, or you are] not required to take any action; in otherwords you can just leave it as is
or discard it - it's your choice.
Anything I post is an example only and is not intended to be the only solution, the total solution nor the final solution to your request nor do I claim that it is. If you find it useful then it is entirely up to you to make whatever changes necessary you feel are adequate for your purposes.
fNum = FreeFile
Open "temp.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
i don't have sure, but help me on these... what they put on picbuf variable?
(i'm trying understand these, but isn't easy. but you can just use a digram)
fNum = FreeFile
Open "temp.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
i don't have sure, but help me on these... what they put on picbuf variable?
(i'm trying understand these, but isn't easy. but you can just use a digram)
Simple enough. When you use Binary as your input type you need to initialize a buffer the length of the file you are going to read. One way to do this is to Open the file As Binary then do the following:
Code:
'
'
InputBuffer = String(LOF(#fNum), 0)
'
'
The above initializes the buffer with binary zeros for the length of the file you just opened. LOF(#fNum) means Length Of File specified by #fNum.
Now you just Get the data into that buffer
Code:
'
Get #fNum ,1, 1, InputBuffer
'
When you use Binary as your output type you do not need to do this; you just Put the data thats in a string however the string data must have been defined as a String variable or the output will be off by 4 bytes. So, for output you just do this:
Code:
'
Dim OutputBuffer As String
'
'
'
OutputBuffer = fileHeader & Mid(buf, i - 1, Len(buf) - i)
Open App.Path & "\MyFile.txt" For Binary As #fNum
Put #fNum, 1, OutputBuffer
Close #fNum
'
In the code snippet you posted the line
picbuf = String(Len(fileHeader) + Len(buf) - i, Chr(0))
is not needed. I don't know why the coder put it there.
But, nevertheless it means to take the length of fileheader plus the length of buf minus 1 and fill picbuf with that many binary zeros.
Anything I post is an example only and is not intended to be the only solution, the total solution nor the final solution to your request nor do I claim that it is. If you find it useful then it is entirely up to you to make whatever changes necessary you feel are adequate for your purposes.
Simple enough. When you use Binary as your input type you need to initialize a buffer the length of the file you are going to read. One way to do this is to Open the file As Binary then do the following:
Code:
'
'
InputBuffer = String(LOF(#fNum), 0)
'
'
The above initializes the buffer with binary zeros for the length of the file you just opened. LOF(#fNum) means Length Of File specified by #fNum.
Now you just Get the data into that buffer
Code:
'
Get #fNum ,1, 1, InputBuffer
'
When you use Binary as your output type you do not need to do this; you just Put the data thats in a string however the string data must have been defined as a String variable or the output will be off by 4 bytes. So, for output you just do this:
Code:
'
Dim OutputBuffer As String
'
'
'
OutputBuffer = fileHeader & Mid(buf, i - 1, Len(buf) - i)
Open App.Path & "\MyFile.txt" For Binary As #fNum
Put #fNum, 1, OutputBuffer
Close #fNum
'
In the code snippet you posted the line
picbuf = String(Len(fileHeader) + Len(buf) - i, Chr(0))
is not needed. I don't know why the coder put it there.
But, nevertheless it means to take the length of fileheader plus the length of buf minus 1 and fill picbuf with that many binary zeros.
Not sure what you are asking by using the normal gif format. You already know that each frame has it's own control bytes that indicates for one thing the X ant Y offsets and it's width and height (Image Descriptor) to use in order to place that image on the canvas with respect to the canvas' X and Y and it's width and height which is specified in the Logical Screen Descriptor.
Anything I post is an example only and is not intended to be the only solution, the total solution nor the final solution to your request nor do I claim that it is. If you find it useful then it is entirely up to you to make whatever changes necessary you feel are adequate for your purposes.
Not sure what you are asking by using the normal gif format. You already know that each frame has it's own control bytes that indicates for one thing the X ant Y offsets and it's width and height (Image Descriptor) to use in order to place that image on the canvas with respect to the canvas' X and Y and it's width and height which is specified in the Logical Screen Descriptor.
like saing:
picbuf =heather + logical screen + grafic control + image description + image data(these last 3 have the actual frame, only 1 frame) + trailer(3B)
i can do in these way?
the Global Color Table have 12 bytes?
Last edited by joaquim; Aug 20th, 2012 at 01:52 PM.
picbuf =heather + logical screen + grafic control + image description + image data(these last 3 have the actual frame, only 1 frame) + trailer(3B)
i can do in these way?
Since it has only 1 frame then why do anything? You would just use the entire file so picbuf = buf. No need to pick out each section and then turn around and put them back together again.
the Global Color Table have 12 bytes?
I don't know how many bytes in table. It varies from one gif file to another
Anything I post is an example only and is not intended to be the only solution, the total solution nor the final solution to your request nor do I claim that it is. If you find it useful then it is entirely up to you to make whatever changes necessary you feel are adequate for your purposes.
picbuf =heather + logical screen + grafic control + image description + image data(these last 3 have the actual frame, only 1 frame) + trailer(3B)
i can do in these way?
Since it has only 1 frame then why do anything? You would just use the entire file so picbuf = buf. No need to pick out each section and then turn around and put them back together again.
the Global Color Table have 12 bytes?
I don't know how many bytes in table. It varies from one gif file to another
i mean for build the temp file
if the Global Color Table depends on the file... then i know that Graphics Control Extension starts on '21',but how can i test it with InStr() function?
I kind of thought you understood that program you were using; the one you last posted posted. The code is in there but just in case you don't understand it you need to scan for &H21F9; not just &H21 as that will occur many times and it won't be for the GCE.
You need to do this
InStr(13, fileHeader, Chr(33) & Chr(249))
The 13 is the starting position for the scan. If there are more than one GCE's then you need to always start at the next position after you find a GCE indicator
Anything I post is an example only and is not intended to be the only solution, the total solution nor the final solution to your request nor do I claim that it is. If you find it useful then it is entirely up to you to make whatever changes necessary you feel are adequate for your purposes.
I kind of thought you understood that program you were using; the one you last posted posted. The code is in there but just in case you don't understand it you need to scan for &H21F9; not just &H21 as that will occur many times and it won't be for the GCE.
You need to do this
InStr(13, fileHeader, Chr(33) & Chr(249))
The 13 is the starting position for the scan. If there are more than one GCE's then you need to always start at the next position after you find a GCE indicator
for the 1st frame i use: InStr(13, fileHeader, Chr(33) & Chr(249)). for the next frame i save the last position of file header and i use: InStr(13, fileHeader, Chr(33) & Chr(249)). if the result is '0' i test the 3B(chr(59)) and i know that is the end of file
Code:
s = InStr(13, FileBuffer, Chr(33) & Chr(249)) 'Grafic Control position
'Debug.Print InStr(s + 2, FileBuffer, Chr(33) & Chr(249))
If InStr(s + 2, FileBuffer, Chr(33) & Chr(249)) = 0 Then 'test the s position(i did more 2 because of Chr(33) and Chr(249))
aimg(0).Picture = LoadPicture(strFileName)
'the image is static and not animated;)
Exit Sub
End If
Option Explicit
Private Enum GifType
GIF87A = 0
GIF89A = 1
End Enum
Private Type LogicalScreenDescriptor
GifWidth As Long
GifHeight As Long
GlobalColorSize As Long
SortFlag As Long
ColorResolution As Long
GlobalColorFlag As Long
Backcolor As Long
PixelRadio As Long
End Type
Public Sub LoadGifFile(strFileName As String, aimg As Variant)
Dim GifHeader As GifType
Dim strLogicalScreenDescription As String
Dim LSDLogicalScreenDescription As LogicalScreenDescriptor
Dim strGifHeader As String
Dim fNum As Integer
Dim FileBuffer As String
Dim PictureBuffer As String
Dim PackedField As String
Dim i As Integer
'Test if the file exists
If Dir$(strFileName) = "" Or strFileName = "" Then
MsgBox "File " & strFileName & " not found", vbCritical
Exit Sub
End If
'Put all file info to a variable
fNum = FreeFile
Open strFileName For Binary Access Read As fNum
FileBuffer = String(LOF(fNum), Chr(0))
Get #fNum, , FileBuffer
Close fNum
'unload all pictureboxes\images
For i = 1 To aimg.Count - 1
Unload aimg(i)
Next i
'Gif Header
strGifHeader = Left$(FileBuffer, 6)
If strGifHeader = LCase("gif87a") Then
GifHeader = GIF87A
Else
GifHeader = GIF89A
End If
'Logical Screen Description
strLogicalScreenDescription = Mid$(FileBuffer, 7, 7)
LSDLogicalScreenDescription.GifWidth = Asc(Left$(strLogicalScreenDescription, 2))
LSDLogicalScreenDescription.GifHeight = Asc(Mid$(strLogicalScreenDescription, 2, 2))
PackedField = Asc(Mid$(strLogicalScreenDescription, 5, 1))
PackedField = DecimalToBinary(PackedField)
LSDLogicalScreenDescription.GlobalColorFlag = Asc(BinaryToDecimal(Mid$(PackedField, 1, 1)))
LSDLogicalScreenDescription.ColorResolution = Asc(BinaryToDecimal(Mid$(PackedField, 2, 3)))
LSDLogicalScreenDescription.GlobalColorFlag = Asc(BinaryToDecimal(Mid$(PackedField, 5, 1)))
LSDLogicalScreenDescription.GlobalColorSize = Asc(BinaryToDecimal(Mid$(PackedField, 6, 3)))
LSDLogicalScreenDescription.Backcolor = Asc(Mid$(strLogicalScreenDescription, 6, 1))
LSDLogicalScreenDescription.PixelRadio = Asc(Mid$(strLogicalScreenDescription, 7, 1))
Dim s As Long
s = InStr(13, FileBuffer, Chr(33) & Chr(249))
'Debug.Print InStr(s + 2, FileBuffer, Chr(33) & Chr(249))
'if the image isn't animated, then just draw it;)
If InStr(s + 2, FileBuffer, Chr(33) & Chr(249)) = 0 Then
aimg(0).Picture = LoadPicture(strFileName)
'Exit Sub
End If
Debug.Print Asc(Right$(FileBuffer, 1)) 'i will recive 59... but with hex() function, i recive '3B';)
End Sub
by some reason i get an error when i try put the data on variable for create the file
Code:
Option Explicit
Private Enum GifType
GIF87A = 0
GIF89A = 1
End Enum
Private Type LogicalScreenDescriptor
GifWidth As Long
GifHeight As Long
GlobalColorSize As Long
SortFlag As Long
ColorResolution As Long
GlobalColorFlag As Long
Backcolor As Long
PixelRadio As Long
End Type
Private Type GraphicControl
Disposal As Long
Delay As Long
TransparentColor As Long
End Type
Private Type ImageDescription
FrameLeft As Long
FrameTop As Long
FrameWidth As Long
FrameHeight As Long
End Type
Public Sub LoadGifFile(strFileName As String, aimg As Variant)
Dim GifHeader As GifType
Dim strLogicalScreenDescription As String
Dim LSDLogicalScreenDescription As LogicalScreenDescriptor
Dim GCGraficControl As GraphicControl
Dim IDImageDescription As ImageDescription
Dim strGifHeader As String
Dim strFrame As String
Dim fNum As Integer
Dim FileBuffer As String
Dim PictureBuffer As String
Dim PackedField As String
Dim FirstFrame As Long
Dim i As Integer
'Test if the file exists
If Dir$(strFileName) = "" Or strFileName = "" Then
MsgBox "File " & strFileName & " not found", vbCritical
Exit Sub
End If
'Put all file info to a variable
fNum = FreeFile
Open strFileName For Binary Access Read As fNum
FileBuffer = String(LOF(fNum), Chr(0))
Get #fNum, , FileBuffer
Close fNum
'unload all pictureboxes\images
For i = 1 To aimg.Count - 1
Unload aimg(i)
Next i
'Gif Header
strGifHeader = Left$(FileBuffer, 6)
If strGifHeader = "GIF87a" Then
GifHeader = GIF87A
ElseIf strGifHeader = "GIF89a" Then
GifHeader = GIF89A
End If
'Test if the Gif is animated or not
FirstFrame = InStr(13, FileBuffer, Chr(33) & Chr(249))
'if the image isn't animated, then just draw it;)
If InStr(FirstFrame + 2, FileBuffer, Chr(33) & Chr(249)) = 0 Then
aimg(0).Picture = LoadPicture(strFileName)
Exit Sub
End If
'Logical Screen Description
strLogicalScreenDescription = Mid$(FileBuffer, 7, 7)
LSDLogicalScreenDescription.GifWidth = Asc(Left$(strLogicalScreenDescription, 2))
LSDLogicalScreenDescription.GifHeight = Asc(Mid$(strLogicalScreenDescription, 2, 2))
PackedField = Asc(Mid$(strLogicalScreenDescription, 5, 1))
PackedField = DecimalToBinary(PackedField)
LSDLogicalScreenDescription.GlobalColorFlag = Asc(BinaryToDecimal(Mid$(PackedField, 1, 1)))
LSDLogicalScreenDescription.ColorResolution = Asc(BinaryToDecimal(Mid$(PackedField, 2, 3)))
LSDLogicalScreenDescription.GlobalColorFlag = Asc(BinaryToDecimal(Mid$(PackedField, 5, 1)))
LSDLogicalScreenDescription.GlobalColorSize = Asc(BinaryToDecimal(Mid$(PackedField, 6, 3)))
LSDLogicalScreenDescription.Backcolor = Asc(Mid$(strLogicalScreenDescription, 6, 1))
LSDLogicalScreenDescription.PixelRadio = Asc(Mid$(strLogicalScreenDescription, 7, 1))
'image count
i = 0
Do
'get frame string
strFrame = Mid$(FileBuffer, FirstFrame, Len(FileBuffer) - FirstFrame)
'Get Grafic Control
PackedField = Asc(Mid$(strFrame, 4, 1))
PackedField = DecimalToBinary(PackedField)
GCGraficControl.Disposal = Asc(BinaryToDecimal(Mid$(PackedField, 4, 3)))
GCGraficControl.Delay = Asc(Mid$(strFrame, 5, 2))
GCGraficControl.TransparentColor = Asc(Mid$(strFrame, 7, 1))
'Get Image Description
IDImageDescription.FrameLeft = Asc(Mid$(strFrame, 10, 2))
IDImageDescription.FrameTop = Asc(Mid$(strFrame, 12, 2))
IDImageDescription.FrameWidth = Asc(Mid$(strFrame, 14, 2))
IDImageDescription.FrameHeight = Asc(Mid$(strFrame, 16, 2))
'If the image array don't exist then create\load it
If i > 0 Then
Load aimg(i)
End If
'create the image temp
fNum = FreeFile
Open "temp.gif" For Binary As fNum
Debug.Print Mid$(FileBuffer, FirstFrame, Len(FileBuffer) - strFrame - 1) ' error '13': type mismatch
If Mid$(FileBuffer, FirstFrame, Len(FileBuffer) - strFrame - 1) <> 0 Then
PictureBuffer = Mid$(FileBuffer, 1, FirstFrame - 1) & Mid$(strFrame, 0, Len(FileBuffer) - strFrame - 1) & Chr(59) '3B
Else
PictureBuffer = Mid$(FileBuffer, 1, FirstFrame - 1) & Mid$(strFrame, 0, Len(FileBuffer) - 1) & Chr(59) '3B
End If
Put #fNum, 1, PictureBuffer
Close fNum
'now load the image
aimg(i).Picture = LoadPicture("temp.gif")
'now we can delete the temp file
Kill "temp.gif"
'change the properties
aimg(i).Tag = GCGraficControl.Delay
'test if theres another image
If InStr(FirstFrame + 2, FileBuffer, Chr(33) & Chr(249)) = 0 Then
Exit Do
Else
FirstFrame = InStr(FirstFrame + 2, FileBuffer, Chr(33) & Chr(249))
End If
i = i + 1
Loop
Debug.Print i
End Sub
see on do...loop code. in last lines i'm trying put all data on string.
please tell me what isn't right
by some reason i get an error when i try put the data on variable for create the file
Code:
Option Explicit
Private Enum GifType
GIF87A = 0
GIF89A = 1
End Enum
Private Type LogicalScreenDescriptor
GifWidth As Long
GifHeight As Long
GlobalColorSize As Long
SortFlag As Long
ColorResolution As Long
GlobalColorFlag As Long
Backcolor As Long
PixelRadio As Long
End Type
Private Type GraphicControl
Disposal As Long
Delay As Long
TransparentColor As Long
End Type
Private Type ImageDescription
FrameLeft As Long
FrameTop As Long
FrameWidth As Long
FrameHeight As Long
End Type
Public Sub LoadGifFile(strFileName As String, aimg As Variant)
Dim GifHeader As GifType
Dim strLogicalScreenDescription As String
Dim LSDLogicalScreenDescription As LogicalScreenDescriptor
Dim GCGraficControl As GraphicControl
Dim IDImageDescription As ImageDescription
Dim strGifHeader As String
Dim strFrame As String
Dim fNum As Integer
Dim FileBuffer As String
Dim PictureBuffer As String
Dim PackedField As String
Dim FirstFrame As Long
Dim i As Integer
'Test if the file exists
If Dir$(strFileName) = "" Or strFileName = "" Then
MsgBox "File " & strFileName & " not found", vbCritical
Exit Sub
End If
'Put all file info to a variable
fNum = FreeFile
Open strFileName For Binary Access Read As fNum
FileBuffer = String(LOF(fNum), Chr(0))
Get #fNum, , FileBuffer
Close fNum
'unload all pictureboxes\images
For i = 1 To aimg.Count - 1
Unload aimg(i)
Next i
'Gif Header
strGifHeader = Left$(FileBuffer, 6)
If strGifHeader = "GIF87a" Then
GifHeader = GIF87A
ElseIf strGifHeader = "GIF89a" Then
GifHeader = GIF89A
End If
'Test if the Gif is animated or not
FirstFrame = InStr(13, FileBuffer, Chr(33) & Chr(249))
'if the image isn't animated, then just draw it;)
If InStr(FirstFrame + 2, FileBuffer, Chr(33) & Chr(249)) = 0 Then
aimg(0).Picture = LoadPicture(strFileName)
Exit Sub
End If
'Logical Screen Description
strLogicalScreenDescription = Mid$(FileBuffer, 7, 7)
LSDLogicalScreenDescription.GifWidth = Asc(Left$(strLogicalScreenDescription, 2))
LSDLogicalScreenDescription.GifHeight = Asc(Mid$(strLogicalScreenDescription, 2, 2))
PackedField = Asc(Mid$(strLogicalScreenDescription, 5, 1))
PackedField = DecimalToBinary(PackedField)
LSDLogicalScreenDescription.GlobalColorFlag = Asc(BinaryToDecimal(Mid$(PackedField, 1, 1)))
LSDLogicalScreenDescription.ColorResolution = Asc(BinaryToDecimal(Mid$(PackedField, 2, 3)))
LSDLogicalScreenDescription.GlobalColorFlag = Asc(BinaryToDecimal(Mid$(PackedField, 5, 1)))
LSDLogicalScreenDescription.GlobalColorSize = Asc(BinaryToDecimal(Mid$(PackedField, 6, 3)))
LSDLogicalScreenDescription.Backcolor = Asc(Mid$(strLogicalScreenDescription, 6, 1))
LSDLogicalScreenDescription.PixelRadio = Asc(Mid$(strLogicalScreenDescription, 7, 1))
'image count
i = 0
Do
'get frame string
strFrame = Mid$(FileBuffer, FirstFrame, Len(FileBuffer) - FirstFrame)
'Get Grafic Control
PackedField = Asc(Mid$(strFrame, 4, 1))
PackedField = DecimalToBinary(PackedField)
GCGraficControl.Disposal = Asc(BinaryToDecimal(Mid$(PackedField, 4, 3)))
GCGraficControl.Delay = Asc(Mid$(strFrame, 5, 2))
GCGraficControl.TransparentColor = Asc(Mid$(strFrame, 7, 1))
'Get Image Description
IDImageDescription.FrameLeft = Asc(Mid$(strFrame, 10, 2))
IDImageDescription.FrameTop = Asc(Mid$(strFrame, 12, 2))
IDImageDescription.FrameWidth = Asc(Mid$(strFrame, 14, 2))
IDImageDescription.FrameHeight = Asc(Mid$(strFrame, 16, 2))
'If the image array don't exist then create\load it
If i > 0 Then
Load aimg(i)
End If
'create the image temp
fNum = FreeFile
Open "temp.gif" For Binary As fNum
Debug.Print Mid$(FileBuffer, FirstFrame, Len(FileBuffer) - strFrame - 1) ' error '13': type mismatch
If Mid$(FileBuffer, FirstFrame, Len(FileBuffer) - strFrame - 1) <> 0 Then
PictureBuffer = Mid$(FileBuffer, 1, FirstFrame - 1) & Mid$(strFrame, 0, Len(FileBuffer) - strFrame - 1) & Chr(59) '3B
Else
PictureBuffer = Mid$(FileBuffer, 1, FirstFrame - 1) & Mid$(strFrame, 0, Len(FileBuffer) - 1) & Chr(59) '3B
End If
Put #fNum, 1, PictureBuffer
Close fNum
'now load the image
aimg(i).Picture = LoadPicture("temp.gif")
'now we can delete the temp file
Kill "temp.gif"
'change the properties
aimg(i).Tag = GCGraficControl.Delay
'test if theres another image
If InStr(FirstFrame + 2, FileBuffer, Chr(33) & Chr(249)) = 0 Then
Exit Do
Else
FirstFrame = InStr(FirstFrame + 2, FileBuffer, Chr(33) & Chr(249))
End If
i = i + 1
Loop
Debug.Print i
End Sub
see on do...loop code. in last lines i'm trying put all data on string.
please tell me what isn't right
You need to look at what I put in RED and think about it.
The way you are doing this is much more complicated than it needs to be. Your code is way over complex and it is a very simple matter to extract out the frame data
Anything I post is an example only and is not intended to be the only solution, the total solution nor the final solution to your request nor do I claim that it is. If you find it useful then it is entirely up to you to make whatever changes necessary you feel are adequate for your purposes.
i'm having problems with these new forum skin
is more slow and give me some bugs
i resolve it:
Code:
Option Explicit
Private Enum GifType
GIF87A = 0
GIF89A = 1
End Enum
Private Type LogicalScreenDescriptor
GifWidth As Long
GifHeight As Long
GlobalColorSize As Long
SortFlag As Long
ColorResolution As Long
GlobalColorFlag As Long
Backcolor As Long
PixelRadio As Long
End Type
Private Type GraphicControl
Disposal As Long
Delay As Long
TransparentColor As Long
End Type
Private Type ImageDescription
FrameLeft As Long
FrameTop As Long
FrameWidth As Long
FrameHeight As Long
End Type
Public Sub LoadGifFile(strFileName As String, aimg As Variant)
Dim GifHeader As GifType
Dim strLogicalScreenDescription As String
Dim LSDLogicalScreenDescription As LogicalScreenDescriptor
Dim GCGraficControl As GraphicControl
Dim IDImageDescription As ImageDescription
Dim strGifHeader As String
Dim strFrame As String
Dim fNum As Integer
Dim FileBuffer As String
Dim PictureBuffer As String
Dim PackedField As String
Dim FirstFrame As Long
Dim FrameEnds As Long
Dim ActualFrame As Long
Dim i As Integer
'Test if the file exists
If Dir$(strFileName) = "" Or strFileName = "" Then
MsgBox "File " & strFileName & " not found", vbCritical
Exit Sub
End If
'Put all file info to a variable
fNum = FreeFile
Open strFileName For Binary Access Read As fNum
FileBuffer = String(LOF(fNum), Chr(0))
Get #fNum, , FileBuffer
Close fNum
'unload all pictureboxes\images
For i = 1 To aimg.Count - 1
Unload aimg(i)
Next i
'Gif Header
strGifHeader = Left$(FileBuffer, 6)
If strGifHeader = "GIF87a" Then
GifHeader = GIF87A
ElseIf strGifHeader = "GIF89a" Then
GifHeader = GIF89A
End If
'Test if the Gif is animated or not
FirstFrame = InStr(13, FileBuffer, Chr(33) & Chr(249))
ActualFrame = FirstFrame
'if the image isn't animated, then just draw it;)
If InStr(FirstFrame + 2, FileBuffer, Chr(33) & Chr(249)) = 0 Then
aimg(0).Picture = LoadPicture(strFileName)
aimg(0).Tag = 0
Exit Sub
End If
'Logical Screen Description
strLogicalScreenDescription = Mid$(FileBuffer, 7, 7)
LSDLogicalScreenDescription.GifWidth = Asc(Left$(strLogicalScreenDescription, 2))
LSDLogicalScreenDescription.GifHeight = Asc(Mid$(strLogicalScreenDescription, 2, 2))
PackedField = Asc(Mid$(strLogicalScreenDescription, 5, 1))
PackedField = DecimalToBinary(PackedField)
LSDLogicalScreenDescription.GlobalColorFlag = Asc(BinaryToDecimal(Mid$(PackedField, 1, 1)))
LSDLogicalScreenDescription.ColorResolution = Asc(BinaryToDecimal(Mid$(PackedField, 2, 3)))
LSDLogicalScreenDescription.GlobalColorFlag = Asc(BinaryToDecimal(Mid$(PackedField, 5, 1)))
LSDLogicalScreenDescription.GlobalColorSize = Asc(BinaryToDecimal(Mid$(PackedField, 6, 3)))
LSDLogicalScreenDescription.Backcolor = Asc(Mid$(strLogicalScreenDescription, 6, 1))
LSDLogicalScreenDescription.PixelRadio = Asc(Mid$(strLogicalScreenDescription, 7, 1))
'image count
i = 0
Do
'get frame string
If InStr(ActualFrame + 2, FileBuffer, Chr(33) & Chr(249)) <> 0 Then
FrameEnds = InStr(ActualFrame + 2, FileBuffer, Chr(33) & Chr(249)) - 2
Else
FrameEnds = InStr(ActualFrame + 2, FileBuffer, Chr(59)) - 1
End If
strFrame = Mid$(FileBuffer, ActualFrame, Len(FileBuffer) - FirstFrame)
'Get Grafic Control
PackedField = Asc(Mid$(strFrame, 4, 1))
PackedField = DecimalToBinary(PackedField)
GCGraficControl.Disposal = Asc(BinaryToDecimal(Mid$(PackedField, 4, 3)))
GCGraficControl.Delay = Asc(Mid$(strFrame, 5, 2)) * 10
Debug.Print GCGraficControl.Delay
GCGraficControl.TransparentColor = Asc(Mid$(strFrame, 7, 1))
'Get Image Description
IDImageDescription.FrameLeft = Asc(Mid$(strFrame, 10, 2))
IDImageDescription.FrameTop = Asc(Mid$(strFrame, 12, 2))
IDImageDescription.FrameWidth = Asc(Mid$(strFrame, 14, 2))
IDImageDescription.FrameHeight = Asc(Mid$(strFrame, 16, 2))
'If the image array don't exist then create\load it
If i > 0 Then
Load aimg(i)
End If
'create the image temp
fNum = FreeFile
Open "temp.gif" For Binary As fNum
'Debug.Print Mid$(FileBuffer, FirstFrame, Len(FileBuffer) - strFrame - 1) ' error '13': type mismatch
PictureBuffer = Mid$(FileBuffer, 1, FirstFrame - 1) & Mid$(FileBuffer, ActualFrame, FrameEnds) & Chr(59) '3B
Put #fNum, 1, PictureBuffer
Close fNum
'now load the image
aimg(i).Picture = LoadPicture("temp.gif")
'change the properties
aimg(i).Tag = GCGraficControl.Delay
'test if theres another image
If InStr(ActualFrame + 2, FileBuffer, Chr(33) & Chr(249)) = 0 Then
Exit Do
Else
ActualFrame = InStr(ActualFrame + 2, FileBuffer, Chr(33) & Chr(249))
End If
i = i + 1
DoEvents
'now we can delete the temp file
Kill "temp.gif"
Loop
End Sub
do me a favor and see how i catch the delay value. because i, with these sample, i get 12. but i belive that is 120... i don't know why i did '*10'
Asc(Mid$(strFrame, 5, 2)) * 10
Anything I post is an example only and is not intended to be the only solution, the total solution nor the final solution to your request nor do I claim that it is. If you find it useful then it is entirely up to you to make whatever changes necessary you feel are adequate for your purposes.
why the Delay isn't so easy to catch like image size?
(anotherthing: if i put the "kill "filename"" in loop, don't works, but outside of loop works... only i for catch some interesting errors lol)
why the Delay isn't so easy to catch like image size?
(anotherthing: if i put the "kill "filename"" in loop, don't works, but outside of loop works... only i for catch some interesting errors lol)
It's the same for any field the is 2 or more bytes like the below
The above should be done the same as for Delay. I told you that you cannot convert 2-bytes to ascii and each one of the above are 2 bytes or more. The only reason you have gotton the correct results, if you have, is that you have been lucky but they are not correct,
I don't know how BinaryToDecimal works so I cannot comment on it as to whether it's correct or not.
Also, you are passing a 3-byte field and as I have told you several times they are not bytes; they are bits.
Global Color Table Size ----------------------+
Sort Flag --------------------------------+ |
Color Resolution ---------------------+ | |
Global Color Table Flag ----------+ | | |
| | | |
| | | |
7 6 5 4 3 2 1 0
+-+-----+-+-----+
| | | | |
+-+-----+-+-----+
Last edited by jmsrickland; Aug 22nd, 2012 at 12:32 PM.
Anything I post is an example only and is not intended to be the only solution, the total solution nor the final solution to your request nor do I claim that it is. If you find it useful then it is entirely up to you to make whatever changes necessary you feel are adequate for your purposes.
why the Delay isn't so easy to catch like image size?
(anotherthing: if i put the "kill "filename"" in loop, don't works, but outside of loop works... only i for catch some interesting errors lol)
Open "temp.gif" For Binary As fNum
Kill "temp.gif"
The above two should be
Open App.Path & "\temp.gif" For Binary As fNum
Kill App.Path & "\temp.gif"
Anything I post is an example only and is not intended to be the only solution, the total solution nor the final solution to your request nor do I claim that it is. If you find it useful then it is entirely up to you to make whatever changes necessary you feel are adequate for your purposes.
The above should be done the same as for Delay. I told you that you cannot convert 2-bytes to ascii and each one of the above are 2 bytes or more. The only reason you have gotton the correct results, if you have, is that you have been lucky but they are not correct,
I don't know how BinaryToDecimal works so I cannot comment on it as to whether it's correct or not.
like these:
IDImageDescription.FrameLeft = Asc(Mid$(strFrame, 10, 1)) + Asc(Mid$(strFrame, 11, 1))
???
anotherthing: on delay you did '*100', but isn't correct... why!?! because the animation is very slow. but when i do '*10' it's the normal animation
Last edited by joaquim; Aug 22nd, 2012 at 12:27 PM.
like these:
IDImageDescription.FrameLeft = Asc(Mid$(strFrame, 10, 1)) + Asc(Mid$(strFrame, 11, 1))
???
anotherthing: on delay you did '*100', but isn't correct... why!?! because the animation is very slow. but when i do '*10' it's the normal animation
I did * 100 because the value of the gif delay in the file is 1/100 of a second. That doesn't mean that timing is correct for any given method you decide to use to control the timing. * 10 works for you because of the method you are using but in some other case * 10 may not be correct. If * 10 works for you then use * 10
Go back and look at post 110. You are not doing the GlobalColorFlag, ColorResolution, GlobalColorFlag, and GlobalColorSize correctly.
Anything I post is an example only and is not intended to be the only solution, the total solution nor the final solution to your request nor do I claim that it is. If you find it useful then it is entirely up to you to make whatever changes necessary you feel are adequate for your purposes.
I did * 100 because the value of the gif delay in the file is 1/100 of a second. That doesn't mean that timing is correct for any given method you decide to use to control the timing. * 10 works for you because of the method you are using but in some other case * 10 may not be correct. If * 10 works for you then use * 10
Go back and look at post 110. You are not doing the GlobalColorFlag, ColorResolution, GlobalColorFlag, and GlobalColorSize correctly.
thanks, but tell me if i'm correct with these line:
The + is correct because you are adding two ascii values. The statement needs the * 256 to shift the LSD/MSD around to MSD/LSD order. So, you need this:
The & is used to concatenate two or more string together, like this:
strOne & strTwo & strThree
However, VB will allow you to use the + sign but it is not considered good VB programming practice
Below is allowed but you should avoid the + sign for strings and use the &
strOne + strTwo + strThree
Anything I post is an example only and is not intended to be the only solution, the total solution nor the final solution to your request nor do I claim that it is. If you find it useful then it is entirely up to you to make whatever changes necessary you feel are adequate for your purposes.
Option Explicit
Public Function DecimalToBinary(ByVal num As String) As String
Dim number As String
Dim step As Long
Dim bstr As String
Dim neg As Boolean
step = 1
bstr = ""
If Left(num, 1) = "-" Then
neg = True
number = Right(num, Len(num) - 1)
Else
neg = False
number = num
End If
While Left(number, 1) = "0"
number = Right(number, Len(number) - 1)
Wend
If Len(number) = 0 Then
DecimalToBinary = 0
Exit Function
End If
While step * 2 <= number
step = step * 2
Wend
While step >= 1
If number >= step Then
number = number - step
bstr = bstr & "1"
Else
bstr = bstr & "0"
End If
step = step / 2
Wend
If neg = True Then
bstr = "-" & bstr
End If
DecimalToBinary = bstr
End Function
Public Function BinaryToDecimal(ByVal bin As String) As String
Dim cont As Long
Dim bstr As String
Dim step As Long
Dim neg As Boolean
step = 1
cont = 0
If Left(bin, 1) = "-" Then
neg = True
bstr = Right(bin, Len(bin) - 1)
Else
neg = False
bstr = bin
End If
While Left(bstr, 1) = "0"
bstr = Right(bstr, Len(bstr) - 1)
Wend
If Len(bstr) = 0 Then
BinaryToDecimal = 0
Exit Function
End If
While Len(bstr) > 0
If Right(bstr, 1) = "1" Then
cont = cont + step
End If
bstr = Left(bstr, Len(bstr) - 1)
step = step * 2
Wend
If neg = True Then
cont = "-" & cont
End If
BinaryToDecimal = cont
End Function
i have 1 question: if we use '*256' for with 2 bytes, we must use for 1 byte too?
is:
GCGraficControl.TransparentColor = Asc(Mid$(strFrame, 7, 1))
or
GCGraficControl.TransparentColor = Asc(Mid$(strFrame, 7, 1))*256
??
thanks
i have 1 question: if we use '*256' for with 2 bytes, we must use for 1 byte too?
is:
GCGraficControl.TransparentColor = Asc(Mid$(strFrame, 7, 1))
or
GCGraficControl.TransparentColor = Asc(Mid$(strFrame, 7, 1))*256
??
thanks
The * 256 is only for 2-byte values. That's how you get the MSD/LSD order which is what we need for normal math. The values in the file are in LSD/MSD order.
Forget about your BinaryToDecimal and DecimalToBinary functions- they are not needed and they are just over-kills; it isn't that complicated to get the correct results.
LSDLogicalScreenDescription.GlobalColorFlag = (PackedField And 128) / 2 ^ 7
LSDLogicalScreenDescription.ColorResolution = (PackedField And 112) / 2 ^ 4
LSDLogicalScreenDescription.SortFlag = (PackedField And 8) / 2 ^ 3
' NOTE - This value is meanless if GlobalColorFlag is 0
LSDLogicalScreenDescription.GlobalColorSize = PackedField And 7
LSDLogicalScreenDescription.GlobalColorSize = 3 * (2 ^ (LSDLogicalScreenDescription.GlobalColorSize + 1))
'
' Get Grafic Control
'
PackedField = Asc(Mid$(strFrame, 4, 1))
GCGraficControl.Disposal = (PackedField And 12) / 2 ^ 2
' ADDED BY JMS
GCGraficControl.UserInput = (PackedField And 2) / 2 ^ 1
' ADDED BY JMS
GCGraficControl.TransparentFlag = (PackedField And 1)
'
' Changed to * 10 from * 100 because you say it's more normal
'
GCGraficControl.Delay = (Asc(Mid(strFrame, 5, 1)) + Asc(Mid(strFrame, 6, 1)) * 256) * 10
' NOTE This value is meaningless if TransparentFlag is 0
GCGraficControl.TransparentColor = Asc(Mid$(strFrame, 7, 1))
Anything I post is an example only and is not intended to be the only solution, the total solution nor the final solution to your request nor do I claim that it is. If you find it useful then it is entirely up to you to make whatever changes necessary you feel are adequate for your purposes.
The * 256 is only for 2-byte values. That's how you get the MSD/LSD order which is what we need for normal math. The values in the file are in LSD/MSD order.
Forget about your BinaryToDecimal and DecimalToBinary functions- they are not needed and they are just over-kills; it isn't that complicated to get the correct results.
LSDLogicalScreenDescription.GlobalColorFlag = (PackedField And 128) / 2 ^ 7
LSDLogicalScreenDescription.ColorResolution = (PackedField And 112) / 2 ^ 4
LSDLogicalScreenDescription.SortFlag = (PackedField And 8) / 2 ^ 3
' NOTE - This value is meanless if GlobalColorFlag is 0
LSDLogicalScreenDescription.GlobalColorSize = PackedField And 7
LSDLogicalScreenDescription.GlobalColorSize = 3 * (2 ^ (LSDLogicalScreenDescription.GlobalColorSize + 1))
'
' Get Grafic Control
'
PackedField = Asc(Mid$(strFrame, 4, 1))
GCGraficControl.Disposal = (PackedField And 12) / 2 ^ 2
' ADDED BY JMS
GCGraficControl.UserInput = (PackedField And 2) / 2 ^ 1
' ADDED BY JMS
GCGraficControl.TransparentFlag = (PackedField And 1)
'
' Changed to * 10 from * 100 because you say it's more normal
'
GCGraficControl.Delay = (Asc(Mid(strFrame, 5, 1)) + Asc(Mid(strFrame, 6, 1)) * 256) * 10
' NOTE This value is meaningless if TransparentFlag is 0
GCGraficControl.TransparentColor = Asc(Mid$(strFrame, 7, 1))
Option Explicit
Option Base 0
Private Declare Function TransparentBlt Lib "msimg32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal crTransparent As Long) As Boolean
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Enum GifType
GIF87A = 0
GIF89A = 1
End Enum
Private Type LogicalScreenDescriptor
GifWidth As Long
GifHeight As Long
GlobalColorSize As Long
SortFlag As Long
ColorResolution As Long
GlobalColorFlag As Long
Backcolor As Long
PixelRadio As Long
End Type
Private Type GraphicControl
Disposal As Long
Delay As Long
TransparentColor As Long
UserInput As Long
TransparentFlag As Long
End Type
Private Type ImageDescription
FrameLeft As Long
FrameTop As Long
FrameWidth As Long
FrameHeight As Long
End Type
Private Type Frame
GCGraphicControl As GraphicControl
IDImageDescription As ImageDescription
End Type
Dim fraFrame() As Frame
Public Sub LoadGifFile(strFileName As String, aimg As Variant)
Dim GifHeader As GifType
Dim strLogicalScreenDescription As String
Dim LSDLogicalScreenDescription As LogicalScreenDescriptor
'Dim GCGraficControl As GraphicControl
'Dim IDImageDescription As ImageDescription
Dim strGifHeader As String
Dim strFrame As String
Dim fNum As Integer
Dim FileBuffer As String
Dim PictureBuffer As String
Dim PackedField As String
Dim FirstFrame As Long
Dim FrameEnds As Long
Dim ActualFrame As Long
Dim i As Integer
'Test if the file exists
If Dir$(strFileName) = "" Or strFileName = "" Then
MsgBox "File " & strFileName & " not found", vbCritical
Exit Sub
End If
'Put all file info to a variable
fNum = FreeFile
Open strFileName For Binary Access Read As fNum
FileBuffer = String(LOF(fNum), Chr(0))
Get #fNum, , FileBuffer
Close fNum
'unload all pictureboxes\images
For i = 1 To aimg.Count - 1
Unload aimg(i)
Next i
'Gif Header
strGifHeader = Left$(FileBuffer, 6)
If strGifHeader = "GIF87a" Then
GifHeader = GIF87A
ElseIf strGifHeader = "GIF89a" Then
GifHeader = GIF89A
End If
'Test if the Gif is animated or not
FirstFrame = InStr(13, FileBuffer, Chr(33) & Chr(249))
ActualFrame = FirstFrame
'if the image isn't animated, then just draw it;)
If InStr(FirstFrame + 2, FileBuffer, Chr(33) & Chr(249)) = 0 Then
aimg(0).Picture = LoadPicture(strFileName)
aimg(0).Tag = 0
Exit Sub
End If
'Logical Screen Description
strLogicalScreenDescription = Mid$(FileBuffer, 7, 7)
LSDLogicalScreenDescription.GifWidth = Asc(Mid(strLogicalScreenDescription, 1, 1)) + Asc(Mid(strLogicalScreenDescription, 2, 1)) * 256
LSDLogicalScreenDescription.GifHeight = Asc(Mid(strLogicalScreenDescription, 3, 1)) + Asc(Mid(strLogicalScreenDescription, 4, 1)) * 256
PackedField = Asc(Mid$(strLogicalScreenDescription, 5, 1))
LSDLogicalScreenDescription.GlobalColorFlag = (PackedField And 128) / 2 ^ 7
LSDLogicalScreenDescription.ColorResolution = (PackedField And 112) / 2 ^ 4
LSDLogicalScreenDescription.SortFlag = (PackedField And 8) / 2 ^ 3
' NOTE - This value is meanless if GlobalColorFlag is 0
LSDLogicalScreenDescription.GlobalColorSize = PackedField And 7
LSDLogicalScreenDescription.GlobalColorSize = 3 * (2 ^ (LSDLogicalScreenDescription.GlobalColorSize + 1))
LSDLogicalScreenDescription.Backcolor = Asc(Mid$(strLogicalScreenDescription, 6, 1))
LSDLogicalScreenDescription.PixelRadio = Asc(Mid$(strLogicalScreenDescription, 7, 1))
'image count
i = 0
ReDim Preserve fraFrame(i)
Do
'get frame string
If InStr(ActualFrame + 2, FileBuffer, Chr(33) & Chr(249)) <> 0 Then
FrameEnds = InStr(ActualFrame + 2, FileBuffer, Chr(33) & Chr(249)) - 2
Else
FrameEnds = InStr(ActualFrame + 2, FileBuffer, Chr(59)) - 1
End If
strFrame = Mid$(FileBuffer, ActualFrame, Len(FileBuffer) - FirstFrame)
'Get Grafic Control
PackedField = Asc(Mid$(strFrame, 4, 1))
fraFrame(i).GCGraphicControl.Disposal = (PackedField And 12) / 2 ^ 2
' ADDED BY JMS
fraFrame(i).GCGraphicControl.UserInput = (PackedField And 2) / 2 ^ 1
' ADDED BY JMS
fraFrame(i).GCGraphicControl.TransparentFlag = (PackedField And 1)
fraFrame(i).GCGraphicControl.Delay = (Asc(Mid(strFrame, 5, 1)) + Asc(Mid(strFrame, 6, 1)) * 256) * 10
' NOTE This value is meaningless if TransparentFlag is 0
fraFrame(i).GCGraphicControl.TransparentColor = Asc(Mid$(strFrame, 7, 1))
'Get Image Description
fraFrame(i).IDImageDescription.FrameLeft = Asc(Mid(strFrame, 10, 1)) + Asc(Mid(strFrame, 11, 1)) * 256
fraFrame(i).IDImageDescription.FrameTop = Asc(Mid(strFrame, 12, 1)) + Asc(Mid(strFrame, 13, 1)) * 256
fraFrame(i).IDImageDescription.FrameWidth = Asc(Mid(strFrame, 14, 1)) + Asc(Mid(strFrame, 15, 1)) * 256
fraFrame(i).IDImageDescription.FrameHeight = Asc(Mid(strFrame, 16, 1)) + Asc(Mid(strFrame, 17, 1)) * 256
'If the image array don't exist then create\load it
If i > 0 Then
Load aimg(i)
End If
'create the image temp
fNum = FreeFile
Open "temp.gif" For Binary As fNum
'Debug.Print Mid$(FileBuffer, FirstFrame, Len(FileBuffer) - strFrame - 1) ' error '13': type mismatch
PictureBuffer = Mid$(FileBuffer, 1, FirstFrame - 1) & Mid$(FileBuffer, ActualFrame, FrameEnds) & Chr(59) '3B
Put #fNum, 1, PictureBuffer
Close fNum
'now load the image
aimg(i).Picture = LoadPicture("temp.gif")
'change the properties
aimg(i).Tag = fraFrame(i).GCGraphicControl.Delay
'test if theres another image
If InStr(ActualFrame + 2, FileBuffer, Chr(33) & Chr(249)) = 0 Then
Exit Do
Else
ActualFrame = InStr(ActualFrame + 2, FileBuffer, Chr(33) & Chr(249))
i = i + 1
If i > 0 Then ReDim Preserve fraFrame(i)
End If
Loop
'now we can delete the temp file
Kill "temp.gif"
'Control the Disposal codes
If aimg.Count > 1 Then
Load aimg(aimg.Count)
For i = 1 To aimg.Count - 2
If fraFrame(i).GCGraphicControl.Disposal = 0 Then
'ignore it
ElseIf fraFrame(i).GCGraphicControl.Disposal = 1 Then
'ActualFrame = PreviousFrame + TransparentActualFrame
If fraFrame(i).GCGraphicControl.TransparentFlag <> 0 Then
BitBlt aimg(aimg.Count - 1).hdc, 0, 0, aimg(i - 1).ScaleWidth, aimg(i - 1).ScaleHeight, aimg(i - 1).hdc, 0, 0, vbSrcCopy
TransparentBlt aimg(aimg.Count - 1).hdc, fraFrame(i).IDImageDescription.FrameLeft, fraFrame(i).IDImageDescription.FrameTop, aimg(i).ScaleWidth, aimg(i).ScaleHeight, aimg(i).hdc, 0, 0, aimg(i).ScaleWidth, aimg(i).ScaleHeight, GetPixel(aimg(i).hdc, 0, 0)
aimg(i).Picture = aimg(aimg.Count - 1).Image
aimg(aimg.Count - 1).Cls
End If
End If
Next i
Unload aimg(aimg.Count - 1)
End If
End Sub
my problem, now, is with:
Code:
If fraFrame(i).GCGraphicControl.TransparentFlag <> 0 Then
because seems not working correctly
because if the backcolor is transparent the disposed is used, else not.... can you correct me that 'if'?
(thanks to these new sub i have the right frame positions)
thanks
Originally Posted by jmsrickland
)
Reply With Quote
