UPDATED: Load Animated GIF frames

[localmotion34]

Nightmare does not describe the Animated GIF format accurately. Living Hell better describes it. Software developers have abused, hacked, and just plain torn apart GIF.

There are even hacks to make a GIF 24 bit color by including tons of local color palettes that extend the global color palette. This code i THINK addresses all the major hacks and tricks to load all the animated GIF frames. I can't seem to get the simpler images to display the transparent background, but that can be fixed. the MAJOR problem was figuring out how the GIF wanted itself drawn and displayed. you literally sometimes have to draw every previous frame before you render the current frame on the drawing HDC. an animated GIF can be made up of smaller image chunks where only what was changed from the previous frame is included in the current frame.

I have tested this with massive GIFs (200 frames, 5 megs) created from ULEAD Cool 3D, and 3 frame 16 color GIFs too. It can load maybe 170-200 frames/sec with a framesize of 450 x 350.

This code needs to be updated to haqibaba's new GIF decoding procedure that is cleaner than his previous. I didnt want to break with his old code until i was sure the METHOD of parsing the GIf was 100% correct.

Anyone that wants to help out is REALLY appreciated. Let me know of any bugs.

My goal is to store all frames in a structured array, with the hbitmap image, the delay time of the frame, and the transparent background color. Then, the array can be passed to a subclassed static control with a timer set, which could render the current frame with transparent background on the timer change.

Code: Select all

Structure BITMAPINFOEX ;Custom BITMAPINFO struct
  bmiHeader.BITMAPINFOHEADER
  bmiColors.RGBQUAD[256]
EndStructure

Structure ANGIF
  hBitmap.l
  TransparentColor.l
  delaytime.l
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 
  Macro GetBit(Value, bit)
    (Value&(1<<bit))>>bit  ;Translates as 'value' ANDed with 2^bit and shifted back to bitposition 0
  EndMacro
  
  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 &$FF
        disposalmethod= n & (%00111000) >>3
        tflag= GetBit(n,0) ;n& %00000001 
        ;Debug tflag 
        delaytime.w=ReadWord(file)
        Debug delaytime &  $FFFF
        transparent.b=ReadByte(file) & 255
        globtranscolor=GlobalCols(transparent& $FF)
        
      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"
        Debug "text" 
        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
      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
      loctranscolor=localCols(transparent& $FF)
    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
    
    If bImColTable ; if a local color table, then draw previous image in array, and then dray new hbitmap with transparency
      DrawImage(imagearray(numberimages-1),0,0)
      DrawTransparentImage(drawdc,hBitmap,im\imLeft,im\imTop,im\imWidth,im\imHeight,loctranscolor) 
    Else
      If tflag And disposalmethod >1
        DrawImage(imagearray(numberimages-1),0,0)
        DrawTransparentImage(drawdc,hBitmap,im\imLeft,im\imTop,im\imWidth,im\imHeight,globtranscolor)
      Else
        DrawImage(hBitmap,im\imLeft,im\imTop)
        ;DrawTransparentImage(drawdc,hBitmap,im\imLeft,im\imTop,im\imWidth,im\imHeight,GlobalCols(gh\ghBkColIndex))
      EndIf 
    EndIf 
    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(200)
            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

[thefool]

Very interesting code!


http://www.animationer.dk/2/0-9/1hjaelp.gif

that image cannot be loaded.

[localmotion34]

It was a problem with the Text extension block reading, and also a problem with setting the disposal method bits to an unrecognized value. yet ANOTHER example of a developer not sticking to the rules of the format.

[thefool]

yet ANOTHER example of a developer not sticking to the rules of the format.

:/

[localmotion34]

OK, so here it is. I am not very happy with it, but this seems to be the best way to deal with the GIF control. The control uses window properties to store a structure that contains the number of frames, the current rendered frame, and all the bitmaps of the GIF stored in a static array. Currently, I have the maximum number of frames set to 600. I can see no way anyone would need more than 600 frames. I have a GIf created from ULEAD Cool3D that is 12 seconds long, and is 200 frames. it is 5 megs compressed as a GIF. Unless you REALLY want to push your CPU during load time, 600 is plenty.

Comments are welcome, and please report bugs.

Code: Select all

;- Structures

Structure ANGIF
  numberframes.l
  framenumber.l
  hBitmap.l[600]
EndStructure

Structure GIFHEADER ;Header
  ghSig.b[6] ;Signature & Version
  ghWidth.w ;Logical Screen Width
  ghHeight.w ;Logical Screen Height
  ghPkFields.b ;Global Color Table Flag
  ghBkColIndex.b ;Background Color Index
  ghAspRatio.b ;Pixel Aspect Ratio
EndStructure

Structure GIFIMAGE ;Image Descriptor
  imSep.b ;Image Separator
  imLeft.w ;Image Left Position
  imTop.w ;Image Top Position
  imWidth.w ;Image Width
  imHeight.w ;Image Height
  impkFields.b ;Local Color Table Flag
EndStructure

Structure GIFCLASS ;This is instead of using globals
  *lpBytes.Byte ;Pointer to next byte in block
  Pass.l ;First pass for interlaced images in OutLineGIF()
  Line.l ;Offset for addressing the bits in OutLineGIF()
  lpBits.l ;Scanline for bits
  pitch.l ;Bytes are rounded up for image lines
  CurrCodeSize.l ;The current code size
  BitsLeft.l ;Used in NextCodeGIF()
  BytesLeft.l ;Used in NextCodeGIF()
  CurrByte.l ;Current byte
  bUseGlobalColMap.b ;Is the color table global
  GlobColRes.l ;Color Resolution, bits '6' '5' '4'
  bImInterLace.b ;Is the image interlaced
  ImgColRes.l ;Color Resolution
EndStructure

Procedure OutLineGIF(lpPixels.l,LineLen.l,height.l,*cl.GIFCLASS)
  ;Outputs the pixel color index data to the DIB
  ;lpPixels -> Memory block that holds the color index value
  ;LineLen -> Length of the line of pixels
  ;Height -> im\imHeight
  ;Gif images are 2, 16 or 256 colors, poking the values into memory
  ;requires a different method for each case. If gif is interlaced,
  ;that is dealt with here.
  
  Protected ib.l,pixel.l,byte.l,BitCnt.l,CntBk.l,ColRes.l,Bits.l
  
  Bits=*cl\lpBits-(*cl\Line * *cl\pitch) ;Pointer to bits
  
  If *cl\bUseGlobalColMap
    ColRes=*cl\GlobColRes
  Else
    ColRes=*cl\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)
            ib=ib | (1 << CntBk)
          EndIf
          CntBk-1
        Next
        PokeB(Bits+byte,ib)
        byte+1
      Next
      
    Case 4
      byte=0
      For pixel=0 To LineLen-1 Step 2
        ib=((PeekB(lpPixels+pixel) & 255) << 4)
        ib | (PeekB(lpPixels+pixel+1) & 255)
        PokeB(Bits+byte,ib)
        byte+1
      Next
      
    Case 8
      For pixel=0 To LineLen-1
        ib=PeekB(lpPixels+pixel) & 255
        PokeB(Bits+pixel,ib)
      Next
      
  EndSelect
  
  If *cl\bImInterLace ;Set Line for different passes when Interlaced
    
    Select *cl\Pass
      
      Case 0 ;Pass 1
        If *cl\Line<height-8
          *cl\Line+8
        Else
          *cl\Line=4 : *cl\Pass+1 ;Set Line for second pass
        EndIf
        
      Case 1 ;Pass 2
        If *cl\Line<height-8
          *cl\Line+8
        Else
          *cl\Line=2 : *cl\Pass+1 ;Set Line for third pass
        EndIf
        
      Case 2 ;Pass 3
        If *cl\Line<height-4
          *cl\Line+4
        Else
          *cl\Line=1 : *cl\Pass+1 ;Set Line for fourth pass
        EndIf
        
      Case 3 ;Pass 4
        If *cl\Line<height-2
          *cl\Line+2
        EndIf
        
    EndSelect
    
  Else ;When not Interlaced increment Line
    
    *cl\Line+1
    
  EndIf
  
EndProcedure

#PB_LoadGifFIle=$6000

