Reading Animated GIFs and extracting images
Posted: Wed Jun 06, 2007 8:27 pm
I have taken haqibaba's OLD gif code, and tweaked it to parse animated GIFs. it is NOT perfect. it still needs work, but the basics are there and the code is commented. please, feel free to add any corrections. there are some GIFs that do not render all frames correctly.
this code is pretty fast. as fast as AVD graphic studio. It can load and display 40 GIF frames in about .75 seconds. haqibaba is the original author of the PB translation of decoding GIF. I myself, figured out how to parse the individual frames and then render the images.
this code is pretty fast. as fast as AVD graphic studio. It can load and display 40 GIF frames in about .75 seconds. haqibaba is the original author of the PB translation of decoding GIF. I myself, figured out how to parse the individual frames and then render the images.
Code: Select all
Structure BITMAPINFOEX ;Custom BITMAPINFO struct
bmiHeader.BITMAPINFOHEADER
bmiColors.RGBQUAD[256]
EndStructure
;loadgif.h - gif loading functions For ImageShop32
;Version 1.0
;Copyright 2000 by John Findlay. All rights reserved.
Macro Bset(i,n)
i | (1 << n)
EndMacro
Macro Bchg(i,n)
Int(Pow(i,1 << n))
EndMacro
Macro Bclr(i,n)
i & ~(1 << n)
EndMacro
Macro BTst(i,n)
(i & (1 << n)) >> n
EndMacro
Macro Byte(i)
i & $FF
EndMacro
;- Constants
#NO_FILE=-2 ;"No such file or directory"
;#EOF=62 ;"End of file" Redefined
#NO_ACCESS=-13 ;"Access denied"
#TOMANY_FILES=-24 ;"Too many open files"
;LoadGIF Generated Errors
#UNKNOWN_CODE=-37 ;Unknown block code
#NOT_VALID=-38 ;Not valid gif
#BAD_CODE_SIZE=-39 ;Error if gif decoder has problems
#OUT_OF_MEMORY=-40 ;Error in no mem
#NO_DIB=-41 ;No DIB
#FILE_ERROR=-42 ;Problem with file codes
#NO_INTERLACE=-43 ;Does not support interlaced images
#NO_BITPIXEL=-44 ;Could not select bits/pixel
#NO_COLOURTABLE=-45 ;No colours
;All error codes should be less than 300
#SUCCESS=300 ;Return from FUNCTION Header()
#MAX_CODES=4095 ;Max possible number of LZW codes
#GIF_Terminator= $3B
#GraphicControl_Extension=$F9
#A_Extension_block=$21
#Comment_Extension=$FE
#PlainText_Extension=$01
#Application_Extension=$FF
#Image_Separator=$2C
;- Arrays
Global Dim stack.b(#MAX_CODES+1) ;Stack for storing pixels
Global Dim suffix.b(#MAX_CODES+1) ;Suffix table
Global Dim prefix.l(#MAX_CODES+1) ;Prefix linked list
Global Dim CharBuff.b(279) ;Current block
Global *lpBytes.Byte ;Pointer to next byte in block
Global Dim GlobalCols.l(256) ;Array for global colours of GIF
Global Dim localCols.l(256) ;Array for local image colours of GIF
;- Structures
Structure GIFHEADER
ghSig.b[6]
ghWidth.w
ghHeight.w
ghPkFields.b
ghBkColIndex.b
ghAspRatio.b
EndStructure
Structure ImageDescriptor
imSep.b
imLeft.w
imTop.w
imWidth.w
imHeight.w
impkFields.b
EndStructure
Global gh.GIFHEADER
Global im.ImageDescriptor
;loadgif.c - gif loading functions for ImageShop32
;Version 1.0
;Copyright 2000 by John Findlay. All rights reserved.
;Closely follows the 'C' source code written by Steven A. Bennett
;#include <windows.h>
;#include <stdio.h>
;#include "loadgif.h"
;- Globals
Global file.l
;Used in LoadGIF()
Global BytesPerLine.l=0 ;Bytes are rounded up for image lines
Global CurrCodeSize.l=0 ;The current code size
Global BitsLeft.l=0 ;Used in GetNextCode()
Global BytesLeft.l=0 ;Used in GetNextCode()
Global CurrByte.l=0 ;Current byte
;Used in Header()
Global bUseGlobalColMap.b=#False
Global bGlobColTable.b=#False ;Global Colour Table Flag bit '7'
Global GlobColRes.l=0 ;Colour Resolution, bits '6' '5' '4'
Global bGlobColsSorted.b=#False ;Sort Flag bit '3'
Global GlobColBytes.l=0
Global GlobColours.l=0
Global bImInterLace.b=#False ;Is the image interlaced
Global bImColsSorted.b=#False ;Is the local colour table sorted
Global bImColTable.b=#False ;Is there a local colour table
Global ImgColRes.l=0 ;!!New: Colour Resolution
Global ImgColBytes.l=0
Global ImgColours.l=0
Global Pass.l=0 ;First pass for interlaced images in OutLine()
Global Line.l=0 ;Offset for addressing the bits in OutLine()
Global lpBits.l=0
Global hDIB.l
Global realwidth.l
Global realheight.l
;Code Mask for LZW compression algorithm
Global Dim CodeMask.l(16)
CodeMask( 0)=$0000 : CodeMask( 1)=$0001
CodeMask( 2)=$0003 : CodeMask( 3)=$0007
CodeMask( 4)=$000F : CodeMask( 5)=$001F
CodeMask( 6)=$003F : CodeMask( 7)=$007F
CodeMask( 8)=$00FF : CodeMask( 9)=$01FF
CodeMask(10)=$03FF : CodeMask(11)=$07FF
CodeMask(12)=$0FFF : CodeMask(13)=$1FFF
CodeMask(14)=$3FFF : CodeMask(15)=$7FFF
Procedure.l Header(lpszFile.s)
;FUNCTION: Header(zFile)
;PURPOSE: Reads the gif header and stores the colours in global array
;GlobalCols()
;RETURNS: SUCCESS - if function succeeds. ERROR - otherwise.
;PARAMS: zFile -> gif file to be read
;USES FUNCS: ColourTableSize()
Protected lp.l,n.l,pos.l,sig.s
Protected r.l,g.l,b.l
Dim GlobalCols.l(256)
Dim localCols.l(256) ;Initially delete the colour arrays
file=ReadFile(#PB_Any,lpszFile)
;Read the file header and logical screen descriptor
ReadData(file,gh,SizeOf(gh))
pos=SizeOf(gh)
sig=PeekS(@gh\ghSig,6) ;Get header string
If sig<>"GIF89a" And sig<>"GIF87a"
ProcedureReturn #NOT_VALID
EndIf
realwidth= gh\ghWidth
realheight=gh\ghHeight
;Store gh\ghPkFields for bit manipulation
Protected PkFields.l=gh\ghPkFields & $FF
;Global Colour Table Flag bit '7'
bGlobColTable=BTst(PkFields,7)
If bGlobColTable
bUseGlobalColMap=#True
;Table size in bytes
GlobColBytes=3*(1 << ((PkFields & $07)+1))
GlobColours=GlobColBytes/3
;Some GIF encoders do not follow the gif spec very well,
;so make GlobColRes from GlobColours.
;Also GIF's are used on different platforms, which do
;have different BitsPerPixel. i.e. 32 colours is 5 bits/pixel.
If GlobColours<=2
GlobColRes=1
ElseIf GlobColours<=16
GlobColRes=4
ElseIf GlobColours<=256
GlobColRes=8
Else
ProcedureReturn #NO_BITPIXEL
EndIf
;Get the Global screen colours
r=0 : g=0 : b=0
For n=0 To GlobColours-1
r=ReadByte(file) & 255
g=ReadByte(file) & 255
b=ReadByte(file) & 255
GlobalCols(n)=RGB(r,g,b)
pos+3
Next
EndIf
n=0
While n<>$2C
n=ReadByte(file) & 255
pos+1
Wend
FileSeek(file,pos-1)
ReadData(file,im,SizeOf(im))
If im\imSep & 255<>$2C
ProcedureReturn #UNKNOWN_CODE
EndIf
;Store im\ImpkFields for bit manipulation
Protected impkFields.l=Byte(im\impkFields)
;Is the image interlaced
bImInterLace=BTst(impkFields,6)
;Is the local colour table sorted
bImColsSorted=BTst(impkFields,5)
;Is there a local colour table
bImColTable=BTst(impkFields,7)
If bImColTable
bUseGlobalColMap=#False
ImgColBytes=3*(1 << ((impkFields & $07)+1))
ImgColours=ImgColBytes/3
;!!New
If ImgColours<=2
ImgColRes=1
ElseIf ImgColours<=16
ImgColRes=4
ElseIf ImgColours<=256
ImgColRes=8
Else
ProcedureReturn #NO_BITPIXEL
EndIf
;Get the local image colours and store them into global array
r=0 : g=0 : b=0
For n=0 To ImgColours-1
r=ReadByte(file) & 255
g=ReadByte(file) & 255
b=ReadByte(file) & 255
localCols(n)=RGB(r,g,b)
Next
Else
If bUseGlobalColMap=#False
ProcedureReturn #NO_COLOURTABLE
EndIf
EndIf
ProcedureReturn #SUCCESS ;Success
EndProcedure
Procedure.b IsNewDibFormat(*lpbih.BITMAPINFOHEADER)
If *lpbih\biSize<>SizeOf(BITMAPCOREHEADER)
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure.l DIBNumColours(lpv.l)
Protected Bits.l
Protected *lpbih.BITMAPINFOHEADER=lpv
Protected *lpbch.BITMAPCOREHEADER=lpv
;With the BITMAPINFO format headers, the size of the palette is
;in biClrUsed, whereas in the BITMAPCORE - style headers, it is
;dependent on the Bits per pixel (2 to the power of bitsperpixel).
If IsNewDibFormat(*lpbih)
If *lpbih\biClrUsed<>0
ProcedureReturn *lpbih\biClrUsed
Else
Bits=*lpbih\biBitCount
EndIf
Else
Bits=*lpbch\bcBitCount
EndIf
If Bits>8 ;Since biClrUsed is 0, we don't have an optimal palette
ProcedureReturn 0
Else
ProcedureReturn (1 << Bits)
EndIf
EndProcedure
Procedure.l ColourTableSize(*lpbih.BITMAPINFOHEADER)
If IsNewDibFormat(*lpbih)
If *lpbih\biCompression=#BI_BITFIELDS
ProcedureReturn ((3+DIBNumColours(*lpbih))*SizeOf(RGBQUAD))
Else
ProcedureReturn (DIBNumColours(*lpbih)*SizeOf(RGBQUAD))
EndIf
Else
ProcedureReturn (DIBNumColours(*lpbih)*SizeOf(RGBTRIPLE))
EndIf
EndProcedure
Procedure.l CreateDIB(Width.l,Height.l,BitCount.l,Comp.l)
Protected Len.l,n.l
Protected hDIB.l
Protected *lpRgbQ.RGBQUAD
Protected bi.BITMAPINFOHEADER
If BitCount<=1
BitCount=1
ElseIf BitCount<=4
BitCount=4
ElseIf BitCount<=8
BitCount=8
ElseIf BitCount<=16
BitCount=16
ElseIf BitCount<=24
BitCount=24
ElseIf BitCount<=32
BitCount=32
Else
BitCount=4 ;set default value to 4 if parameter is bogus
EndIf
bi\biSize=SizeOf(bi)
bi\biWidth=Width
bi\biHeight=Height
bi\biPlanes=1
bi\biBitCount=BitCount
bi\biCompression=Comp
bi\biSizeImage=0
bi\biXPelsPerMeter=0
bi\biYPelsPerMeter=0
;!!New
If bUseGlobalColMap
bi\biClrUsed=GlobColours
Else
bi\biClrUsed=ImgColours
EndIf
bi\biClrImportant=0
BytesPerLine=(((BitCount*Width)+31) >> 5) << 2
Len=bi\biSize+ColourTableSize(bi)+(BytesPerLine*Height)
;Fill in the image size
bi\biSizeImage=BytesPerLine*Height
;Alloc memory block to store our DIB
hDIB=AllocateMemory(Len)
;Use bitmap info structure to fill first part of DIB with the BITMAPINFOHEADER
CopyMemory(bi,hDIB,SizeOf(bi))
;Colours (Or Masks For the new DIB formats) are straight after BITMAPINFOHEADER
*lpRgbQ=hDIB+SizeOf(bi)
;!!New, Set the colours in the DIB
If bUseGlobalColMap
For n=0 To bi\biClrUsed-1
*lpRgbQ\rgbBlue=Blue(GlobalCols(n))
*lpRgbQ\rgbGreen=Green(GlobalCols(n))
*lpRgbQ\rgbRed=Red(GlobalCols(n))
*lpRgbQ\rgbReserved=0
*lpRgbQ+4
Next
Else
For n=0 To bi\biClrUsed-1
*lpRgbQ\rgbBlue=Blue(localCols(n))
*lpRgbQ\rgbGreen=Green(localCols(n))
*lpRgbQ\rgbRed=Red(localCols(n))
*lpRgbQ\rgbReserved=0
*lpRgbQ+4
Next
EndIf
ProcedureReturn hDIB
EndProcedure
Procedure OutLine(lpPixels.l,LineLen.l)
;PROCEDURE: OutLine()
;PURPOSE: Outputs the pixel colour index data to the DIB
;RETURNS: None
;PARAMS: lpPixels -> memory block that holds the colour index value
;LineLen -> length of the line of pixels
;USES FUNCS : None
;GIF images are 2, 16 or 256 colours, poking the values into memory
;requires a different method for each case. If gif is interlaced,
;that is deal with here.
Protected ib.l
Protected Pixel.l,byte.l,BitCnt.l,CntBk.l,ColRes.l
;!!New
If bUseGlobalColMap
ColRes=GlobColRes
Else
ColRes=ImgColRes
EndIf
Select ColRes
Case 1
byte=0
For Pixel=0 To LineLen-1 Step 8
ib=0
CntBk=7
For BitCnt=0 To 8-1
If PeekB(lpPixels+BitCnt+Pixel) & 255
ib=Bset(ib,CntBk)
EndIf
CntBk-1
Next
PokeB(lpBits-(Line*BytesPerLine)+byte,ib & 255)
byte+1
Next
Case 4
byte=0
For Pixel=0 To LineLen-1 Step 2
ib=((PeekB(lpPixels+Pixel) & 255) << 4) | (PeekB(lpPixels+Pixel+1) & 255)
PokeB(lpBits-(Line*BytesPerLine)+byte,ib & 255)
byte+1
Next
Case 8
For Pixel=0 To LineLen-1
PokeB(lpBits-(Line*BytesPerLine)+Pixel,PeekB(lpPixels+Pixel))
Next
EndSelect
;Set Line for different passes when Interlaced
If bImInterLace
Select Pass
Case 0 ;Pass 1
If Line<im\imHeight-8
Line+8
Else
Line=4 : Pass+1 ;Set Line for second pass
EndIf
Case 1 ;Pass 2
If Line<im\imHeight-8
Line+8
Else
Line=2 : Pass+1 ;Set Line for third pass
EndIf
Case 2 ;Pass 3
If Line<im\imHeight-4
Line+4
Else
Line=1 : Pass+1 ;Set Line for fourth pass
EndIf
Case 3 ;Pass 4
If Line<im\imHeight-2
Line+2
EndIf
EndSelect
;When not Interlaced increment Line
Else
Line+1
EndIf
EndProcedure
Procedure.l GetNextCode()
;FUNCTION: GetNextCode()
;PURPOSE: Reads the next code from the data stream
;RETURNS: Returns the LZW CODE or ERROR
;PARAMS: None
;USES FUNCS: None
Protected n.l,ret.l,lp.l
Protected i.l=0
If BitsLeft=0 ;Any bits left in byte?
If BytesLeft<=0 ;If not get another block
*lpBytes=@CharBuff(0) ;Set byte pointer
BytesLeft=ReadByte(file) & 255
If BytesLeft<0
ProcedureReturn BytesLeft ;Return if error
ElseIf BytesLeft
;Fill the char buffer with the new block
For n=0 To BytesLeft-1
i=ReadByte(file) & 255
If i<0
ProcedureReturn i
EndIf
CharBuff(n)=i
Next
EndIf
EndIf
CurrByte=*lpBytes\b & 255 ;Get a byte
*lpBytes+1 ;Increment index pointer
BitsLeft=8 ;Set bits left in the byte
BytesLeft-1 ;Decrement the bytes left counter
EndIf
ret=CurrByte >> (8-BitsLeft) ;Shift off any previously used bits
While CurrCodeSize>BitsLeft
If BytesLeft<=0
;Out of bytes in current block
*lpBytes=@CharBuff(0) ;Set byte pointer
BytesLeft=ReadByte(file) & 255
If BytesLeft<0
ProcedureReturn BytesLeft ;Return if error
ElseIf BytesLeft
;Fill the char buffer with the current block
For n=0 To BytesLeft-1
i=ReadByte(file) & 255
If i<0
ProcedureReturn i
EndIf
CharBuff(n)=i
Next
EndIf
EndIf
CurrByte=*lpBytes\b & 255 ;Get a byte
*lpBytes+1 ;Increment index pointer
ret | (CurrByte << BitsLeft) ;Add remaining bits to return value
BitsLeft+8 ;Set bit counter
BytesLeft-1 ;Decrement bytesleft counter
Wend
BitsLeft-CurrCodeSize ;Subtract the code size from bitsleft
ret & CodeMask(CurrCodeSize) ;Mask off the right number of bits
ProcedureReturn ret
EndProcedure
Procedure.l loadGIF(lpszFile.s)
;FUNCTION: LoadGIF(zFile)
;PURPOSE: Decodes the gif image after the gif header has been read
;RETURNS: hDIB, Handle of new DIB or ERROR if not successful
;PARAMS: zFile -> gif file to be read
;USES FUNCS: Header(), CreateDIB(), ColourTableSize(),
;GetNextCode(), OutLine()
Protected hDIB.l
Protected *lpSP.Byte ;Pointer to stack
Protected *lpBuffPtr.Byte ;Pointer to buffer
Protected code.l
Protected BufCnt.l ;Count for pixel line length
Protected TempOldCode.l
Protected OldCode.l
Protected cc.l,ret.l,lp.l
Protected LZWCodeSize.l ;Code bits size
Protected ClearCode.l ;Value for a clear code
Protected EndingCode.l ;Value for a ending code
Protected NewCodes.l ;First available code
Protected TopSlot.l ;Highest code for current size
Protected Slot.l ;Last read code
ret=Header(lpszFile)
If ret<#SUCCESS
CloseFile(file)
ProcedureReturn ret ;Return error
EndIf
Protected linewidth.l=im\imWidth ;Image width
;Get the first byte of the new block of image data.
;Should be the bit size
LZWCodeSize=ReadByte(file) & 255
;Bit size is normally the same as the colour resolution.
;i.e. 8 for 256 colours
If LZWCodeSize<0 Or LZWCodeSize<2 Or LZWCodeSize>8
CloseFile(file)
ProcedureReturn #BAD_CODE_SIZE
EndIf
;Initialise the variables for the decoder for reading a new image.
CurrCodeSize=LZWCodeSize+1
TopSlot=1 << CurrCodeSize
ClearCode=1 << LZWCodeSize
EndingCode=ClearCode+1
NewCodes=ClearCode+2
Slot=NewCodes
BitsLeft=0
BytesLeft=0
;Just in case...
TempOldCode=0 : OldCode=0
;Allocate space for the decode buffer
Protected lpBUFF.l=AllocateMemory(linewidth+8) ;+8 just in case
;Set up the stack pointer, decode buffer pointer and line counter
*lpSP=@stack(0)
*lpBuffPtr=lpBUFF
BufCnt=linewidth
;Create the DIB width, height, colour bits and compression.
;Colours were read in the function Header()
;!!New
If bUseGlobalColMap
hDIB=CreateDIB(im\imWidth,im\imHeight,GlobColRes,#BI_RGB)
Else
hDIB=CreateDIB(im\imWidth,im\imHeight,ImgColRes,#BI_RGB)
EndIf
Line=0 ;Set address offset for OutLine()
Pass=0 ;For interlaced images in OutLine()
Protected *lphDIB.BITMAPINFOHEADER=hDIB
If hDIB=0
FreeMemory(lpBUFF)
CloseFile(file)
ProcedureReturn #NO_DIB
EndIf
;Image data bits of DIB
lpBits=*lphDIB+*lphDIB\biSize+ColourTableSize(*lphDIB)+(BytesPerLine*(im\imHeight-1))
;This is the main loop. For each code we get we pass through the
;linked list of prefix codes, pushing the corresponding "character"
;for each code onto the stack. When the list reaches a single
;"character" we push that on the stack too, and then start
;unstacking each character for output in the correct order.
;Special handling is included for the clear code, and the whole
;thing ends when we get an ending code.
While cc<>EndingCode
cc=GetNextCode()
;If a file error, return without completing the decode
If cc<0
FreeMemory(lpBUFF)
CloseFile(file)
ProcedureReturn #FILE_ERROR
EndIf
;If the code is a clear code, re-initialise all necessary items.
If cc=ClearCode
CurrCodeSize=LZWCodeSize+1
Slot=NewCodes
TopSlot=1 << CurrCodeSize
;Continue reading codes until we get a non-clear code
;(Another unlikely, but possible case...)
While cc=ClearCode
cc=GetNextCode()
Wend
;If we get an ending code immediately after a clear code
;(Yet another unlikely case), then break out of the loop.
If cc=EndingCode ;end
ret=0
If BufCnt<>linewidth ;If there are any left, output the bytes
OutLine(lpBUFF,linewidth-BufCnt-1)
EndIf
CloseFile(file)
FreeMemory(lpBUFF)
ProcedureReturn hDIB
EndIf
;Finally, if the code is beyond the range of already set codes,
;(This one had better not happen... I have no idea what will
;result from this, but I doubt it will look good...)
;then set it to colour zero.
If cc>=Slot
cc=0
EndIf
OldCode=cc
TempOldCode=OldCode
;And let us not forget to put the char into the buffer. And if,
;on the off chance, we were exactly one pixel from the end of
;the line, we have to send the buffer to the OutLine() routine
*lpBuffPtr\b=cc
*lpBuffPtr+1
BufCnt-1
If BufCnt=0
OutLine(lpBUFF,linewidth)
*lpBuffPtr=lpBUFF
BufCnt=linewidth
EndIf
Else
;In this case, it's not a clear code or an ending code, so it
;must be a code code. So we can now decode the code into a
;stack of character codes (Clear as mud, right?).
code=cc
If code=Slot
code=TempOldCode
*lpSP\b=OldCode
*lpSP+1
EndIf
;Here we scan back along the linked list of prefixes, pushing
;helpless characters (i.e. suffixes) onto the stack as we do so.
While code>=NewCodes
*lpSP\b=suffix(code)
*lpSP+1
code=prefix(code)
Wend
;Push the last character on the stack, and set up the new
;prefix and suffix, and if the required slot number is greater
;than that allowed by the current bit size, increase the bit
;size. (NOTE - if we are all full, we *don't* save the new
;suffix and prefix... I'm not certain if this is correct...
;it might be more proper to overwrite the last code...
*lpSP\b=code
*lpSP+1
If Slot<TopSlot
OldCode=code
suffix(Slot)=OldCode
prefix(Slot)=TempOldCode
Slot+1
TempOldCode=cc
EndIf
If Slot>=TopSlot
If CurrCodeSize<12
TopSlot=TopSlot << 1
CurrCodeSize+1
EndIf
EndIf
;Now that we've pushed the decoded string (in reverse order)
;onto the stack, lets pop it off and put it into our decode
;buffer, and when the decode buffer is full, write another line.
While *lpSP>@stack(0)
*lpSP-1
*lpBuffPtr\b=*lpSP\b
*lpBuffPtr+1
BufCnt-1
If BufCnt=0
OutLine(lpBUFF,linewidth)
*lpBuffPtr=lpBUFF
BufCnt=linewidth
EndIf
Wend
EndIf
Wend
;end
ret=0
If BufCnt<>linewidth ;If there are any left, output the bytes
OutLine(lpBUFF,linewidth-BufCnt-1)
EndIf
CloseFile(file)
FreeMemory(lpBUFF)
ProcedureReturn hDIB
EndProcedure
Procedure.l LoadGIF_(lpszFile.s)
Protected bie.BITMAPINFOEX
Protected *lphDIB.BITMAPINFOHEADER
Protected *lpRgbQ.RGBQUAD
Protected count.l,bhsize.l,ncolors.l,hDIB.l,hdc.l,hBitmap.l
hDIB=loadGIF(lpszFile)
If hDIB<=0 ;Check for errors
ProcedureReturn hDIB
EndIf
*lphDIB=hDIB ;Use a pointer to get info
bhsize=*lphDIB\biSize
ncolors=*lphDIB\biClrUsed
*lpRgbQ=hDIB+bhsize
;Fill in a BITMAPINFOEX structure for CreateDIBitmap_()
CopyMemory(*lphDIB,bie\bmiHeader,SizeOf(BITMAPINFOHEADER))
For count=0 To ncolors-1 ;Fill in a palette
bie\bmiColors[count]\rgbBlue=*lpRgbQ\rgbBlue ;blue
bie\bmiColors[count]\rgbGreen=*lpRgbQ\rgbGreen ;green
bie\bmiColors[count]\rgbRed=*lpRgbQ\rgbRed ;red
*lpRgbQ+4
Next
;Create the DDB bitmap
hdc=GetDC_(#Null)
hBitmap=CreateDIBitmap_(hdc,bie\bmiHeader,#CBM_INIT,hDIB+bhsize+(ncolors*4),bie,#DIB_RGB_COLORS)
FreeMemory(hDIB) ;Free the DIB
ProcedureReturn hBitmap
EndProcedure
Global Dim imagearray.l(1)
Procedure DrawTransparentImage(DC, Bitmap, x, y, Width, Height, TransparentColor)
; First, create some DC's. These are our gateways To associated
; bitmaps in RAM
maskDC = createcompatibledc_(DC)
tempDC = createcompatibledc_(DC)
SourceDC = createcompatibledc_(DC)
selectobject_(SourceDC, Bitmap)
; Then, we need the bitmaps. Note that we create a monochrome
; bitmap here!
; This is a trick we use For creating a mask fast enough.
hMaskBmp = createbitmap_(Width, Height, 1, 1, 0)
hTempBmp = CreateCompatibleBitmap_(DC, Width, Height)
; Then we can assign the bitmaps to the DCs
;
hMaskBmp = selectobject_(maskDC, hMaskBmp)
hTempBmp = selectobject_(tempDC, hTempBmp)
; Now we can create a mask. First, we set the background color
; To the transparent color; then we copy the image into the
; monochrome bitmap.
; When we are done, we reset the background color of the
; original source.
TransparentColor= setbkcolor_(SourceDC, TransparentColor)
BitBlt_ (maskDC, 0, 0, Width, Height, SourceDC, 0, 0, #SRCCOPY)
setbkcolor_(SourceDC, TransparentColor)
; The first we do with the mask is To MergePaint it into the
; destination.
; This will punch a WHITE hole in the background exactly were
; we want the graphics To be painted in.
BitBlt_ (tempDC, 0, 0, Width, Height, maskDC, 0, 0, #SRCCOPY)
BitBlt_ (DC, x, y, Width, Height, tempDC, 0, 0, #MERGEPAINT)
; Now we delete the transparent part of our source image. To do
; this, we must invert the mask And MergePaint it into the
; source image. The transparent area will now appear as WHITE.
BitBlt_ (maskDC, 0, 0, Width, Height, maskDC, 0, 0, #NOTSRCCOPY)
BitBlt_ (tempDC, 0, 0, Width, Height, SourceDC, 0, 0, #SRCCOPY)
BitBlt_ (tempDC, 0, 0, Width, Height, maskDC, 0, 0, #MERGEPAINT)
; Both target And source are clean. All we have To do is To And
; them together!
BitBlt_ (DC, x, y, Width, Height, tempDC, 0, 0, #SRCAND)
; Now all we have To do is To clean up after us And free system
; resources..
DeleteObject_ (hMaskBmp)
DeleteObject_ (hTempBmp)
DeleteDC_ (maskDC)
DeleteDC_ (tempDC)
DeleteDC_ (SourceDC)
EndProcedure
Procedure LoadGIFframes(lpszFile.s,imagearray.l(1))
Protected hDIB.l
Protected *lpSP.Byte ;Pointer to stack
Protected *lpBuffPtr.Byte ;Pointer to buffer
Protected code.l
Protected BufCnt.l ;Count for pixel line length
Protected TempOldCode.l
Protected OldCode.l
Protected cc.l,ret.l,lp.l
Protected LZWCodeSize.l ;Code bits size
Protected ClearCode.l ;Value for a clear code
Protected EndingCode.l ;Value for a ending code
Protected NewCodes.l ;First available code
Protected TopSlot.l ;Highest code for current size
Protected Slot.l ;Last read code
Protected bie.BITMAPINFOEX
Protected *lphDIB.BITMAPINFOHEADER
Protected *lpRgbQ.RGBQUAD
Protected count.l,bhsize.l,ncolors.l,hdc.l,hBitmap.l
; Get the HEader
ret=Header(lpszFile)
If ret<#SUCCESS
CloseFile(file)
ProcedureReturn ret ;Return error
EndIf
Protected linewidth.l=im\imWidth ;Image width
;Get the first byte of the new block of image data.
;Should be the bit size
LZWCodeSize=ReadByte(file) & 255
;Bit size is normally the same as the colour resolution.
;i.e. 8 for 256 colours
If LZWCodeSize<0 Or LZWCodeSize<2 Or LZWCodeSize>8
CloseFile(file)
ProcedureReturn #BAD_CODE_SIZE
EndIf
;Initialise the variables for the decoder for reading a new image.
CurrCodeSize=LZWCodeSize+1
TopSlot=1 << CurrCodeSize
ClearCode=1 << LZWCodeSize
EndingCode=ClearCode+1
NewCodes=ClearCode+2
Slot=NewCodes
BitsLeft=0
BytesLeft=0
;Just in case...
TempOldCode=0 : OldCode=0
;Allocate space for the decode buffer
Protected lpBUFF.l=AllocateMemory(linewidth+8) ;+8 just in case
;Set up the stack pointer, decode buffer pointer and line counter
*lpSP=@stack(0)
*lpBuffPtr=lpBUFF
BufCnt=linewidth
;Create the DIB width, height, colour bits and compression.
;Colours were read in the function Header()
;!!New
If bUseGlobalColMap
hDIB=CreateDIB(im\imWidth,im\imHeight,GlobColRes,#BI_RGB)
Else
hDIB=CreateDIB(im\imWidth,im\imHeight,ImgColRes,#BI_RGB)
EndIf
Line=0 ;Set address offset for OutLine()
Pass=0 ;For interlaced images in OutLine()
*lphDIB.BITMAPINFOHEADER=hDIB
If hDIB=0
FreeMemory(lpBUFF)
CloseFile(file)
ProcedureReturn #NO_DIB
EndIf
;Image data bits of DIB
lpBits=*lphDIB+*lphDIB\biSize+ColourTableSize(*lphDIB)+(BytesPerLine*(im\imHeight-1))
;This is the main loop. For each code we get we pass through the
;linked list of prefix codes, pushing the corresponding "character"
;for each code onto the stack. When the list reaches a single
;"character" we push that on the stack too, and then start
;unstacking each character for output in the correct order.
;Special handling is included for the clear code, and the whole
;thing ends when we get an ending code.
While cc<>EndingCode
cc=GetNextCode()
;If a file error, return without completing the decode
If cc<0
FreeMemory(lpBUFF)
CloseFile(file)
ProcedureReturn #FILE_ERROR
EndIf
;If the code is a clear code, re-initialise all necessary items.
If cc=ClearCode
CurrCodeSize=LZWCodeSize+1
Slot=NewCodes
TopSlot=1 << CurrCodeSize
;Continue reading codes until we get a non-clear code
;(Another unlikely, but possible case...)
While cc=ClearCode
cc=GetNextCode()
Wend
;If we get an ending code immediately after a clear code
;(Yet another unlikely case), then break out of the loop.
If cc=EndingCode ;end
ret=0
If BufCnt<>linewidth ;If there are any left, output the bytes
OutLine(lpBUFF,linewidth-BufCnt-1)
EndIf
CloseFile(file)
FreeMemory(lpBUFF)
ProcedureReturn hDIB
EndIf
;Finally, if the code is beyond the range of already set codes,
;(This one had better not happen... I have no idea what will
;result from this, but I doubt it will look good...)
;then set it to colour zero.
If cc>=Slot
cc=0
EndIf
OldCode=cc
TempOldCode=OldCode
;And let us not forget to put the char into the buffer. And if,
;on the off chance, we were exactly one pixel from the end of
;the line, we have to send the buffer to the OutLine() routine
*lpBuffPtr\b=cc
*lpBuffPtr+1
BufCnt-1
If BufCnt=0
OutLine(lpBUFF,linewidth)
*lpBuffPtr=lpBUFF
BufCnt=linewidth
EndIf
Else
;In this case, it's not a clear code or an ending code, so it
;must be a code code. So we can now decode the code into a
;stack of character codes (Clear as mud, right?).
code=cc
If code=Slot
code=TempOldCode
*lpSP\b=OldCode
*lpSP+1
EndIf
;Here we scan back along the linked list of prefixes, pushing
;helpless characters (i.e. suffixes) onto the stack as we do so.
While code>=NewCodes
*lpSP\b=suffix(code)
*lpSP+1
code=prefix(code)
Wend
;Push the last character on the stack, and set up the new
;prefix and suffix, and if the required slot number is greater
;than that allowed by the current bit size, increase the bit
;size. (NOTE - if we are all full, we *don't* save the new
;suffix and prefix... I'm not certain if this is correct...
;it might be more proper to overwrite the last code...
*lpSP\b=code
*lpSP+1
If Slot<TopSlot
OldCode=code
suffix(Slot)=OldCode
prefix(Slot)=TempOldCode
Slot+1
TempOldCode=cc
EndIf
If Slot>=TopSlot
If CurrCodeSize<12
TopSlot=TopSlot << 1
CurrCodeSize+1
EndIf
EndIf
;Now that we've pushed the decoded string (in reverse order)
;onto the stack, lets pop it off and put it into our decode
;buffer, and when the decode buffer is full, write another line.
While *lpSP>@stack(0)
*lpSP-1
*lpBuffPtr\b=*lpSP\b
*lpBuffPtr+1
BufCnt-1
If BufCnt=0
OutLine(lpBUFF,linewidth)
*lpBuffPtr=lpBUFF
BufCnt=linewidth
EndIf
Wend
EndIf
Wend
;end
ret=0
If BufCnt<>linewidth ;If there are any left, output the bytes
OutLine(lpBUFF,linewidth-BufCnt-1)
EndIf
If hDIB<=0 ;Check for errors
;ProcedureReturn hDIB
EndIf
;Create the hBitmap
*lphDIB=hDIB ;Use a pointer to get info
bhsize=*lphDIB\biSize
ncolors=*lphDIB\biClrUsed
*lpRgbQ=hDIB+bhsize
;Fill in a BITMAPINFOEX structure for CreateDIBitmap_()
CopyMemory(*lphDIB,bie\bmiHeader,SizeOf(BITMAPINFOHEADER))
For count=0 To ncolors-1 ;Fill in a palette
bie\bmiColors[count]\rgbBlue=*lpRgbQ\rgbBlue ;blue
bie\bmiColors[count]\rgbGreen=*lpRgbQ\rgbGreen ;green
bie\bmiColors[count]\rgbRed=*lpRgbQ\rgbRed ;red
*lpRgbQ+4
Next
;Create the DDB bitmap
hdc=GetDC_(#Null)
hBitmap=CreateDIBitmap_(hdc,bie\bmiHeader,#CBM_INIT,hDIB+bhsize+(ncolors*4),bie,#DIB_RGB_COLORS)
FreeMemory(hDIB) ;Free the DIB
imagearray(0)=hBitmap
numberimages=1
;- Now to get the other Framez
NotatEnd=1
; #GIF_Terminator= $3B
; #GraphicControl_Extension=$F9
; #A_Extension_block=$21
; #Comment_Extension=$FE
; #PlainText_Extension=$01
; #Application_Extension=$FF
; #Image_Separator=$2C
While NotatEnd=1
While n<>$2C
n=ReadByte(file) & 255
If n=$3B
NotatEnd=0
Debug "found end at " + Str(Loc(file))
CloseFile(file)
FreeMemory(lpBUFF)
ProcedureReturn numberimages
ElseIf n=$F9
;Graphics control extension
n=ReadByte(file) & 255
Size=n
n=ReadByte(file) & 255
packedfields.b=n
delaytime.w=ReadWord(file)
transparent.b=ReadByte(file) & 255
transcolor=GlobalCols(transparent)
; If transcolor<0
; transcolor=0
; EndIf
;Debug n
;FileSeek(file,Loc(file)+n)
ElseIf n=$FF
;application extension
ElseIf n=$FE
;comment extention
n=ReadByte(file) & 255
FileSeek(file,Loc(file)+n)
ElseIf n= $01
;"plain text extention"
n=ReadByte(file) & 255
FileSeek(file,Loc(file)+n)
ElseIf n =$21
;"A Extension_block
EndIf
Wend
n=0
FileSeek(file,Loc(file)-1)
ReadData(file,im,SizeOf(im))
If im\imSep & 255<>$2C
ProcedureReturn #UNKNOWN_CODE
EndIf
impkFields.l=Byte(im\impkFields)
;Is the image interlaced
bImInterLace=BTst(impkFields,6)
;Is the local colour table sorted
bImColsSorted=BTst(impkFields,5)
;Is there a local colour table
bImColTable=BTst(impkFields,7)
If bImColTable
Debug "color table"
bUseGlobalColMap=#False
ImgColBytes=3*(1 << ((impkFields & $07)+1))
ImgColours=ImgColBytes/3
;!!New
If ImgColours<=2
ImgColRes=1
ElseIf ImgColours<=16
ImgColRes=4
ElseIf ImgColours<=256
ImgColRes=8
Else
Debug "no bitpixel"
ProcedureReturn #NO_BITPIXEL
EndIf
;Get the local image colours and store them into global array
r=0 : g=0 : b=0
For n=0 To ImgColours-1
r=ReadByte(file) & 255
g=ReadByte(file) & 255
b=ReadByte(file) & 255
localCols(n)=RGB(r,g,b)
Next
Else
If bUseGlobalColMap=#False
Debug "no colortable"
ProcedureReturn #NO_COLOURTABLE
EndIf
EndIf
linewidth.l=im\imWidth ;Image width
;Get the first byte of the new block of image data.
;Should be the bit size
LZWCodeSize=ReadByte(file) & 255
;Bit size is normally the same as the colour resolution.
;i.e. 8 for 256 colours
If LZWCodeSize<0 Or LZWCodeSize<2 Or LZWCodeSize>8
CloseFile(file)
Debug "bad code size"
ProcedureReturn #BAD_CODE_SIZE
EndIf
;Initialise the variables for the decoder for reading a new image.
CurrCodeSize=LZWCodeSize+1
TopSlot=1 << CurrCodeSize
ClearCode=1 << LZWCodeSize
EndingCode=ClearCode+1
NewCodes=ClearCode+2
Slot=NewCodes
BitsLeft=0
BytesLeft=0
;Just in case...
TempOldCode=0 : OldCode=0
;Allocate space for the decode buffer
lpBUFF.l=AllocateMemory(linewidth+8) ;+8 just in case
;Set up the stack pointer, decode buffer pointer and line counter
*lpSP=@stack(0)
*lpBuffPtr=lpBUFF
BufCnt=linewidth
;Create the DIB width, height, colour bits and compression.
;Colours were read in the function Header()
;!!New
If bUseGlobalColMap
hDIB=CreateDIB(im\imWidth,im\imHeight,GlobColRes,#BI_RGB)
Else
hDIB=CreateDIB(im\imWidth,im\imHeight,ImgColRes,#BI_RGB)
EndIf
Line=0 ;Set address offset for OutLine()
Pass=0 ;For interlaced images in OutLine()
*lphDIB.BITMAPINFOHEADER=hDIB
If hDIB=0
FreeMemory(lpBUFF)
CloseFile(file)
ProcedureReturn #NO_DIB
EndIf
;Image data bits of DIB
lpBits=*lphDIB+*lphDIB\biSize+ColourTableSize(*lphDIB)+(BytesPerLine*(im\imHeight-1))
cc=0
;This is the main loop. For each code we get we pass through the
;linked list of prefix codes, pushing the corresponding "character"
;for each code onto the stack. When the list reaches a single
;"character" we push that on the stack too, and then start
;unstacking each character for output in the correct order.
;Special handling is included for the clear code, and the whole
;thing ends when we get an ending code.
While cc<>EndingCode
cc=GetNextCode()
;If a file error, return without completing the decode
If cc<0
FreeMemory(lpBUFF)
CloseFile(file)
Debug "file error"
ProcedureReturn #FILE_ERROR
EndIf
;If the code is a clear code, re-initialise all necessary items.
If cc=ClearCode
CurrCodeSize=LZWCodeSize+1
Slot=NewCodes
TopSlot=1 << CurrCodeSize
;Continue reading codes until we get a non-clear code
;(Another unlikely, but possible case...)
While cc=ClearCode
cc=GetNextCode()
Wend
;If we get an ending code immediately after a clear code
;(Yet another unlikely case), then break out of the loop.
If cc=EndingCode ;end
ret=0
If BufCnt<>linewidth ;If there are any left, output the bytes
OutLine(lpBUFF,linewidth-BufCnt-1)
EndIf
CloseFile(file)
FreeMemory(lpBUFF)
;ProcedureReturn hDIB
EndIf
;Finally, if the code is beyond the range of already set codes,
;(This one had better not happen... I have no idea what will
;result from this, but I doubt it will look good...)
;then set it to colour zero.
If cc>=Slot
cc=0
EndIf
OldCode=cc
TempOldCode=OldCode
;And let us not forget to put the char into the buffer. And if,
;on the off chance, we were exactly one pixel from the end of
;the line, we have to send the buffer to the OutLine() routine
*lpBuffPtr\b=cc
*lpBuffPtr+1
BufCnt-1
If BufCnt=0
OutLine(lpBUFF,linewidth)
*lpBuffPtr=lpBUFF
BufCnt=linewidth
EndIf
Else
;In this case, it's not a clear code or an ending code, so it
;must be a code code. So we can now decode the code into a
;stack of character codes (Clear as mud, right?).
code=cc
If code=Slot
code=TempOldCode
*lpSP\b=OldCode
*lpSP+1
EndIf
;Here we scan back along the linked list of prefixes, pushing
;helpless characters (i.e. suffixes) onto the stack as we do so.
While code>=NewCodes
*lpSP\b=suffix(code)
*lpSP+1
code=prefix(code)
Wend
;Push the last character on the stack, and set up the new
;prefix and suffix, and if the required slot number is greater
;than that allowed by the current bit size, increase the bit
;size. (NOTE - if we are all full, we *don't* save the new
;suffix and prefix... I'm not certain if this is correct...
;it might be more proper to overwrite the last code...
*lpSP\b=code
*lpSP+1
If Slot<TopSlot
OldCode=code
suffix(Slot)=OldCode
prefix(Slot)=TempOldCode
Slot+1
TempOldCode=cc
EndIf
If Slot>=TopSlot
If CurrCodeSize<12
TopSlot=TopSlot << 1
CurrCodeSize+1
EndIf
EndIf
;Now that we've pushed the decoded string (in reverse order)
;onto the stack, lets pop it off and put it into our decode
;buffer, and when the decode buffer is full, write another line.
While *lpSP>@stack(0)
*lpSP-1
*lpBuffPtr\b=*lpSP\b
*lpBuffPtr+1
BufCnt-1
If BufCnt=0
OutLine(lpBUFF,linewidth)
*lpBuffPtr=lpBUFF
BufCnt=linewidth
EndIf
Wend
EndIf
Wend
;end
ret=0
If BufCnt<>linewidth ;If there are any left, output the bytes
OutLine(lpBUFF,linewidth-BufCnt-1)
EndIf
*lphDIB=hDIB ;Use a pointer to get info
bhsize=*lphDIB\biSize
ncolors=*lphDIB\biClrUsed
*lpRgbQ=hDIB+bhsize
;Fill in a BITMAPINFOEX structure for CreateDIBitmap_()
CopyMemory(*lphDIB,bie\bmiHeader,SizeOf(BITMAPINFOHEADER))
For count=0 To ncolors-1 ;Fill in a palette
bie\bmiColors[count]\rgbBlue=*lpRgbQ\rgbBlue ;blue
bie\bmiColors[count]\rgbGreen=*lpRgbQ\rgbGreen ;green
bie\bmiColors[count]\rgbRed=*lpRgbQ\rgbRed ;red
*lpRgbQ+4
Next
;Create the DDB bitmap
hdc=GetDC_(#Null)
hBitmap=CreateDIBitmap_(hdc,bie\bmiHeader,#CBM_INIT,hDIB+bhsize+(ncolors*4),bie,#DIB_RGB_COLORS)
PBimage=CreateImage(#PB_Any,realwidth,realheight)
drawdc=StartDrawing(ImageOutput(PBimage))
; For some retarded reason, we have to draw and redraw the GIF frames over the previous image imagenumber-1
DrawImage(imagearray(numberimages-1),0,0)
DrawTransparentImage(drawdc,hBitmap,im\imLeft,im\imTop,im\imWidth,im\imHeight,transcolor)
StopDrawing()
FreeMemory(hDIB) ;Free the DIB
imagearray(numberimages)=ImageID(PBimage)
numberimages=numberimages+1
Wend
ProcedureReturn numberimages
EndProcedure
If OpenWindow(0, 0, 0, 800, 600, "MDIGadget", #PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_SizeGadget|#PB_Window_MaximizeGadget)
If CreateGadgetList(WindowID(0)) And CreateMenu(0, WindowID(0))
MenuTitle("File")
MenuItem(0, "Open GIF")
MenuItem(1, "Exit")
MenuTitle("MDI windows menu")
MDIGadget(0, 0, 0, 0, 0, 1, 2, #PB_MDI_AutoSize)
EndIf
EndIf
Repeat
Select WaitWindowEvent()
Case #PB_Event_Gadget
Select EventGadget()
Case 0
EndSelect
Case #PB_Event_Menu
Select EventMenu()
Case 0
Pattern.s="All Supported Formats|*.gif"
filename.s=OpenFileRequester("Choose An Image File To Open","",Pattern,0)
If filename
Dim myarray(100)
numberGIFs=LoadGIFframes(filename,myarray())
For a=1 To numberGIFs
AddGadgetItem(0,a,"GIF Frame " + Str(a))
CreateGadgetList(WindowID(a))
ImageGadget(a*10,0,0,0,0,0)
SendMessage_(GadgetID(a*10),#STM_SETIMAGE,#IMAGE_BITMAP,myarray(a-1))
Next
;
EndIf
Case 1
End
EndSelect
Case #PB_Event_CloseWindow
End
EndSelect
ForEver
