Printable View
i know my friend. my objective is combine the frames(for show the corrected frame).Quote:
Originally Posted by jmsrickland
but my big objective is use these code for update my sprite control. i'm update it for read more gif files, and make the graphics effects more faster(i'm building the Graphic class too hehehe
can you just advice on transparentblt() api function?
i know that works fine, but the positions aren't correct:(
I don't know which project you are working on so send me the project that you are currently working on with the TransparentBlt problem and only the gif file you are trying to position. I see what I can do.
heres the code updated:
the frame 0 position isn't correct. how can i get it?Code:'Method 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.
Option Explicit
Private Type DisposedValues
Disposed As Integer
FrameXPos As Long
FrameYPos As Long
End Type
Public Enum GifType
GIF87A = 0
GIF89A = 1
End Enum
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 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 Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
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 TotalFrames As Long
Public GifTypeFile As GifType
Public Dispose() As DisposedValues
Public Function LoadGif(sFile As String, aImg As Variant) As Boolean
If Dir$(sFile) = "" Or sFile = "" Then
MsgBox "File " & sFile & " not found", vbCritical
Exit Function
End If
If Mid$(UCase(sFile), Len(sFile) - 2, 3) <> "GIF" Then Exit Function
'On Error GoTo ErrHandler
'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&, FrameX&, FrameY&, TimeWait&
Dim GifEnd As String
Dim intDisposed() As Integer
Dim intHeight As Integer
Dim intWidth As Integer
GifEnd = Chr(0) & Chr(33) & Chr(249) '<---only for animated GIF's
'unload all pictureboxes\images
For i = 1 To aImg.Count - 1
Unload aImg(i)
Next i
'Get GIF File into buffer
fNum = FreeFile
Open sFile For Binary Access Read As fNum
buf = String(LOF(fNum), Chr(0))
Get #fNum, , buf
Close fNum
i = 1
imgCount = 0
j = InStr(1, buf, GifEnd) + 1 '<--- j = 1 or 0 if not a animated gif ---- j > 1 if it is an animated gif
'if the Gif isn't animated
'then just show the image
If j < 2 Then
aImg(0).Picture = LoadPicture(sFile)
TotalFrames = aImg.Count - 1
aImg(0).Tag = 0
LoadGif = True
Exit Function
End If
fileHeader = Left(buf, j)
'if the file is gif structure
If Left$(fileHeader, 1) <> "G" Then
MsgBox "This file is not a *.gif file", vbCritical
Exit Function
End If
LoadGif = True
'Get gif type
'intWidth = Asc(Mid$(fileHeader, 7, 4))
'intHeight = Asc(Mid$(fileHeader, 9, 4))
'BackColor = Asc(Mid$(fileHeader, 11, 1))
'Gif Type
If Left$(fileHeader, 6) = "GIF89a" Then
GifTypeFile = GIF89A
Else
GifTypeFile = GIF87A
End If
i = j + 2
'how many times the animation is repeated
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 "temp.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
'frame delay time
TimeWait = ((Asc(Mid(imgHeader, 4, 1))) + (Asc(Mid(imgHeader, 5, 1)) * 256&)) * 10&
If imgCount > 1 Then
'Get frame position
FrameX = Asc(Mid(imgHeader, 9, 1)) + (Asc(Mid(imgHeader, 10, 1)) * 256&)
FrameY = Asc(Mid(imgHeader, 11, 1)) + (Asc(Mid(imgHeader, 12, 1)) * 256&)
'load control for show the image
Load aImg(imgCount - 1)
'change the control position
'for show the image in right position
aImg(imgCount - 1).Left = FrameX * Screen.TwipsPerPixelX
aImg(imgCount - 1).Top = FrameY * Screen.TwipsPerPixelY
End If
' Use .Tag Property to save TimeWait interval for separate Image
aImg(imgCount - 1).Tag = TimeWait
aImg(imgCount - 1).Picture = LoadPicture("temp.gif")
'Get the disposal values and positions from frames
ReDim Preserve Dispose(aImg.Count - 1)
Dispose(aImg.Count - 1).Disposed = Asc(Mid(imgHeader, 3, 1)) / 4 And 3
Dispose(aImg.Count - 1).FrameXPos = FrameX
Dispose(aImg.Count - 1).FrameYPos = FrameY
'kill temp file
Kill ("temp.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 "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
TimeWait = ((Asc(Mid(imgHeader, 4, 1))) + (Asc(Mid(imgHeader, 5, 1)) * 256)) * 10
If imgCount > 1 Then
FrameX = Asc(Mid(imgHeader, 9, 1)) + (Asc(Mid(imgHeader, 10, 1)) * 256)
FrameY = Asc(Mid(imgHeader, 11, 1)) + (Asc(Mid(imgHeader, 12, 1)) * 256)
Load aImg(imgCount - 1)
aImg(imgCount - 1).Left = FrameX * Screen.TwipsPerPixelX
aImg(imgCount - 1).Top = FrameY * Screen.TwipsPerPixelY
End If
aImg(imgCount - 1).Tag = TimeWait
aImg(imgCount - 1).Picture = LoadPicture("temp.gif")
ReDim Preserve Dispose(aImg.Count - 1)
Dispose(aImg.Count - 1).Disposed = Asc(Mid(imgHeader, 3, 1)) / 4 And 3
Dispose(aImg.Count - 1).FrameXPos = FrameX
Dispose(aImg.Count - 1).FrameYPos = FrameY
Kill ("temp.gif")
End If
TotalFrames = aImg.Count - 1
LoadGif = True
If aImg.Count >= 2 Then
Load aImg(aImg.Count)
aImg(aImg.Count - 1).Width = aImg(0).Width
aImg(aImg.Count - 1).Height = aImg(0).Height
For i = 1 To aImg.Count - 2
If Dispose(i).Disposed = 0 Then
'nothing
ElseIf Dispose(i).Disposed = 1 Then
'previous frame + actual frame(transparent) = result frame
aImg(aImg.Count - 1).Picture = aImg(i - 1).Image
Debug.Print TransparentBlt(aImg(aImg.Count - 1).hdc, Dispose(i).FrameXPos, Dispose(i).FrameYPos, 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(i).Left = FrameX * Screen.TwipsPerPixelX
aImg(i).Top = FrameY * Screen.TwipsPerPixelY
aImg(aImg.Count - 1).Cls
End If
Next i
Unload aImg(aImg.Count - 1)
End If
LoadGif = True
Exit Function
ErrHandler:
MsgBox "Error No. " & Err.Number & " when reading file", vbCritical
LoadGif = False
On Error GoTo 0
End Function
Here's what you doQuote:
Originally Posted by joaquim
1) Set Form ScaleMode = vbPixels
2) Change Image1(0) to appearance flat and BorderStyle none
3) Add another Picture box control (Picture2)
4) Set it's ScaleMode to vbPixels
5) Cut and Paste Image1(0) inside of Picture2
6) Change code as below
In the .BAS module change codeCode:
Private Sub Command1_Click()
Timer1.Enabled = False
CommonDialog1.ShowOpen
If LoadGif(CommonDialog1.FileName, image1) = False Then Exit Sub
Picture2.Width = image1(0).Width + 4
Picture2.Height = image1(0).Height + 4
FrameCount = 0
Timer1.Interval = image1(0).Tag
Timer1.Enabled = True
image1(0).Visible = True
End Sub
Code:'Method 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.
Option Explicit
Private Type DisposedValues
Disposed As Integer
FrameXPos As Long
FrameYPos As Long
End Type
Public Enum GifType
GIF87A = 0
GIF89A = 1
End Enum
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 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 Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
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 TotalFrames As Long
Public GifTypeFile As GifType
Public Dispose() As DisposedValues
Public Function LoadGif(sFile As String, aImg As Variant) As Boolean
If Dir$(sFile) = "" Or sFile = "" Then
MsgBox "File " & sFile & " not found", vbCritical
Exit Function
End If
If Mid$(UCase(sFile), Len(sFile) - 2, 3) <> "GIF" Then Exit Function
'On Error GoTo ErrHandler
'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&, FrameX&, FrameY&, TimeWait&
Dim GifEnd As String
Dim intDisposed() As Integer
Dim intHeight As Integer
Dim intWidth As Integer
GifEnd = Chr(0) & Chr(33) & Chr(249) '<---only for animated GIF's
'unload all pictureboxes\images
For i = 1 To aImg.Count - 1
Unload aImg(i)
Next i
'Get GIF File into buffer
fNum = FreeFile
Open sFile For Binary Access Read As fNum
buf = String(LOF(fNum), Chr(0))
Get #fNum, , buf
Close fNum
i = 1
imgCount = 0
j = InStr(1, buf, GifEnd) + 1 '<--- j = 1 or 0 if not a animated gif ---- j > 1 if it is an animated gif
'if the Gif isn't animated
'then just show the image
If j < 2 Then
aImg(0).Picture = LoadPicture(sFile)
TotalFrames = aImg.Count - 1
aImg(0).Tag = 0
LoadGif = True
Exit Function
End If
fileHeader = Left(buf, j)
'if the file is gif structure
If Left$(fileHeader, 1) <> "G" Then
MsgBox "This file is not a *.gif file", vbCritical
Exit Function
End If
LoadGif = True
'Get gif type
'intWidth = Asc(Mid$(fileHeader, 7, 4))
'intHeight = Asc(Mid$(fileHeader, 9, 4))
'BackColor = Asc(Mid$(fileHeader, 11, 1))
'Gif Type
If Left$(fileHeader, 6) = "GIF89a" Then
GifTypeFile = GIF89A
Else
GifTypeFile = GIF87A
End If
i = j + 2
'how many times the animation is repeated
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 "temp.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
'frame delay time
TimeWait = ((Asc(Mid(imgHeader, 4, 1))) + (Asc(Mid(imgHeader, 5, 1)) * 256&)) * 10&
If imgCount > 1 Then
'Get frame position
FrameX = Asc(Mid(imgHeader, 9, 1)) + (Asc(Mid(imgHeader, 10, 1)) * 256&)
FrameY = Asc(Mid(imgHeader, 11, 1)) + (Asc(Mid(imgHeader, 12, 1)) * 256&)
'load control for show the image
Load aImg(imgCount - 1)
'change the control position
'for show the image in right position
aImg(imgCount - 1).Left = FrameX '* Screen.TwipsPerPixelX
aImg(imgCount - 1).Top = FrameY '* Screen.TwipsPerPixelY
End If
' Use .Tag Property to save TimeWait interval for separate Image
aImg(imgCount - 1).Tag = TimeWait
aImg(imgCount - 1).Picture = LoadPicture("temp.gif")
'Get the disposal values and positions from frames
ReDim Preserve Dispose(aImg.Count - 1)
Dispose(aImg.Count - 1).Disposed = Asc(Mid(imgHeader, 3, 1)) / 4 And 3
Dispose(aImg.Count - 1).FrameXPos = FrameX
Dispose(aImg.Count - 1).FrameYPos = FrameY
'kill temp file
Kill ("temp.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 "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
TimeWait = ((Asc(Mid(imgHeader, 4, 1))) + (Asc(Mid(imgHeader, 5, 1)) * 256)) * 10
If imgCount > 1 Then
FrameX = Asc(Mid(imgHeader, 9, 1)) + (Asc(Mid(imgHeader, 10, 1)) * 256)
FrameY = Asc(Mid(imgHeader, 11, 1)) + (Asc(Mid(imgHeader, 12, 1)) * 256)
Load aImg(imgCount - 1)
aImg(imgCount - 1).Left = FrameX '* Screen.TwipsPerPixelX
aImg(imgCount - 1).Top = FrameY '* Screen.TwipsPerPixelY
End If
aImg(imgCount - 1).Tag = TimeWait
aImg(imgCount - 1).Picture = LoadPicture("temp.gif")
ReDim Preserve Dispose(aImg.Count - 1)
Dispose(aImg.Count - 1).Disposed = Asc(Mid(imgHeader, 3, 1)) / 4 And 3
Dispose(aImg.Count - 1).FrameXPos = FrameX
Dispose(aImg.Count - 1).FrameYPos = FrameY
Kill ("temp.gif")
End If
TotalFrames = aImg.Count - 1
LoadGif = True
If aImg.Count >= 2 Then
Load aImg(aImg.Count)
aImg(aImg.Count - 1).Width = aImg(0).Width
aImg(aImg.Count - 1).Height = aImg(0).Height
For i = 1 To aImg.Count - 2
If Dispose(i).Disposed = 0 Then
'nothing
ElseIf Dispose(i).Disposed = 1 Then
'previous frame + actual frame(transparent) = result frame
aImg(aImg.Count - 1).Picture = aImg(i - 1).Image
Debug.Print TransparentBlt(aImg(aImg.Count - 1).hdc, Dispose(i).FrameXPos, Dispose(i).FrameYPos, 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(i).Left = 0 'FrameX * Screen.TwipsPerPixelX
aImg(i).Top = 0 'FrameY * Screen.TwipsPerPixelY
aImg(aImg.Count - 1).Cls
End If
Next i
Unload aImg(aImg.Count - 1)
End If
LoadGif = True
Exit Function
ErrHandler:
MsgBox "Error No. " & Err.Number & " when reading file", vbCritical
LoadGif = False
On Error GoTo 0
End Function
OK, here is another BAS module
BTW: You are not using the correct value for the background color
Code:+------+----+----+--+--+--+-----------------------
|GIF89a|1400|1900|F7|04|00|<--- Start of GCT --->
+------+----+----+--+--+--+-----------------------
| |
If high bit is 1 ---+ |
then use this byte ----+
as index into Global
Color Table for the
background color
i see 1 error that sometimes i do... instead start with '1', i start with '0'. the 1st byte is '1' and not '0';)Quote:
Originally Posted by jmsrickland
i need ask 2 things:
1 - all bytes are in hexadecimal values?
2 - if so. when we see the Logical Screen Descriptor(for sample) the Packed Field(2 bytes). we need convert it to binary and then catch the bits that we need, right? or theres another calculation\formula more easy?
'There is no error you just need to know how to read the bits of the bytes
The Format Is this:
Which means you use the next byte 04 an the index into the Global Color Table. The 04 does not mean to use the 5th byte as the color. It means you need to multiply the index by 3 and add that value the the base address of the color tableCode:Bit Position = 7 6 5 4 3 2 1 0
F7 = 1 1 1 1 0 1 1 1
You can see that the high bit is set to 1
|
|
1 1 1 1 0 1 1 1
F 7
The table has 3-bytes per color, like this:
Keep in mind that there may not even be a Global Color Table. If this is the case then allCode:<--------------- Global Color Table (up to 768 Bytes) -------------------->
Color 0 Color 1 Color 2 Color 3 Color 4 Color 254 Color 255
| 00 00 00 | 80 00 00 | 00 80 00 | 80 80 00 | XX XX XX | ......... | 00 FF FF | FF FF FF |
frames use their own Local Color Table if they have one.
Also, even if there is a Global Color Table it may or may not be used.
What 2-byte packed field are you referring to? A packed field is only 1-byteQuote:
Originally Posted by joaquim
You don't convert to binary, you convert to Ascii. For example, if you want to test the Global Color Table bit (in the above example it is the byte that has the &HF7 = 11110111 ) you AND that byte with 128(= &H80 = 10000000) and if it equals 128 then the bit is set on and that means there is a Global Color Table
In VB you would do it this way:
Code:If Asc(Mid(GifBuffer, 11, 1)) And 128 = 128 Then
'
' Here if there is a Global Color Table
'
End If
Logical Screen Descriptor -> Packed Byte i see '91', then it's 2 digits are 1 byte.. after see your nice table... thanks.Quote:
Originally Posted by jmsrickland
you give me for Global Color Table, but i still don't understand for others values:(
can you give me the formula?
You say you are looking at a 91. Now is that a Decimal 91 (same as Ascii) or is it &H91?Code:+---- GIF Header ---+
| |
Packed byte -------------------------|--------------+ |
Logical Screen Height ---------------|------------+ | |
Logical Screen Width ----------------|---------+ | | |
| | | | |
+---+---+--+--+-+-+-+
|GIF|89a| | | | | |
+---+---+--+--+-+-+-+
| | |
| | + -- Pixel Aspect Ratio
| + ---- Background Color Index
|
Global Color Table Size ----------------------+ |
Sort Flag --------------------------------+ | |
Color Resolution ---------------------+ | | |
Global Color Table Flag ----------+ | | | |
| | | | |
| | | | |
7 6 5 4 3 2 1 0 |
+-+-----+-+-----+ |
| | | | | -+
+-+-----+-+-----+
| |
| + --- 0 Table not sorted
| 1 Table is sorted decreasing importance, most important color first.
|
+
1 = Global Color Table - Use next byte as index for Background Color
0 = No Global Color Table - Next byte is meaningless
Size of Global Color Table 3 * (2 ^ ((Value of bits 2 1 0) + 1))
Assuming it is &H91 then you have this:
91 = 1000 0001
Now look at above table I posted and you can see that the high bit is on so therefore you have a Global Color Table and because the last three bit are 001 that says you color table is only 1 which doesn't make sense.
Now if it is Ascii 91 then that means it is &H5B and 5B = 0101 1011
And that says the high bit is off so there is no Global Color Table
Which GIF file are you looking at?
so you did:Quote:
Originally Posted by jmsrickland
asc(91)=5B
then you convert 5B(hexadecimal) to binary that is 0101 1011.
now we need the last 3 digits: 011
3 * (2 ^ ((011) + 1))=12288
"Which GIF file are you looking at?"
what i'm trying to do is learn how read the bits;)
You are not paying attention to what I am saying to you.
First: Asc(91) does not equal 5B. It the other way around; Asc(Chr(&H5B)) = 91. To get the hexadecimal you simply do this Hex(91) = 5B
If it is decimal 91 (which means the byte is 5B then there is no Global Color Table so it is meaningless to try and to find it's size.
Second, you do not use the last 3-bits like you are doing. Do not do this:
3 * (2 ^ ((011) + 1))=12288
because you are using the last 3-bits as the value and that is not what you should do. 011 = 3 so you math would be this:
3 * (2 ^ 3) + 1 = 25
Your VB code for this is this:
3 * (2 ^ (Asc(Mid(GifBuffer, 11, 1)) And 3)) + 1
But remember, &H5B says there is no global color table which means that the frame(s) have their own
You are not paying attention to what I am saying to you.
First: Asc(91) does not equal 5B. It the other way around; Asc(Chr(&H5B)) = 91. To get the hexadecimal you simply do this Hex(91) = 5B
If it is decimal 91 (which means the byte is 5B then there is no Global Color Table so it is meaningless to try and to find it's size.
Second, you do not use the last 3-bits like you are doing. Do not do this:
3 * (2 ^ ((011) + 1))=12288
because you are using the last 3-bits as the value and that is not what you should do. 011 = 3 so you math would be this:
3 * (2 ^ 3) + 1 = 25
3 * (2 ^ (Asc(Mid(buf, 11, 1)) And 3)) + 1
But remember, &H5B says there is no global color table which means that the frame(s) have their own
ok... thanks for correct me.Quote:
Originally Posted by jmsrickland
i know that 011(binary)=3(decimal). the vb6 have something for convert the binary to decimal or i must build a function?
"But remember, &H5B says there is no global color table which means that the frame(s) have their own"
it's a const value?
You are not paying attention to what I am saying to you.
First: Asc(91) does not equal 5B. It the other way around; Asc(Chr(&H5B)) = 91. To get the hexadecimal you simply do this Hex(91) = 5B
If it is decimal 91 (which means the byte is 5B then there is no Global Color Table so it is meaningless to try and to find it's size.
Second, you do not use the last 3-bits like you are doing. Do not do this:
3 * (2 ^ ((011) + 1))=12288
because you are using the last 3-bits as the value and that is not what you should do. 011 = 3 so you math would be this:
3 * (2 ^ 3) + 1 = 25
Your VB code is this:
3 * (2 ^ (Asc(Mid(GifBuffer, 11, 1)) And 3)) + 1
But remember, &H5B says there is no global color table which means that the frame(s) have their own so the above calculation would be meaningless in this case but you would use this when there is a global color table or use it for a local color table except the offset 11 would be a different number
3 * (2 ^ (Asc(Mid(GifBuffer, ??, 1)) And 3)) + 1
where ?? is the string position for the byte that is used for a local color table
To extract the values from this byte use the following
7654 3210
xxxx xxxx
And 128 to get x000 0000 = Global Color Table Flag
And 48 to get 0xxx 0000 = Color Resolution
And 8 to get 0000 x000 = Sort Flag
And 3 to get 0000 0xxx = Global Color Table Size
"3 * (2 ^ (Asc(Mid(GifBuffer, 11, 1)) And 3)) + 1"
then it's:
3 * (2 ^ (Asc(Mid(GifBuffer, 11, 1)) And BinaryConvertedToDecimal)) + 1
right?
3 * (2 ^ (Asc(Mid(GifBuffer, 11, 1)) And 8)) + 1Quote:
Originally Posted by jmsrickland
and i have the short flag;)
i understand, but i still have the question: but the Graphics Control Extension - > Packed Field have a diferent configuraction, right?
The calculation 3 * (2 ^ (Asc(Mid(GifBuffer, 11, 1)) And 3)) + 1 is for the color table size only, not the other fields.
Global Color Table Flag = Asc(Mid(GifBuffer, 11, 1)) And 128
Color Resolution = Asc(Mid(GifBuffer, 11, 1)) And 48
Sort Flag = Asc(Mid(GifBuffer, 11, 1)) And 8
Global Color Table Size = 3 * (2 ^ (Asc(Mid(GifBuffer, 11, 1)) And 3)) + 1
YesQuote:
Originally Posted by joaquim
It is this:
Code:
End of
GCE Data
4 Bytes of |
GCE Data |
| |
GCE | Byte: |
Indicator | X1 X2 X3 X4 |
| | | | | | |
| 21 F9 | 04 | 05 32 00 09 00
Here is a complete description of the GCE
Code:"Extension Introducer"
Identifies beginning
of an extension Block ----------+ Block Terminator
| |
| |
+----+----+----+----+----+----+----+----+
| 21 | F9 | 04 | X1 | X2 | X3 | X4 | 00 |
+----+----+----+----+----+----+----+----+
| | | |
| | |<- Control Block ->|
Graphic Control Label ---------------+ |
+---- Block Size (Fixed Value)
block. This field contains the fixed value 0x21.
ii) Graphic Control Label - Identifies the current block as a
Graphic Control Extension. This field contains the fixed value
0xF9.
iii) Block Size - Number of bytes in the block, after the Block
Size field and up to but not including the Block Terminator. This
field contains the fixed value 4.
iv) Disposal Method - Indicates the way in which the graphic is to
be treated after being displayed.
|
+-----------------------+
|
+----+----+----+----+----+
| 04 | X1 | X2 | X3 | X4 |
+----+----+----+----+----+
|
+------------+
|
|
---------------
X1 = 7 6 5 4 3 2 1 0
---------------
x x x x 0 0 x x
x x x x 0 1 x x
x x x x 1 0 x x
x x x x 1 1 x x
|
|
+---------+
|
00 0 No disposal specified
01 1 Do not dispose - Leave
10 2 Restore Background
11 3 Restore Previous
Bits 7 6 5 3 To be defined
v) User Input Flag - Indicates whether or not user input is
expected before continuing. If the flag is set, processing will
continue when user input is entered. The nature of the User input
is determined by the application (Carriage Return, Mouse Button
Click, etc.).
|
+------------------------+
|
X1 = 7 6 5 4 3 2 1 0
---------------
x x x x d d 0 x
x x x x d d 1 x
Values : 0 - User input is not expected.
1 - User input is expected.
When a Delay Time is used and the User Input Flag is set,
processing will continue when user input is received or when the
delay time expires, whichever occurs first.
vi) Transparency Flag - Indicates whether a transparency index is
given in the Transparent Index field. (This field is the least
significant bit of the byte.)
|
+--------------------------+
|
X1 = 7 6 5 4 3 2 1 0
---------------
x x x x x x x 0
x x x x d d u 1
Values : 0 - Transparent Index is not given.
1 - Transparent Index is given.
vii) Delay Time - If not 0, this field specifies the number of
hundredths (1/100) of a second to wait before continuing with the
processing of the Data Stream. The clock starts ticking immediately
after the graphic is rendered. This field may be used in
conjunction with the User Input Flag field.
|
+----------------------------+----+ 2-byte value
| |
+---+----+----+----+----+----+----+----+
|21 | F9 | 04 | X1 | X2 | X3 | X4 | 00 |
+---+----+----+----+----+----+----+----+
viii) Transparency Index - The Transparency Index is such that when
encountered, the corresponding pixel of the display device is not
modified and processing goes on to the next pixel. The index is
present if and only if the Transparency Flag is set to 1.
|
+--------------------------------------+
|
+---+----+----+----+----+----+----+----+
|21 | F9 | 04 | X1 | X2 | X3 | X4 | 00 |
+---+----+----+----+----+----+----+----+
ix) Block Terminator - This [1 byte] zero-length data block marks the end of the
| Graphic Control Extension.
|
+-------------------------------------------+
|
+---+----+----+----+----+----+----+----+
|21 | F9 | 04 | X1 | X2 | X3 | X4 | 00 |
+---+----+----+----+----+----+----+----+
:(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