Procedure.l NextCodeGIF(file.l,CharBuff.b(1),CodeMask.l(1),*cl.GIFCLASS)
  ;Reads the next code from the data stream
  ;Returns the LZW CODE or ERROR
  
  Protected count.l,Char.l,ret.l
  
  If *cl\BitsLeft=0 ;Any bits left in byte?
    
    If *cl\BytesLeft<=0 ;If not get another block
      
      *cl\lpBytes=@CharBuff(0) ;Set byte pointer
      *cl\BytesLeft=ReadByte(file) & 255
      
      If *cl\BytesLeft<0
        ProcedureReturn *cl\BytesLeft ;Return if error
      ElseIf *cl\BytesLeft
        For count=0 To *cl\BytesLeft-1
          Char=ReadByte(file) & 255
          If Char<0 : ProcedureReturn Char : EndIf
          CharBuff(count)=Char ;Fill the char buffer with the new block
        Next
      EndIf
      
    EndIf
    
    *cl\CurrByte=*cl\lpBytes\b & 255 ;Get a byte
    *cl\lpBytes+1 ;Increment index pointer
    *cl\BitsLeft=8 ;Set bits left in the byte
    *cl\BytesLeft-1 ;Decrement the bytes left counter
    
  EndIf
  
  ;Shift off any previously used bits
  ret=*cl\CurrByte >> (8-*cl\BitsLeft)
  
  While *cl\CurrCodeSize>*cl\BitsLeft
    
    If *cl\BytesLeft<=0
      
      ;Out of bytes in current block
      *cl\lpBytes=@CharBuff(0) ;Set byte pointer
      *cl\BytesLeft=ReadByte(file) & 255
      
      If *cl\BytesLeft<0
        ProcedureReturn *cl\BytesLeft ;Return if error
      ElseIf *cl\BytesLeft
        For count=0 To *cl\BytesLeft-1
          Char=ReadByte(file) & 255
          If Char<0 : ProcedureReturn Char : EndIf
          CharBuff(count)=Char ;Fill the char buffer with the current block
        Next
      EndIf
      
    EndIf
    
    *cl\CurrByte=*cl\lpBytes\b & 255 ;Get a byte
    *cl\lpBytes+1 ;Increment index pointer
    ret | (*cl\CurrByte << *cl\BitsLeft) ;Add remaining bits to return
    *cl\BitsLeft+8 ;Set bit counter
    *cl\BytesLeft-1 ;Decrement bytesleft counter
    
  Wend
  
  *cl\BitsLeft-*cl\CurrCodeSize ;Subtract the code size from bitsleft
  ret & CodeMask(*cl\CurrCodeSize) ;Mask off the right number of bits
  ProcedureReturn ret
  
