Printable View
:(Quote:
Originally Posted by jmsrickland
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
Bytes X2 and X3 are the delay speed of the imageQuote:
Originally Posted by joaquim
See post #80
thanks for all my friendQuote:
Originally Posted by jmsrickland
in time i will read images by pixels;)
with a long array i can create images and use the standard API GUI functions;)
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.aspQuote:
Originally Posted by jmsrickland
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:(
Quote:
Originally Posted by joaquim
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.
Go to this link and read about how it works
http://www.google.com/webhp?source=s...iw=963&bih=634
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
i don't know why a can't see the text, only selected lolQuote:
Originally Posted by jmsrickland
what means: "leave it up to the Browser/Viewer"?
is for i ignore the method?
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.
- i don't know why i can't see the text on that link that you give me... only when i use the mouse for select the text, i can see it lol http://www.mistycreek.com/corel_addo...sal_method.htm ;Quote:
Originally Posted by jmsrickland
- on method explication table... what means: "leave it up to the Browser/Viewer"?
is for i ignore the method?
finally i found the text that i was loking for: http://cs.nyu.edu/courses/fall10/V22...imatedGifs.pdf
thanks
It's the same thing as I stated for Method 0 in my post #90Quote:
Originally Posted by joaquim
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.
i don't have sure, but help me on these... what they put on picbuf variable?Code: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'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:Quote:
Originally Posted by joaquim
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.Code:'
'
InputBuffer = String(LOF(#fNum), 0)
'
'
Now you just Get the data into that buffer
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:'
Get #fNum ,1, 1, InputBuffer
'
In the code snippet you posted the lineCode:'
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
'
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.
for be more easy can i use the normal gif format(thinking in frame that i use)?Quote:
Originally Posted by jmsrickland
(see the 1st image(gif file format): http://www.matthewflickinger.com/lab..._and_bytes.asp
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:Quote:
Originally Posted by jmsrickland
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?
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;)Quote:
Originally Posted by jmsrickland
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 never use these functionCode:instr(13,fileHeader,"21")
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;)Quote:
Originally Posted by jmsrickland
thanksCode: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
see my entire code(my own code):
tomorrow i will finish;)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
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
thanks
by some reason i get an error when i try put the data on variable for create the file:(
see on do...loop code. in last lines i'm trying put all data on string.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
please tell me what isn't right:(
You need to look at what I put in RED and think about it.Quote:
Originally Posted by joaquim
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
i'm having problems with these new forum skin:(
is more slow and give me some bugs:(
i resolve it:
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':(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
Asc(Mid$(strFrame, 5, 2)) * 10
GCGraficControl.Delay = Asc(Mid$(strFrame, 5, 2)) * 10
That is not correct. You can not convert 2 bytes to an ascii value; only one byte can be converted to ascii.
Note that the delay value is 2 bytes and it is in Little Endian order which means the LSD is in the first byte and the MSD is in the 2nd byte.
For example - assume Mid$(strFrame, 5, 2) has the following values:
You need to convert each byte to ascii and then switch the two byes around so that you wind up with MSD LSD order instead of LSD MSD order.Code:Byte Byte
5 6
LSD MSD
+----+----+
| 04 | 01 |
+----+----+
So, 0401 should be switched around to 0104. Below is what you need to get the true value:
GCGraficControl.Delay = Asc(Mid(strFrame, 5, 1)) + Asc(Mid(strFrame, 6, 1)) * 256
Also, the value is in 1/100th not 1/10th
GCGraficControl.Delay = GCGraficControl.Delay * 100
To do this in one statement you do the following:
GCGraficControl.Delay = (Asc(Mid(strFrame, 5, 1)) + Asc(Mid(strFrame, 6, 1)) * 256) * 100
why the Delay isn't so easy to catch like image size?Quote:
Originally Posted by jmsrickland
(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 belowQuote:
Originally Posted by joaquim
LSDLogicalScreenDescription.GifWidth = Asc(Left$(strLogicalScreenDescription, 2))
LSDLogicalScreenDescription.GifHeight = Asc(Mid$(strLogicalScreenDescription, 2, 2))
LSDLogicalScreenDescription.ColorResolution = Asc(BinaryToDecimal(Mid$(PackedField, 2, 3)))
LSDLogicalScreenDescription.GlobalColorSize = Asc(BinaryToDecimal(Mid$(PackedField, 6, 3)))
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))
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.
LSDLogicalScreenDescription.ColorResolution = Asc(BinaryToDecimal(Mid$(PackedField, 2, 3)))
LSDLogicalScreenDescription.GlobalColorSize = Asc(BinaryToDecimal(Mid$(PackedField, 6, 3)))
This is what the Packed Field looks like:
Code:Global Color Table Size ----------------------+
Sort Flag --------------------------------+ |
Color Resolution ---------------------+ | |
Global Color Table Flag ----------+ | | |
| | | |
| | | |
7 6 5 4 3 2 1 0
+-+-----+-+-----+
| | | | |
+-+-----+-+-----+
Open "temp.gif" For Binary As fNumQuote:
Originally Posted by joaquim
Kill "temp.gif"
The above two should be
Open App.Path & "\temp.gif" For Binary As fNum
Kill App.Path & "\temp.gif"
like these:Quote:
Originally Posted by jmsrickland
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 * 10Quote:
Originally Posted by joaquim
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:Quote:
Originally Posted by jmsrickland
maybe instead '+', i must use '&'... but it's correct?Code:IDImageDescription.FrameLeft = Asc(Mid$(strFrame, 10, 1)) + Asc(Mid$(strFrame, 11, 1))
IDImageDescription.FrameLeft = Asc(Mid$(strFrame, 10, 1)) + Asc(Mid$(strFrame, 11, 1))
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:
IDImageDescription.FrameLeft = Asc(Mid$(strFrame, 10, 1)) + Asc(Mid$(strFrame, 11, 1)) * 256
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
i have 1 question: if we use '*256' for with 2 bytes, we must use for 1 byte too?Code: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
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.Quote:
Originally Posted by joaquim
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.
'
' 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))
'
' 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))
'
' Get Image Description
'
IDImageDescription.FrameLeft = Asc(Mid(strFrame, 10, 1)) + Asc(Mid(strFrame, 11, 1)) * 256
IDImageDescription.FrameTop = Asc(Mid(strFrame, 12, 1)) + Asc(Mid(strFrame, 13, 1)) * 256
IDImageDescription.FrameWidth = Asc(Mid(strFrame, 14, 1)) + Asc(Mid(strFrame, 15, 1)) * 256
IDImageDescription.FrameHeight = Asc(Mid(strFrame, 16, 1)) + Asc(Mid(strFrame, 17, 1)) * 256
thanks for all my friendQuote:
Originally Posted by jmsrickland
i have nice results;)
my problem, now, is with:Code: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
because seems not working correctly:(Code:If fraFrame(i).GCGraphicControl.TransparentFlag <> 0 Then
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
i must admit:
I'M A MACHINE lol
now the code works 100% for the '1' disposal;)Code:'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 '
BitBlt aimg(aimg.Count - 1).hdc, 0, 0, aimg(i - 1).ScaleWidth, aimg(i - 1).ScaleHeight, aimg(i - 1).hdc, 0, 0, vbSrcCopy
If fraFrame(i).GCGraphicControl.BackColor <> LSDLogicalScreenDescription.BackColor Then
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)
Else
BitBlt aimg(aimg.Count - 1).hdc, fraFrame(i).IDImageDescription.FrameLeft, fraFrame(i).IDImageDescription.FrameTop, aimg(i).ScaleWidth, aimg(i).ScaleHeight, aimg(i).hdc, 0, 0, vbSrcCopy
End If
aimg(i).Picture = aimg(aimg.Count - 1).Image
aimg(aimg.Count - 1).Cls
End If
Debug.Print fraFrame(i).GCGraphicControl.Disposal
Next i
Unload aimg(aimg.Count - 1)
End If
tomorrow i will do it for the others;)
stay well and thanks