EndProcedure

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.l LoadGIFframes(filename.s,imageArray.l(1))
  ;From "loadgif.c" for ImageShop32 by John Findlay
  ;Loads LZW Graphics Interchange Format files
  ;Uses NextCodeGIF() and OutLineGIF()
  
  Protected Dim stack.b(4096) ;Stack for storing pixels
  Protected Dim suffix.b(4096) ;Suffix table, max number of LZW codes
  Protected Dim prefix.l(4096) ;Prefix linked list (these are longs)
  Protected Dim CharBuff.b(279) ;Current block
  Protected Dim GlobalCols.l(256) ;Global colors of gif
  Protected Dim localCols.l(256) ;Local image colors of gif
  Protected Dim CodeMask.l(16) ;Masks for LZW compression algorithm
  Protected gh.GIFHEADER
  Protected im.GIFIMAGE
  Protected cl.GIFCLASS
  Protected bi.BITMAPINFOHEADER
  Protected *pal.RGBQUAD
  Protected *lpSP.Byte ;Pointer to stack
  Protected *lpBuffPtr.Byte ;Pointer to buffer
  Protected bGlobColsSorted.b ;Sort Flag  bit '3' (this is unused)
  Protected file.l,sig.s,PkFields.l,bGlobColTable.b,GlobColBytes.l
  Protected GlobColors.l,count.l,Red.l,Green.l,Blue.l
  Protected width.l,height.l,impkFields.l,bImColsSorted.b
  Protected bImColTable.b,ImgColBytes.l,LZWCodeSize.l,TopSlot.l
  Protected ClearCode.l,ImgColors.l,EndingCode.l,NewCodes.l,Slot.l
  Protected lpBUFF.l,TempOldCode.l,OldCode.l,BufCnt.l,bitcount.l
  Protected ncolors.l,Len.l,hDIB.l,cc.l,code.l
  Protected *dib.BITMAPINFOHEADER
  
  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
  
  ;Open the file
  file=ReadFile(#PB_Any,filename)
  If file=0
    MessageRequester("LOAD ERROR","File could not be opened")
    ProcedureReturn #False
  EndIf
  
  ;Read the file header and logical screen descriptor
  ReadData(file,gh,SizeOf(gh))
  
  sig=PeekS(@gh\ghSig,6) ;Get the header version string
  If sig<>"GIF89a" And sig<>"GIF87a"
    CloseFile(file)
    MessageRequester("LOAD ERROR","Not a valid gif file")
    ProcedureReturn #False ;NOT_VALID
  EndIf
  
  realwidth=gh\ghWidth
  realheight=gh\ghHeight
  
  ;Store gh\ghPkFields for bit manipulation
  PkFields=gh\ghPkFields & 255
  
  ;Global Color Table Flag bit '7'
  bGlobColTable=(PkFields & (1 << 7)) >> 7
  
  If bGlobColTable
    cl\bUseGlobalColMap=#True
    
    GlobColBytes=3*(1 << ((PkFields & $07)+1)) ;Table size in bytes
    GlobColors=GlobColBytes/3 ;Number of colors
    
    ;Some gif encoders do not follow the gif spec very well,
    ;so make cl\GlobColRes from GlobColors.
    ;Also gif's are used on different platforms, which do
    ;have different bits per pixel. i.e. 32 colors is 5 bits/pixel.
    If GlobColors<=2
      cl\GlobColRes=1
    ElseIf GlobColors<=16
      cl\GlobColRes=4
    Else
      cl\GlobColRes=8
    EndIf
    
    For count=0 To GlobColors-1 ;Get the global screen colors
      Red=ReadByte(file) & 255
      Green=ReadByte(file) & 255
      Blue=ReadByte(file) & 255
      GlobalCols(count)=RGB(Red,Green,Blue)
    Next
  EndIf
  
  count=0
  While count<>$2C ;Search for im\imSep
    count=ReadByte(file) & 255
  Wend
  FileSeek(file,Loc(file)-1) ;Seek to im\imSep
  
  ReadData(file,im,SizeOf(im)) ;Read the image descriptor
  
  ;Store im\imPkFields for bit manipulation
  impkFields=im\impkFields & 255
  
  ;Is the image interlaced
  cl\bImInterLace=(impkFields & (1 << 6)) >> 6
  
  ;Is the local color table sorted
  bImColsSorted=(impkFields & (1 << 5)) >> 5
  
  ;Is there a local color table
  bImColTable=(impkFields & (1 << 7)) >> 7
  
  If bImColTable
    cl\bUseGlobalColMap=#False
    
    ImgColBytes=3*(1 << ((impkFields & $07)+1)) ;Table size in bytes
    ImgColors=ImgColBytes/3 ;Number of colors
    
    If ImgColors<=2 ;Make sure image bit depth is 1, 4 or 8
      cl\ImgColRes=1
    ElseIf ImgColors<=16
      cl\ImgColRes=4
    Else
      cl\ImgColRes=8
    EndIf
    
    For count=0 To ImgColors-1 ;Get the local image colors
      Red=ReadByte(file) & 255
      Green=ReadByte(file) & 255
      Blue=ReadByte(file) & 255
      localCols(count)=RGB(Red,Green,Blue)
    Next
  Else ;No local color table
    If cl\bUseGlobalColMap=#False ;No global color table
      CloseFile(file)
      MessageRequester("LOAD ERROR","No color table")
      ProcedureReturn #False ;NO_COLORTABLE
    EndIf
  EndIf
  
  width=im\imWidth & $FFFF ;Image width
  height=im\imHeight & $FFFF ;Image height
  
  ;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 color resolution.
  ;i.e. 8 for 256 colors
  If LZWCodeSize<2 Or LZWCodeSize>8
    CloseFile(file)
    MessageRequester("LOAD ERROR","LZW code size is not valid")
    ProcedureReturn #False ;BAD_CODE_SIZE
  EndIf
  
  ;Initialise the variables for the decoder for reading a new image.
  cl\CurrCodeSize=LZWCodeSize+1
  TopSlot=1 << cl\CurrCodeSize ;Highest code for current size
  ClearCode=1 << LZWCodeSize ;Value for a clear code
  EndingCode=ClearCode+1 ;Value for an ending code
  NewCodes=ClearCode+2 ;First available code
  Slot=NewCodes ;Last read code
  cl\BitsLeft=0
  cl\BytesLeft=0
  
  ;Just in case...
  TempOldCode=0 : OldCode=0
  
  ;Allocate space for the decode buffer
  lpBUFF=AllocateMemory(width+8) ;+8 just in case
  
  ;Set up the stack pointer, decode buffer pointer and line counter
  *lpSP=@stack(0)
  *lpBuffPtr=lpBUFF
  BufCnt=width ;Count for pixel line length
  
  ;Start creating the DIB
  If cl\bUseGlobalColMap ;Global color table
    bitcount=cl\GlobColRes
  Else ;Local color table
    bitcount=cl\ImgColRes
  EndIf
  
  bi\biSize=SizeOf(bi)
  bi\biWidth=width
  bi\biHeight=height
  bi\biPlanes=1
  bi\biBitCount=bitcount ;BitCount will be 1, 4 or 8
  bi\biCompression=#BI_RGB
  bi\biSizeImage=0
  bi\biXPelsPerMeter=0
  bi\biYPelsPerMeter=0
  If cl\bUseGlobalColMap ;Global color table
    bi\biClrUsed=GlobColors
  Else ;Local color table
    bi\biClrUsed=ImgColors
  EndIf
  bi\biClrImportant=0
  
  ;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 bi\biClrUsed<>0
    ncolors=bi\biClrUsed
  Else ;We don't have an optimal palette
    ncolors=1 << bi\biBitCount
  EndIf
  
  cl\pitch=(((bitcount*width)+31) >> 5) << 2 ;Bytes per line
  Len=bi\biSize+(ncolors*4)+(cl\pitch*height) ;Size of DIB
  
  bi\biSizeImage=cl\pitch*height ;Fill in biSizeImage
  
  ;Allocate memory block to store our DIB
  hDIB=AllocateMemory(Len)
  If hDIB=0
    FreeMemory(lpBUFF)
    ;CloseFile(file)
    MessageRequester("LOAD ERROR","Memory allocation failed")
    ProcedureReturn #False ;NO_DIB
  EndIf
  
  ;Fill first part of DIB with the BITMAPINFOHEADER
  CopyMemory(bi,hDIB,SizeOf(bi))
  
  ;Set the colors in the DIB (or masks for the new DIB formats)
  *pal=hDIB+SizeOf(bi)
  If cl\bUseGlobalColMap
    For count=0 To bi\biClrUsed-1
      *pal\rgbBlue=Blue(GlobalCols(count))
      *pal\rgbGreen=Green(GlobalCols(count))
      *pal\rgbRed=Red(GlobalCols(count))
      *pal+4
    Next
  Else
    For count=0 To bi\biClrUsed-1
      *pal\rgbBlue=Blue(localCols(count))
      *pal\rgbGreen=Green(localCols(count))
      *pal\rgbRed=Red(localCols(count))
      *pal+4
    Next
  EndIf
  
  cl\Line=0 ;Set address offset for OutLineGIF()
  cl\Pass=0 ;For interlaced images in OutLineGIF()
  
  ;Image data bits of DIB
  cl\lpBits=hDIB+bi\biSize+(ncolors*4)+(cl\pitch*(height-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=NextCodeGIF(file,CharBuff(),CodeMask(),cl)
    
    If cc<0 ;If a file error, return without completing the decode
      FreeMemory(lpBUFF)
      ;CloseFile(file)
      MessageRequester("LOAD ERROR","Not a valid LZW code")
      ProcedureReturn #False ;FILE_ERROR
    EndIf
    
    ;If the code is a clear code, re-initialise all necessary items.
    If cc=ClearCode
      
      cl\CurrCodeSize=LZWCodeSize+1
      Slot=NewCodes
      TopSlot=1 << cl\CurrCodeSize
      
      ;Continue reading codes until we get a non-clear code
      ;(another unlikely, but possible case...)
      While cc=ClearCode
        cc=NextCodeGIF(file,CharBuff(),CodeMask(),cl)
      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
        Break ;end loop
      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 color 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 OutLineGIF() routine
      *lpBuffPtr\b=cc
      *lpBuffPtr+1
      BufCnt-1
      
      If BufCnt=0
        OutLineGIF(lpBUFF,width,height,cl)
        *lpBuffPtr=lpBUFF
        BufCnt=width
      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 cl\CurrCodeSize<12
          TopSlot=TopSlot << 1
          cl\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
          OutLineGIF(lpBUFF,width,height,cl)
          *lpBuffPtr=lpBUFF
          BufCnt=width
        EndIf
      Wend
      
    EndIf
  Wend
  
  If BufCnt<>width ;If there are any left, output the bytes
    OutLineGIF(lpBUFF,width-BufCnt-1,height,cl)
  EndIf
  *dib=hDIB
  If *dib=0 ;Avoid errors
    ProcedureReturn #False
  EndIf
  
  Bits=*dib+*dib\biSize+(*dib\biClrUsed*4) ;Pointer to bits
  
  ;Create the DDB bitmap
  hdc=GetDC_(#Null)
  hBitmap=CreateDIBitmap_(hdc,*dib,#CBM_INIT,Bits,*dib,#DIB_RGB_COLORS)
  FreeMemory(hDIB)
  imageArray(0)=hBitmap 
  numberimages=1
  
  ;- continue to other frames
  Macro GetBit(Value, bit)
    (Value&(1<<bit))>>bit  ;Translates as 'value' ANDed with 2^bit and shifted back to bitposition 0
  EndMacro
  
  ; Read through the various image blocks
  NotatEnd=1
  While NotatEnd=1
    While n<>$2C 
      n=ReadByte(file) & 255
      If n=$3B
        NotatEnd=0
        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 &$FF
        ;Debug Bin(n&$FF)
        disposalmethod= (n & %00011100) >>2 
        ;Debug disposalmethod
        tflag= GetBit(n,0) ;n& %00000001 
        ;Debug tflag 
        delaytime.w=ReadWord(file)
        
        ;Debug delaytime &  $FFFF
        transparent.b=ReadByte(file) 
        globtranscolor=GlobalCols(transparent& $FF)
      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"
        Debug "text" 
        ; n=ReadByte(file) & 255
        ;FileSeek(file,Loc(file)+n& $FF)
      ElseIf n =$21
        ;"A Extension_block
      EndIf 
    Wend
    n=0
    
    ; done with reading the image blocks for this frame
  FileSeek(file,Loc(file)-1)
  count=0
  While count<>$2C ;Search for im\imSep
    count=ReadByte(file) & 255
  Wend
  FileSeek(file,Loc(file)-1) ;Seek to im\imSep
  
  ReadData(file,im,SizeOf(im)) ;Read the image descriptor
  
  ;Store im\imPkFields for bit manipulation
  impkFields=im\impkFields & 255
  
  ;Is the image interlaced
  cl\bImInterLace=(impkFields & (1 << 6)) >> 6
  
  ;Is the local color table sorted
  bImColsSorted=(impkFields & (1 << 5)) >> 5
  
  ;Is there a local color table
  bImColTable=(impkFields & (1 << 7)) >> 7
  
  If bImColTable
    cl\bUseGlobalColMap=#False
    
    ImgColBytes=3*(1 << ((impkFields & $07)+1)) ;Table size in bytes
    ImgColors=ImgColBytes/3 ;Number of colors
    
    If ImgColors<=2 ;Make sure image bit depth is 1, 4 or 8
      cl\ImgColRes=1
    ElseIf ImgColors<=16
      cl\ImgColRes=4
    Else
      cl\ImgColRes=8
    EndIf
    
    For count=0 To ImgColors-1 ;Get the local image colors
      Red=ReadByte(file) & 255
      Green=ReadByte(file) & 255
      Blue=ReadByte(file) & 255
      localCols(count)=RGB(Red,Green,Blue)
    Next
    loctranscolor=localCols(transparent& $FF)
  Else ;No local color table
    If cl\bUseGlobalColMap=#False ;No global color table
      CloseFile(file)
      MessageRequester("LOAD ERROR","No color table")
      ProcedureReturn #False ;NO_COLORTABLE
    EndIf
  EndIf
  
  width=im\imWidth & $FFFF ;Image width
  height=im\imHeight & $FFFF ;Image height
  
  ;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 color resolution.
  ;i.e. 8 for 256 colors
  If LZWCodeSize<2 Or LZWCodeSize>8
    CloseFile(file)
    MessageRequester("LOAD ERROR","LZW code size is not valid")
    ProcedureReturn #False ;BAD_CODE_SIZE
  EndIf
  
  ;Initialise the variables for the decoder for reading a new image.
  cl\CurrCodeSize=LZWCodeSize+1
  TopSlot=1 << cl\CurrCodeSize ;Highest code for current size
  ClearCode=1 << LZWCodeSize ;Value for a clear code
  EndingCode=ClearCode+1 ;Value for an ending code
  NewCodes=ClearCode+2 ;First available code
  Slot=NewCodes ;Last read code
  cl\BitsLeft=0
  cl\BytesLeft=0
  
  ;Just in case...
  TempOldCode=0 : OldCode=0
  
  ;Allocate space for the decode buffer
  lpBUFF=AllocateMemory(width+8) ;+8 just in case
  
  ;Set up the stack pointer, decode buffer pointer and line counter
  *lpSP=@stack(0)
  *lpBuffPtr=lpBUFF
  BufCnt=width ;Count for pixel line length
  
  ;Start creating the DIB
  If cl\bUseGlobalColMap ;Global color table
    bitcount=cl\GlobColRes
  Else ;Local color table
    bitcount=cl\ImgColRes
  EndIf
  
  bi\biSize=SizeOf(bi)
  bi\biWidth=width
  bi\biHeight=height
  bi\biPlanes=1
  bi\biBitCount=bitcount ;BitCount will be 1, 4 or 8
  bi\biCompression=#BI_RGB
  bi\biSizeImage=0
  bi\biXPelsPerMeter=0
  bi\biYPelsPerMeter=0
  If cl\bUseGlobalColMap ;Global color table
    bi\biClrUsed=GlobColors
  Else ;Local color table
    bi\biClrUsed=ImgColors
  EndIf
  bi\biClrImportant=0
  
  ;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 bi\biClrUsed<>0
    ncolors=bi\biClrUsed
  Else ;We don't have an optimal palette
    ncolors=1 << bi\biBitCount
  EndIf
  
  cl\pitch=(((bitcount*width)+31) >> 5) << 2 ;Bytes per line
  Len=bi\biSize+(ncolors*4)+(cl\pitch*height) ;Size of DIB
  
  bi\biSizeImage=cl\pitch*height ;Fill in biSizeImage
  
  ;Allocate memory block to store our DIB
  hDIB=AllocateMemory(Len)
  If hDIB=0
    FreeMemory(lpBUFF)
    CloseFile(file)
    MessageRequester("LOAD ERROR","Memory allocation failed")
    ProcedureReturn #False ;NO_DIB
  EndIf
  
  ;Fill first part of DIB with the BITMAPINFOHEADER
  CopyMemory(bi,hDIB,SizeOf(bi))
  
  ;Set the colors in the DIB (or masks for the new DIB formats)
  *pal=hDIB+SizeOf(bi)
  If cl\bUseGlobalColMap
    For count=0 To bi\biClrUsed-1
      *pal\rgbBlue=Blue(GlobalCols(count))
      *pal\rgbGreen=Green(GlobalCols(count))
      *pal\rgbRed=Red(GlobalCols(count))
      *pal+4
    Next
  Else
    For count=0 To bi\biClrUsed-1
      *pal\rgbBlue=Blue(localCols(count))
      *pal\rgbGreen=Green(localCols(count))
      *pal\rgbRed=Red(localCols(count))
      *pal+4
    Next
  EndIf
  
  cl\Line=0 ;Set address offset for OutLineGIF()
  cl\Pass=0 ;For interlaced images in OutLineGIF()
  
  ;Image data bits of DIB
  cl\lpBits=hDIB+bi\biSize+(ncolors*4)+(cl\pitch*(height-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.
  cc=0 
  
  While cc<>EndingCode
    
    cc=NextCodeGIF(file,CharBuff(),CodeMask(),cl)
    
    If cc<0 ;If a file error, return without completing the decode
      FreeMemory(lpBUFF)
      CloseFile(file)
      MessageRequester("LOAD ERROR","Not a valid LZW code")
      ProcedureReturn #False ;FILE_ERROR
    EndIf
    
    ;If the code is a clear code, re-initialise all necessary items.
    If cc=ClearCode
      
      cl\CurrCodeSize=LZWCodeSize+1
      Slot=NewCodes
      TopSlot=1 << cl\CurrCodeSize
      
      ;Continue reading codes until we get a non-clear code
      ;(another unlikely, but possible case...)
      While cc=ClearCode
        cc=NextCodeGIF(file,CharBuff(),CodeMask(),cl)
      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
        Break ;end loop
      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 color 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 OutLineGIF() routine
      *lpBuffPtr\b=cc
      *lpBuffPtr+1
      BufCnt-1
      
      If BufCnt=0
        OutLineGIF(lpBUFF,width,height,cl)
        *lpBuffPtr=lpBUFF
        BufCnt=width
      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 cl\CurrCodeSize<12
          TopSlot=TopSlot << 1
          cl\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
          OutLineGIF(lpBUFF,width,height,cl)
          *lpBuffPtr=lpBUFF
          BufCnt=width
        EndIf
      Wend
      
    EndIf
    
  Wend
  
  If BufCnt<>width ;If there are any left, output the bytes
    OutLineGIF(lpBUFF,width-BufCnt-1,height,cl)
  EndIf
  
  ;Create the DDB bitmap
  *dib=hDIB
  If *dib=0 ;Avoid errors
    ProcedureReturn #False
  EndIf
  
  Bits=*dib+*dib\biSize+(*dib\biClrUsed*4) ;Pointer to bits
  
  ;- create the bitmap 
  ;Create the DDB bitmap
  hdc=GetDC_(#Null)
  hBitmap=CreateDIBitmap_(hdc,*dib,#CBM_INIT,Bits,*dib,#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
  
  If bImColTable ; if a local color table, then draw previous image in array, and then dray new hbitmap with transparency
    DrawImage(imageArray(numberimages-1),0,0)
    DrawTransparentImage(drawdc,hBitmap,im\imLeft,im\imTop,im\imWidth,im\imHeight,loctranscolor) 
  Else
    If tflag And disposalmethod <=1
      DrawImage(imageArray(numberimages-1),0,0)
      DrawTransparentImage(drawdc,hBitmap,im\imLeft,im\imTop,im\imWidth,im\imHeight,globtranscolor)
    Else
      DrawImage(imageArray(numberimages-1),0,0)
      DrawImage(hBitmap,im\imLeft,im\imTop)
    EndIf 
  EndIf 
  StopDrawing()
  FreeMemory(hDIB) ;Free the DIB
  imageArray(numberimages)=ImageID(pbimage)
  numberimages=numberimages+1
Wend 
ProcedureReturn numberimages 
EndProcedure


;Procedure TimerProc(hwnd,
Procedure GIFTimerProc(hwnd,msg,wParam,lParam)
  Select msg
    Case #PB_LoadGifFIle
      *GIFframe.ANGIF=GetProp_(hwnd,"frameinfo") 
      If *GIFframe
        For d=0 To *GIFframe\numberframes-1
          DeleteObject_(*GIFframe\hBitmap[d])
        Next
        FreeMemory(*GIFframe)
      EndIf
      *frame.ANGIF=AllocateMemory(SizeOf(ANGIF))
      Dim GIFarray.l(600)
      string.s=PeekS(lParam)
      numberframes=LoadGIFframes(string.s,GIFarray())
      Redim GIFarray.l(numberframes-1)
      SendMessage_(hwnd,#STM_SETIMAGE,#IMAGE_BITMAP,GIFarray(0))
      settimer_(hwnd,200,100,0)
      *frame\numberframes=numberframes
      *frame\framenumber=0
      For a=0 To numberframes-1
        *frame\hBitmap[a]=GIFarray(a)
      Next 
      setprop_(hwnd,"frameinfo",*frame.ANGIF)
      
    Case #WM_TIMER
      *GIFframe.ANGIF=GetProp_(hwnd,"frameinfo") ; get the image array pointer
      framenumber=*GIFframe\framenumber ; get the frame index
      killtimer_(hwnd,200) ; stop the timer
      *GIFframe\framenumber=*GIFframe\framenumber+1; increase the frame count
      If *GIFframe\framenumber=*GIFframe\numberframes
        *GIFframe\framenumber=0
      EndIf
      hBitmap=*GIFframe\hBitmap[framenumber] ; get the bitmap
      ;delaytime=PeekW(*ptr+(frame*SizeOf(ANGIF))+4) ; get the delaytime
      SendMessage_(hwnd,#STM_SETIMAGE,#IMAGE_BITMAP,hBitmap); set the new bitmap
      
      settimer_(hwnd,200,100,0) ; set the new timer
      setprop_(hwnd,"frameinfo",*GIFframe.ANGIF); reset the window props
      ;FreeMemory(*GIFframe)
  EndSelect 
  ProcedureReturn CallWindowProc_(GetProp_(hwnd,"oldproc"),hwnd,msg,wParam,lParam)
EndProcedure

Procedure GifStaticControl(id.l,x.l,y.l,width.l,height.l)
  StaticCtl=ImageGadget(id,x.l,y.l,width.l,height,0)
  If id=#PB_Any
    PBreturn=StaticCtl
    hwnd=GadgetID(StaticCtl)
  Else
    PBreturn=GadgetID(id)
    hwnd=GadgetID(id)
  EndIf
  setprop_(hwnd,"oldproc",SetWindowLong_(hwnd,#GWL_WNDPROC,@GIFTimerProc())) ; subclass
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)
    GifStaticControl(50,100,100,200,200)
  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
            SendMessage_(GadgetID(50),#PB_LoadGifFIle,0,filename)
            ;Dim myarray(800)
            ;numberGIFs=LoadGIFframes(filename,myarray())
            ; UseGadgetList(WindowID(0))
            ; GifStaticControl(50,100,100,200,200,myarray.ANGIF())
            ; 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

[Kwai chang caine]

Hello Localmotion34.
What a great job

But, i have an error at the line 84 with some GIF.
Not all, but this, for example :



I don't know if this is normal :roll:
I post so you know

[Rook Zimbabwe]

Fantastic job!

I used to use the LoadAnimatedSprite command in B3D, I used it for an on screen way to print letters and create HUD displays etc.

I have been of the opinion that PB needed this for a long time.

[deano1987]

This didnt load Animated GIF files correctly or set transparency... So I have been working hard to fix all the problems in the script and get it to load GIF images correctly, my script can now load 99% of GIF files correctly with the further 1% being just minimal display problems...

I'm hoping to release the code soon, it's taken me a huge amount of time so I hope everyone will appreciate my efforts

[Niffo]

Hello,

Hope you will release it soon, i am very interested.

[netmaestro]

I'm hoping to release the code soon, it's taken me a huge amount of time so I hope everyone will appreciate my efforts

Very good news, I'm looking forward to it! And rest assured, if it's solid code that "pretty much just works" - there will be no shortage of appreciation, believe me Thanks for your efforts and moreover, your willingness to share your code. That, to me, is the lifeblood of these forums.

[kvitaliy]

Comments are welcome, and please report bugs.

Code: Select all

Procedure.l NextCodeGIF(file.l,CharBuff.b(1),CodeMask.l(1),*cl.GIFCLASS)

Syntax error in the procedure arguments

[Niffo]

Yes the syntax has changed in the latest versions of PB http://www.purebasic.com/documentation/ ... e/dim.html

[deano1987]

Comments are welcome, and please report bugs.

Code: Select all

Procedure.l NextCodeGIF(file.l,CharBuff.b(1),CodeMask.l(1),*cl.GIFCLASS)

Syntax error in the procedure arguments

I've fixed this for PB 4.3... will release soon

[Niffo]

Some news, deano1987 ?

[Divide By Zero]

All that needed to be done was to add the 'Array' keyword. Running fine on PB4.51 with just those changes.

From the manual

"Arrays can be passed as parameters using the Array keyword, linked lists using the List keyword and maps using the Map keyword."

Hope that helps

Code: Select all

;- Structures

Structure ANGIF
  numberframes.l
  framenumber.l
  hBitmap.l[600]
EndStructure

Structure GIFHEADER ;Header
  ghSig.b[6] ;Signature & Version
  ghWidth.w ;Logical Screen Width
  ghHeight.w ;Logical Screen Height
  ghPkFields.b ;Global Color Table Flag
  ghBkColIndex.b ;Background Color Index
  ghAspRatio.b ;Pixel Aspect Ratio
EndStructure

Structure GIFIMAGE ;Image Descriptor
  imSep.b ;Image Separator
  imLeft.w ;Image Left Position
  imTop.w ;Image Top Position
  imWidth.w ;Image Width
  imHeight.w ;Image Height
  impkFields.b ;Local Color Table Flag
EndStructure

Structure GIFCLASS ;This is instead of using globals
  *lpBytes.Byte ;Pointer to next byte in block
  Pass.l ;First pass for interlaced images in OutLineGIF()
  Line.l ;Offset for addressing the bits in OutLineGIF()
  lpBits.l ;Scanline for bits
  pitch.l ;Bytes are rounded up for image lines
  CurrCodeSize.l ;The current code size
  BitsLeft.l ;Used in NextCodeGIF()
  BytesLeft.l ;Used in NextCodeGIF()
  CurrByte.l ;Current byte
  bUseGlobalColMap.b ;Is the color table global
  GlobColRes.l ;Color Resolution, bits '6' '5' '4'
  bImInterLace.b ;Is the image interlaced
  ImgColRes.l ;Color Resolution
EndStructure

Procedure OutLineGIF(lpPixels.l,LineLen.l,height.l,*cl.GIFCLASS)
  ;Outputs the pixel color index data to the DIB
  ;lpPixels -> Memory block that holds the color index value
  ;LineLen -> Length of the line of pixels
  ;Height -> im\imHeight
  ;Gif images are 2, 16 or 256 colors, poking the values into memory
  ;requires a different method for each case. If gif is interlaced,
  ;that is dealt with here.
  
  Protected ib.l,pixel.l,byte.l,BitCnt.l,CntBk.l,ColRes.l,Bits.l
  
  Bits=*cl\lpBits-(*cl\Line * *cl\pitch) ;Pointer to bits
  
  If *cl\bUseGlobalColMap
    ColRes=*cl\GlobColRes
  Else
    ColRes=*cl\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)
            ib=ib | (1 << CntBk)
          EndIf
          CntBk-1
        Next
        PokeB(Bits+byte,ib)
        byte+1
      Next
      
    Case 4
      byte=0
      For pixel=0 To LineLen-1 Step 2
        ib=((PeekB(lpPixels+pixel) & 255) << 4)
        ib | (PeekB(lpPixels+pixel+1) & 255)
        PokeB(Bits+byte,ib)
        byte+1
      Next
      
    Case 8
      For pixel=0 To LineLen-1
        ib=PeekB(lpPixels+pixel) & 255
        PokeB(Bits+pixel,ib)
      Next
      
  EndSelect
  
  If *cl\bImInterLace ;Set Line for different passes when Interlaced
    
    Select *cl\Pass
      
      Case 0 ;Pass 1
        If *cl\Line<height-8
          *cl\Line+8
        Else
          *cl\Line=4 : *cl\Pass+1 ;Set Line for second pass
        EndIf
        
      Case 1 ;Pass 2
        If *cl\Line<height-8
          *cl\Line+8
        Else
          *cl\Line=2 : *cl\Pass+1 ;Set Line for third pass
        EndIf
        
      Case 2 ;Pass 3
        If *cl\Line<height-4
          *cl\Line+4
        Else
          *cl\Line=1 : *cl\Pass+1 ;Set Line for fourth pass
        EndIf
        
      Case 3 ;Pass 4
        If *cl\Line<height-2
          *cl\Line+2
        EndIf
        
    EndSelect
    
  Else ;When not Interlaced increment Line
    
    *cl\Line+1
    
  EndIf
  
EndProcedure

#PB_LoadGifFIle=$6000

Procedure.l NextCodeGIF(file.l,Array CharBuff.b(1),Array CodeMask.l(1),*cl.GIFCLASS)
  ;Reads the next code from the data stream
  ;Returns the LZW CODE or ERROR
  
  Protected count.l,Char.l,ret.l
  
  If *cl\BitsLeft=0 ;Any bits left in byte?
    
    If *cl\BytesLeft<=0 ;If not get another block
      
      *cl\lpBytes=@CharBuff(0) ;Set byte pointer
      *cl\BytesLeft=ReadByte(file) & 255
      
      If *cl\BytesLeft<0
        ProcedureReturn *cl\BytesLeft ;Return if error
      ElseIf *cl\BytesLeft
        For count=0 To *cl\BytesLeft-1
          Char=ReadByte(file) & 255
          If Char<0 : ProcedureReturn Char : EndIf
          CharBuff(count)=Char ;Fill the char buffer with the new block
        Next
      EndIf
      
    EndIf
    
    *cl\CurrByte=*cl\lpBytes\b & 255 ;Get a byte
    *cl\lpBytes+1 ;Increment index pointer
    *cl\BitsLeft=8 ;Set bits left in the byte
    *cl\BytesLeft-1 ;Decrement the bytes left counter
    
  EndIf
  
  ;Shift off any previously used bits
  ret=*cl\CurrByte >> (8-*cl\BitsLeft)
  
  While *cl\CurrCodeSize>*cl\BitsLeft
    
    If *cl\BytesLeft<=0
      
      ;Out of bytes in current block
      *cl\lpBytes=@CharBuff(0) ;Set byte pointer
      *cl\BytesLeft=ReadByte(file) & 255
      
      If *cl\BytesLeft<0
        ProcedureReturn *cl\BytesLeft ;Return if error
      ElseIf *cl\BytesLeft
        For count=0 To *cl\BytesLeft-1
          Char=ReadByte(file) & 255
          If Char<0 : ProcedureReturn Char : EndIf
          CharBuff(count)=Char ;Fill the char buffer with the current block
        Next
      EndIf
      
    EndIf
    
    *cl\CurrByte=*cl\lpBytes\b & 255 ;Get a byte
    *cl\lpBytes+1 ;Increment index pointer
    ret | (*cl\CurrByte << *cl\BitsLeft) ;Add remaining bits to return
    *cl\BitsLeft+8 ;Set bit counter
    *cl\BytesLeft-1 ;Decrement bytesleft counter
    
  Wend
  
  *cl\BitsLeft-*cl\CurrCodeSize ;Subtract the code size from bitsleft
  ret & CodeMask(*cl\CurrCodeSize) ;Mask off the right number of bits
  ProcedureReturn ret
  
EndProcedure

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.l LoadGIFframes(filename.s,Array imageArray.l(1))
  ;From "loadgif.c" for ImageShop32 by John Findlay
  ;Loads LZW Graphics Interchange Format files
  ;Uses NextCodeGIF() and OutLineGIF()
  
  Protected Dim stack.b(4096) ;Stack for storing pixels
  Protected Dim suffix.b(4096) ;Suffix table, max number of LZW codes
  Protected Dim prefix.l(4096) ;Prefix linked list (these are longs)
  Protected Dim CharBuff.b(279) ;Current block
  Protected Dim GlobalCols.l(256) ;Global colors of gif
  Protected Dim localCols.l(256) ;Local image colors of gif
  Protected Dim CodeMask.l(16) ;Masks for LZW compression algorithm
  Protected gh.GIFHEADER
  Protected im.GIFIMAGE
  Protected cl.GIFCLASS
  Protected bi.BITMAPINFOHEADER
  Protected *pal.RGBQUAD
  Protected *lpSP.Byte ;Pointer to stack
  Protected *lpBuffPtr.Byte ;Pointer to buffer
  Protected bGlobColsSorted.b ;Sort Flag  bit '3' (this is unused)
  Protected file.l,sig.s,PkFields.l,bGlobColTable.b,GlobColBytes.l
  Protected GlobColors.l,count.l,Red.l,Green.l,Blue.l
  Protected width.l,height.l,impkFields.l,bImColsSorted.b
  Protected bImColTable.b,ImgColBytes.l,LZWCodeSize.l,TopSlot.l
  Protected ClearCode.l,ImgColors.l,EndingCode.l,NewCodes.l,Slot.l
  Protected lpBUFF.l,TempOldCode.l,OldCode.l,BufCnt.l,bitcount.l
  Protected ncolors.l,Len.l,hDIB.l,cc.l,code.l
  Protected *dib.BITMAPINFOHEADER
  
  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
  
  ;Open the file
  file=ReadFile(#PB_Any,filename)
  If file=0
    MessageRequester("LOAD ERROR","File could not be opened")
    ProcedureReturn #False
  EndIf
  
  ;Read the file header and logical screen descriptor
  ReadData(file,gh,SizeOf(gh))
  
  sig=PeekS(@gh\ghSig,6) ;Get the header version string
  If sig<>"GIF89a" And sig<>"GIF87a"
    CloseFile(file)
    MessageRequester("LOAD ERROR","Not a valid gif file")
    ProcedureReturn #False ;NOT_VALID
  EndIf
  
  realwidth=gh\ghWidth
  realheight=gh\ghHeight
  
  ;Store gh\ghPkFields for bit manipulation
  PkFields=gh\ghPkFields & 255
  
  ;Global Color Table Flag bit '7'
  bGlobColTable=(PkFields & (1 << 7)) >> 7
  
  If bGlobColTable
    cl\bUseGlobalColMap=#True
    
    GlobColBytes=3*(1 << ((PkFields & $07)+1)) ;Table size in bytes
    GlobColors=GlobColBytes/3 ;Number of colors
    
    ;Some gif encoders do not follow the gif spec very well,
    ;so make cl\GlobColRes from GlobColors.
    ;Also gif's are used on different platforms, which do
    ;have different bits per pixel. i.e. 32 colors is 5 bits/pixel.
    If GlobColors<=2
      cl\GlobColRes=1
    ElseIf GlobColors<=16
      cl\GlobColRes=4
    Else
      cl\GlobColRes=8
    EndIf
    
    For count=0 To GlobColors-1 ;Get the global screen colors
      Red=ReadByte(file) & 255
      Green=ReadByte(file) & 255
      Blue=ReadByte(file) & 255
      GlobalCols(count)=RGB(Red,Green,Blue)
    Next
  EndIf
  
  count=0
  While count<>$2C ;Search for im\imSep
    count=ReadByte(file) & 255
  Wend
  FileSeek(file,Loc(file)-1) ;Seek to im\imSep
  
  ReadData(file,im,SizeOf(im)) ;Read the image descriptor
  
  ;Store im\imPkFields for bit manipulation
  impkFields=im\impkFields & 255
  
  ;Is the image interlaced
  cl\bImInterLace=(impkFields & (1 << 6)) >> 6
  
  ;Is the local color table sorted
  bImColsSorted=(impkFields & (1 << 5)) >> 5
  
  ;Is there a local color table
  bImColTable=(impkFields & (1 << 7)) >> 7
  
  If bImColTable
    cl\bUseGlobalColMap=#False
    
    ImgColBytes=3*(1 << ((impkFields & $07)+1)) ;Table size in bytes
    ImgColors=ImgColBytes/3 ;Number of colors
    
    If ImgColors<=2 ;Make sure image bit depth is 1, 4 or 8
      cl\ImgColRes=1
    ElseIf ImgColors<=16
      cl\ImgColRes=4
    Else
      cl\ImgColRes=8
    EndIf
    
    For count=0 To ImgColors-1 ;Get the local image colors
      Red=ReadByte(file) & 255
      Green=ReadByte(file) & 255
      Blue=ReadByte(file) & 255
      localCols(count)=RGB(Red,Green,Blue)
    Next
  Else ;No local color table
    If cl\bUseGlobalColMap=#False ;No global color table
      CloseFile(file)
      MessageRequester("LOAD ERROR","No color table")
      ProcedureReturn #False ;NO_COLORTABLE
    EndIf
  EndIf
  
  width=im\imWidth & $FFFF ;Image width
  height=im\imHeight & $FFFF ;Image height
  
  ;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 color resolution.
  ;i.e. 8 for 256 colors
  If LZWCodeSize<2 Or LZWCodeSize>8
    CloseFile(file)
    MessageRequester("LOAD ERROR","LZW code size is not valid")
    ProcedureReturn #False ;BAD_CODE_SIZE
  EndIf
  
  ;Initialise the variables for the decoder for reading a new image.
  cl\CurrCodeSize=LZWCodeSize+1
  TopSlot=1 << cl\CurrCodeSize ;Highest code for current size
  ClearCode=1 << LZWCodeSize ;Value for a clear code
  EndingCode=ClearCode+1 ;Value for an ending code
  NewCodes=ClearCode+2 ;First available code
  Slot=NewCodes ;Last read code
  cl\BitsLeft=0
  cl\BytesLeft=0
  
  ;Just in case...
  TempOldCode=0 : OldCode=0
  
  ;Allocate space for the decode buffer
  lpBUFF=AllocateMemory(width+8) ;+8 just in case
  
  ;Set up the stack pointer, decode buffer pointer and line counter
  *lpSP=@stack(0)
  *lpBuffPtr=lpBUFF
  BufCnt=width ;Count for pixel line length
  
  ;Start creating the DIB
  If cl\bUseGlobalColMap ;Global color table
    bitcount=cl\GlobColRes
  Else ;Local color table
    bitcount=cl\ImgColRes
  EndIf
  
  bi\biSize=SizeOf(bi)
  bi\biWidth=width
  bi\biHeight=height
  bi\biPlanes=1
  bi\biBitCount=bitcount ;BitCount will be 1, 4 or 8
  bi\biCompression=#BI_RGB
  bi\biSizeImage=0
  bi\biXPelsPerMeter=0
  bi\biYPelsPerMeter=0
  If cl\bUseGlobalColMap ;Global color table
    bi\biClrUsed=GlobColors
  Else ;Local color table
    bi\biClrUsed=ImgColors
  EndIf
  bi\biClrImportant=0
  
  ;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 bi\biClrUsed<>0
    ncolors=bi\biClrUsed
  Else ;We don't have an optimal palette
    ncolors=1 << bi\biBitCount
  EndIf
  
  cl\pitch=(((bitcount*width)+31) >> 5) << 2 ;Bytes per line
  Len=bi\biSize+(ncolors*4)+(cl\pitch*height) ;Size of DIB
  
  bi\biSizeImage=cl\pitch*height ;Fill in biSizeImage
  
  ;Allocate memory block to store our DIB
  hDIB=AllocateMemory(Len)
  If hDIB=0
    FreeMemory(lpBUFF)
    ;CloseFile(file)
    MessageRequester("LOAD ERROR","Memory allocation failed")
    ProcedureReturn #False ;NO_DIB
  EndIf
  
  ;Fill first part of DIB with the BITMAPINFOHEADER
  CopyMemory(bi,hDIB,SizeOf(bi))
  
  ;Set the colors in the DIB (or masks for the new DIB formats)
  *pal=hDIB+SizeOf(bi)
  If cl\bUseGlobalColMap
    For count=0 To bi\biClrUsed-1
      *pal\rgbBlue=Blue(GlobalCols(count))
      *pal\rgbGreen=Green(GlobalCols(count))
      *pal\rgbRed=Red(GlobalCols(count))
      *pal+4
    Next
  Else
    For count=0 To bi\biClrUsed-1
      *pal\rgbBlue=Blue(localCols(count))
      *pal\rgbGreen=Green(localCols(count))
      *pal\rgbRed=Red(localCols(count))
      *pal+4
    Next
  EndIf
  
  cl\Line=0 ;Set address offset for OutLineGIF()
  cl\Pass=0 ;For interlaced images in OutLineGIF()
  
  ;Image data bits of DIB
  cl\lpBits=hDIB+bi\biSize+(ncolors*4)+(cl\pitch*(height-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=NextCodeGIF(file,CharBuff(),CodeMask(),cl)
    
    If cc<0 ;If a file error, return without completing the decode
      FreeMemory(lpBUFF)
      ;CloseFile(file)
      MessageRequester("LOAD ERROR","Not a valid LZW code")
      ProcedureReturn #False ;FILE_ERROR
    EndIf
    
    ;If the code is a clear code, re-initialise all necessary items.
    If cc=ClearCode
      
      cl\CurrCodeSize=LZWCodeSize+1
      Slot=NewCodes
      TopSlot=1 << cl\CurrCodeSize
      
      ;Continue reading codes until we get a non-clear code
      ;(another unlikely, but possible case...)
      While cc=ClearCode
        cc=NextCodeGIF(file,CharBuff(),CodeMask(),cl)
      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
        Break ;end loop
      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 color 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 OutLineGIF() routine
      *lpBuffPtr\b=cc
      *lpBuffPtr+1
      BufCnt-1
      
      If BufCnt=0
        OutLineGIF(lpBUFF,width,height,cl)
        *lpBuffPtr=lpBUFF
        BufCnt=width
      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 cl\CurrCodeSize<12
          TopSlot=TopSlot << 1
          cl\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
          OutLineGIF(lpBUFF,width,height,cl)
          *lpBuffPtr=lpBUFF
          BufCnt=width
        EndIf
      Wend
      
    EndIf
  Wend
  
  If BufCnt<>width ;If there are any left, output the bytes
    OutLineGIF(lpBUFF,width-BufCnt-1,height,cl)
  EndIf
  *dib=hDIB
  If *dib=0 ;Avoid errors
    ProcedureReturn #False
  EndIf
  
  Bits=*dib+*dib\biSize+(*dib\biClrUsed*4) ;Pointer to bits
  
  ;Create the DDB bitmap
  hdc=GetDC_(#Null)
  hBitmap=CreateDIBitmap_(hdc,*dib,#CBM_INIT,Bits,*dib,#DIB_RGB_COLORS)
  FreeMemory(hDIB)
  imageArray(0)=hBitmap 
  numberimages=1
  
  ;- continue to other frames
  Macro GetBit(Value, bit)
    (Value&(1<<bit))>>bit  ;Translates as 'value' ANDed with 2^bit and shifted back to bitposition 0
  EndMacro
  
  ; Read through the various image blocks
  NotatEnd=1
  While NotatEnd=1
    While n<>$2C 
      n=ReadByte(file) & 255
      If n=$3B
        NotatEnd=0
        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 &$FF
        ;Debug Bin(n&$FF)
        disposalmethod= (n & %00011100) >>2 
        ;Debug disposalmethod
        tflag= GetBit(n,0) ;n& %00000001 
        ;Debug tflag 
        delaytime.w=ReadWord(file)
        
        ;Debug delaytime &  $FFFF
        transparent.b=ReadByte(file) 
        globtranscolor=GlobalCols(transparent& $FF)
      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"
        Debug "text" 
        ; n=ReadByte(file) & 255
        ;FileSeek(file,Loc(file)+n& $FF)
      ElseIf n =$21
        ;"A Extension_block
      EndIf 
    Wend
    n=0
    
    ; done with reading the image blocks for this frame
  FileSeek(file,Loc(file)-1)
  count=0
  While count<>$2C ;Search for im\imSep
    count=ReadByte(file) & 255
  Wend
  FileSeek(file,Loc(file)-1) ;Seek to im\imSep
  
  ReadData(file,im,SizeOf(im)) ;Read the image descriptor
  
  ;Store im\imPkFields for bit manipulation
  impkFields=im\impkFields & 255
  
  ;Is the image interlaced
  cl\bImInterLace=(impkFields & (1 << 6)) >> 6
  
  ;Is the local color table sorted
  bImColsSorted=(impkFields & (1 << 5)) >> 5
  
  ;Is there a local color table
  bImColTable=(impkFields & (1 << 7)) >> 7
  
  If bImColTable
    cl\bUseGlobalColMap=#False
    
    ImgColBytes=3*(1 << ((impkFields & $07)+1)) ;Table size in bytes
    ImgColors=ImgColBytes/3 ;Number of colors
    
    If ImgColors<=2 ;Make sure image bit depth is 1, 4 or 8
      cl\ImgColRes=1
    ElseIf ImgColors<=16
      cl\ImgColRes=4
    Else
      cl\ImgColRes=8
    EndIf
    
    For count=0 To ImgColors-1 ;Get the local image colors
      Red=ReadByte(file) & 255
      Green=ReadByte(file) & 255
      Blue=ReadByte(file) & 255
      localCols(count)=RGB(Red,Green,Blue)
    Next
    loctranscolor=localCols(transparent& $FF)
  Else ;No local color table
    If cl\bUseGlobalColMap=#False ;No global color table
      CloseFile(file)
      MessageRequester("LOAD ERROR","No color table")
      ProcedureReturn #False ;NO_COLORTABLE
    EndIf
  EndIf
  
  width=im\imWidth & $FFFF ;Image width
  height=im\imHeight & $FFFF ;Image height
  
  ;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 color resolution.
  ;i.e. 8 for 256 colors
  If LZWCodeSize<2 Or LZWCodeSize>8
    CloseFile(file)
    MessageRequester("LOAD ERROR","LZW code size is not valid")
    ProcedureReturn #False ;BAD_CODE_SIZE
  EndIf
  
  ;Initialise the variables for the decoder for reading a new image.
  cl\CurrCodeSize=LZWCodeSize+1
  TopSlot=1 << cl\CurrCodeSize ;Highest code for current size
  ClearCode=1 << LZWCodeSize ;Value for a clear code
  EndingCode=ClearCode+1 ;Value for an ending code
  NewCodes=ClearCode+2 ;First available code
  Slot=NewCodes ;Last read code
  cl\BitsLeft=0
  cl\BytesLeft=0
  
  ;Just in case...
  TempOldCode=0 : OldCode=0
  
  ;Allocate space for the decode buffer
  lpBUFF=AllocateMemory(width+8) ;+8 just in case
  
  ;Set up the stack pointer, decode buffer pointer and line counter
  *lpSP=@stack(0)
  *lpBuffPtr=lpBUFF
  BufCnt=width ;Count for pixel line length
  
  ;Start creating the DIB
  If cl\bUseGlobalColMap ;Global color table
    bitcount=cl\GlobColRes
  Else ;Local color table
    bitcount=cl\ImgColRes
  EndIf
  
  bi\biSize=SizeOf(bi)
  bi\biWidth=width
  bi\biHeight=height
  bi\biPlanes=1
  bi\biBitCount=bitcount ;BitCount will be 1, 4 or 8
  bi\biCompression=#BI_RGB
  bi\biSizeImage=0
  bi\biXPelsPerMeter=0
  bi\biYPelsPerMeter=0
  If cl\bUseGlobalColMap ;Global color table
    bi\biClrUsed=GlobColors
  Else ;Local color table
    bi\biClrUsed=ImgColors
  EndIf
  bi\biClrImportant=0
  
  ;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 bi\biClrUsed<>0
    ncolors=bi\biClrUsed
  Else ;We don't have an optimal palette
    ncolors=1 << bi\biBitCount
  EndIf
  
  cl\pitch=(((bitcount*width)+31) >> 5) << 2 ;Bytes per line
  Len=bi\biSize+(ncolors*4)+(cl\pitch*height) ;Size of DIB
  
  bi\biSizeImage=cl\pitch*height ;Fill in biSizeImage
  
  ;Allocate memory block to store our DIB
  hDIB=AllocateMemory(Len)
  If hDIB=0
    FreeMemory(lpBUFF)
    CloseFile(file)
    MessageRequester("LOAD ERROR","Memory allocation failed")
    ProcedureReturn #False ;NO_DIB
  EndIf
  
  ;Fill first part of DIB with the BITMAPINFOHEADER
  CopyMemory(bi,hDIB,SizeOf(bi))
  
  ;Set the colors in the DIB (or masks for the new DIB formats)
  *pal=hDIB+SizeOf(bi)
  If cl\bUseGlobalColMap
    For count=0 To bi\biClrUsed-1
      *pal\rgbBlue=Blue(GlobalCols(count))
      *pal\rgbGreen=Green(GlobalCols(count))
      *pal\rgbRed=Red(GlobalCols(count))
      *pal+4
    Next
  Else
    For count=0 To bi\biClrUsed-1
      *pal\rgbBlue=Blue(localCols(count))
      *pal\rgbGreen=Green(localCols(count))
      *pal\rgbRed=Red(localCols(count))
      *pal+4
    Next
  EndIf
  
  cl\Line=0 ;Set address offset for OutLineGIF()
  cl\Pass=0 ;For interlaced images in OutLineGIF()
  
  ;Image data bits of DIB
  cl\lpBits=hDIB+bi\biSize+(ncolors*4)+(cl\pitch*(height-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.
  cc=0 
  
  While cc<>EndingCode
    
    cc=NextCodeGIF(file,CharBuff(),CodeMask(),cl)
    
    If cc<0 ;If a file error, return without completing the decode
      FreeMemory(lpBUFF)
      CloseFile(file)
      MessageRequester("LOAD ERROR","Not a valid LZW code")
      ProcedureReturn #False ;FILE_ERROR
    EndIf
    
    ;If the code is a clear code, re-initialise all necessary items.
    If cc=ClearCode
      
      cl\CurrCodeSize=LZWCodeSize+1
      Slot=NewCodes
      TopSlot=1 << cl\CurrCodeSize
      
      ;Continue reading codes until we get a non-clear code
      ;(another unlikely, but possible case...)
      While cc=ClearCode
        cc=NextCodeGIF(file,CharBuff(),CodeMask(),cl)
      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
        Break ;end loop
      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 color 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 OutLineGIF() routine
      *lpBuffPtr\b=cc
      *lpBuffPtr+1
      BufCnt-1
      
      If BufCnt=0
        OutLineGIF(lpBUFF,width,height,cl)
        *lpBuffPtr=lpBUFF
        BufCnt=width
      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 cl\CurrCodeSize<12
          TopSlot=TopSlot << 1
          cl\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
          OutLineGIF(lpBUFF,width,height,cl)
          *lpBuffPtr=lpBUFF
          BufCnt=width
        EndIf
      Wend
      
    EndIf
    
  Wend
  
  If BufCnt<>width ;If there are any left, output the bytes
    OutLineGIF(lpBUFF,width-BufCnt-1,height,cl)
  EndIf
  
  ;Create the DDB bitmap
  *dib=hDIB
  If *dib=0 ;Avoid errors
    ProcedureReturn #False
  EndIf
  
  Bits=*dib+*dib\biSize+(*dib\biClrUsed*4) ;Pointer to bits
  
  ;- create the bitmap 
  ;Create the DDB bitmap
  hdc=GetDC_(#Null)
  hBitmap=CreateDIBitmap_(hdc,*dib,#CBM_INIT,Bits,*dib,#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
  
  If bImColTable ; if a local color table, then draw previous image in array, and then dray new hbitmap with transparency
    DrawImage(imageArray(numberimages-1),0,0)
    DrawTransparentImage(drawdc,hBitmap,im\imLeft,im\imTop,im\imWidth,im\imHeight,loctranscolor) 
  Else
    If tflag And disposalmethod <=1
      DrawImage(imageArray(numberimages-1),0,0)
      DrawTransparentImage(drawdc,hBitmap,im\imLeft,im\imTop,im\imWidth,im\imHeight,globtranscolor)
    Else
      DrawImage(imageArray(numberimages-1),0,0)
      DrawImage(hBitmap,im\imLeft,im\imTop)
    EndIf 
  EndIf 
  StopDrawing()
  FreeMemory(hDIB) ;Free the DIB
  imageArray(numberimages)=ImageID(pbimage)
  numberimages=numberimages+1
Wend 
ProcedureReturn numberimages 
EndProcedure


;Procedure TimerProc(hwnd,
Procedure GIFTimerProc(hwnd,msg,wParam,lParam)
  Select msg
    Case #PB_LoadGifFIle
      *GIFframe.ANGIF=GetProp_(hwnd,"frameinfo") 
      If *GIFframe
        For d=0 To *GIFframe\numberframes-1
          DeleteObject_(*GIFframe\hBitmap[d])
        Next
        FreeMemory(*GIFframe)
      EndIf
      *frame.ANGIF=AllocateMemory(SizeOf(ANGIF))
      Dim GIFarray.l(600)
      string.s=PeekS(lParam)
      numberframes=LoadGIFframes(string.s,GIFarray())
      ReDim GIFarray.l(numberframes-1)
      SendMessage_(hwnd,#STM_SETIMAGE,#IMAGE_BITMAP,GIFarray(0))
      SetTimer_(hwnd,200,100,0)
      *frame\numberframes=numberframes
      *frame\framenumber=0
      For a=0 To numberframes-1
        *frame\hBitmap[a]=GIFarray(a)
      Next 
      SetProp_(hwnd,"frameinfo",*frame.ANGIF)
      
    Case #WM_TIMER
      *GIFframe.ANGIF=GetProp_(hwnd,"frameinfo") ; get the image array pointer
      framenumber=*GIFframe\framenumber ; get the frame index
      KillTimer_(hwnd,200) ; stop the timer
      *GIFframe\framenumber=*GIFframe\framenumber+1; increase the frame count
      If *GIFframe\framenumber=*GIFframe\numberframes
        *GIFframe\framenumber=0
      EndIf
      hBitmap=*GIFframe\hBitmap[framenumber] ; get the bitmap
      ;delaytime=PeekW(*ptr+(frame*SizeOf(ANGIF))+4) ; get the delaytime
      SendMessage_(hwnd,#STM_SETIMAGE,#IMAGE_BITMAP,hBitmap); set the new bitmap
      
      SetTimer_(hwnd,200,100,0) ; set the new timer
      SetProp_(hwnd,"frameinfo",*GIFframe.ANGIF); reset the window props
      ;FreeMemory(*GIFframe)
  EndSelect 
  ProcedureReturn CallWindowProc_(GetProp_(hwnd,"oldproc"),hwnd,msg,wParam,lParam)
EndProcedure

Procedure GifStaticControl(id.l,x.l,y.l,width.l,height.l)
  StaticCtl=ImageGadget(id,x.l,y.l,width.l,height,0)
  If id=#PB_Any
    PBreturn=StaticCtl
    hwnd=GadgetID(StaticCtl)
  Else
    PBreturn=GadgetID(id)
    hwnd=GadgetID(id)
  EndIf
  SetProp_(hwnd,"oldproc",SetWindowLong_(hwnd,#GWL_WNDPROC,@GIFTimerProc())) ; subclass
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)
    GifStaticControl(50,100,100,200,200)
  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
            SendMessage_(GadgetID(50),#PB_LoadGifFIle,0,filename)
            ;Dim myarray(800)
            ;numberGIFs=LoadGIFframes(filename,myarray())
            ; UseGadgetList(WindowID(0))
            ; GifStaticControl(50,100,100,200,200,myarray.ANGIF())
            ; 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