Animation Gadget - last update Dec30 2013

netmaestro · Post by **netmaestro** » Thu Dec 12, 2013 3:36 am

This is a gadget for hosting animated gifs. It comes complete with its own decoder so it's easy to use. The decoder processes all disposal/transparency issues at the frame level and produces a structured object containing an image list with delay times and transparent colors for the gadget to display. The project comes with complete source code and five random gif images with varying transparency/disposal methods and a test program to show it in action. OS-specific technologies have been avoided so I hope it will compile and run on all platforms. The decoder isn't as fast as Wilbert's (nobody's anything is as fast as Wilbert's) but with the debugger off this performs quite adequately. With 5 decent-sized gifs to decode on startup, there is no noticeable delay here. If you're wanting to use a decoder to make sprites, I recommend Wilbert's as it makes 32bit images, though you will have more work to do to create a usable animation, as his output is in a more raw form. What makes my decoder more suited to a gui gadget is that it produces 24bit images at the container size, ready for display. With 24bit images you can make a smooth animation in an image gadget, while the same gadget hosting 32bit versions of those images will flicker badly. Sprites in a screen don't have this problem. So, bottom line: for sprites, go with Wilbert's. For a turnkey gui solution, try this one.

Code: Select all

;================================================================================================================
; Project:             Animation Gadget
;
; Author:              netmaestro
; Contributors:        Wilbert
;
; Date:                December 11, 2013
;
; Revision:            1.0.3
; Revision date:       December 30, 2013
;
; Target compiler:     PureBasic 5.21 and newer
;
; Target OS:           Microsoft Windows
;                      Mac OSX
;                      Linux                           
;                       
; License:             Free to use, modify or share
;                      NO WARRANTY expressed or implied
;
; Exported commands:   GifObjectFromBuffer(*buffer, buffersize)
;                      GifObjectFromFile(file$)
;                      FreeGifObject(*gifobject)
;                      
;                      AnimationGadget(gadget, x, y, width, height, *obj.GifObject, transparentcolor, flags=0)
;                      FreeAnimationGadget(gadget)
;
;================================================================================================================

;================================================================
;                 CODESECTION: GIF DECODER
;================================================================

DeclareModule GifLib
  
  Global animationgadget_mutex
  
  Structure GIF_Frame
    frameindex.i
    image.i
    left.u
    top.u
    width.u
    height.u
    delay.u
    interlaced.i
    disposalmethod.a
    transparencyflag.a
    transparentcolor.l
  EndStructure
  
  Structure GifObject
    globaltransparency.i
    transparentcolor.i
    containerwidth.i
    containerheight.i
    backgroundcolor.i
    framecount.i
    repeats.u
    Array Frame.GIF_Frame(0)
  EndStructure
  
  Structure GIF_HEADER_AND_LOGICAL_SCREEN_DESCRIPTOR
    HeaderBytes.a[6]
    Width.u
    Height.u
    PackedByte.a
    BackgroundColorIndex.a
    PixelAspectRatio.a
  EndStructure
  
  Structure GRAPHICS_CONTROL_EXTENSION
    Introducer.a
    Label.a
    BlockSize.a
    PackedByte.a
    DelayTime.u
    TransparentColorIndex.a
    BlockTerminator.a
  EndStructure
  
  Structure IMAGE_DESCRIPTOR
    Separator.a
    ImageLeft.w
    ImageTop.w
    ImageWidth.w
    ImageHeight.w
    PackedByte.a
  EndStructure
  
  Structure codetable Align 4
    prev.l
    color.a
    size.l
  EndStructure
  
  Structure codestream
    tblentry.codetable[4096]
  EndStructure
  
  Structure colorstream
    index.i
    color.a[0]
  EndStructure
  
  Structure colortable
    color.l[0]
  EndStructure
  
  #GIFHEADER89a      = $613938464947
  #GIFHEADER87a      = $613738464947
  #GIFHEADERMASK     = $FFFFFFFFFFFF
  #COLORTABLE_EXISTS = $80
  #LOOPFOREVER       = $00
  
  Enumeration
    #DISPOSAL_NONE
    #DISPOSAL_LEAVEINPLACE
    #DISPOSAL_FILLBKGNDCOLOR
    #DISPOSAL_RESTORESTATE
  EndEnumeration
  
  Declare IsLocalColorTable(*buffer)
  Declare IsGlobalColorTable(*buffer)
  Declare GifImageHeight(*buffer)
  Declare GifImageWidth(*buffer)
  Declare GetBackgroundColor(*buffer)
  Declare OutputCodeString(*ct.codestream, this_code, *stream.colorstream)
  Declare CreateBaseImage(*object.GifObject, index=0)
  Declare ProcessGifData(*buffer, buffersize)
  Declare GifObjectFromBuffer(*buffer, size)
  Declare GifObjectFromFile(filename$)
  Declare FreeGifObject(*object.GifObject)
  Declare Animate(gadget)
  Declare FreeAnimationGadget(gadget)
  Declare AnimationGadget(window, gadget, x, y, w, h, *object.GifObject, flags=0)
  
EndDeclareModule

Module GifLib
  
  Procedure IsLocalColorTable(*buffer)
    
    Protected *ptr.IMAGE_DESCRIPTOR = *buffer
    
    If *ptr\PackedByte & #COLORTABLE_EXISTS
      ProcedureReturn  2 << (*ptr\PackedByte & 7) *3
    Else
      ProcedureReturn 0
    EndIf
  EndProcedure
  
  Procedure IsGlobalColorTable(*gifdata)
    
    Protected *ptr.GIF_HEADER_AND_LOGICAL_SCREEN_DESCRIPTOR = *gifdata
    
    If *ptr\PackedByte & #COLORTABLE_EXISTS
      ProcedureReturn 2 << (*ptr\PackedByte & 7) * 3
    Else
      ProcedureReturn 0
    EndIf
  EndProcedure
  
  Procedure GifImageWidth(*gifdata)
    
    Protected *ptr.GIF_HEADER_AND_LOGICAL_SCREEN_DESCRIPTOR = *gifdata
    
    ProcedureReturn *ptr\Width
  EndProcedure
  
  Procedure GifImageHeight(*gifdata)
    
    Protected *ptr.GIF_HEADER_AND_LOGICAL_SCREEN_DESCRIPTOR = *gifdata
    
    ProcedureReturn *ptr\Height
  EndProcedure
  
  Procedure GetBackgroundColor(*gifdata)
    
    Protected *ptr.GIF_HEADER_AND_LOGICAL_SCREEN_DESCRIPTOR = *gifdata
    Protected index = *ptr\BackgroundColorIndex
    Protected *readcolors.Long
    
    If IsGlobalColorTable(*ptr)
      *readcolors.Long = *gifdata + 13 + (index * 3)
      ProcedureReturn RGBA(PeekA(*readcolors),PeekA(*readcolors+1),PeekA(*readcolors+2), 255)
    Else
      ProcedureReturn 0
    EndIf
  EndProcedure
  
  Procedure CreateBaseImage(*obj.GifObject, index=0)
    ProcedureReturn CreateImage(#PB_Any, *obj\containerwidth, *obj\containerheight, 32, #PB_Image_Transparent)
  EndProcedure
  
  Procedure OutputCodeString(*ct.codestream, this_code, *stream.colorstream)
    *stream\index + *ct\tblentry[this_code]\size-1
    While *ct\tblentry[this_code]\size > 1
      *stream\color[*stream\index] = *ct\tblentry[this_code]\color
      this_code = *ct\tblentry[this_code]\prev
      *stream\index - 1
    Wend
    *stream\color[*stream\index] = *ct\tblentry[this_code]\color
    ProcedureReturn *ct\tblentry[this_code]\color
  EndProcedure
  
  Macro m_InitCodeTable
    For j=0 To clr_code-1 : *ct\tblentry[j]\color = j : *ct\tblentry[j]\size = 1 : Next
    For j=clr_code To 4095 : *ct\tblentry[j]\color=0 : *ct\tblentry[j]\prev=0 : *ct\tblentry[j]\size=0 : Next
  EndMacro
  
  Procedure ProcessGifData(*buffer, buffersize)
    
    Protected *colors.colortable  = AllocateMemory(1024)
    Protected *stream.colorstream = AllocateMemory(1024)
    Protected *ct.codestream      = AllocateMemory(SizeOf(codestream))
    
    Protected *gifobject.GifObject, *readcolors.Long, *readptr, *gcereader.GRAPHICS_CONTROL_EXTENSION
    Protected *idreader.IMAGE_DESCRIPTOR, *writeptr, *packed
    
    Protected.l codesize, offset, cur_code, mask, clr_code, next_code, prev_code, end_code, bytesleft
    Protected.i index, bytes_colortable, colorcount, extension_label, transparency, tc_index
    Protected.i morebytes, disposalmethod, repeats, thisframe, result, nextblock
    Protected.i min_codesize, totalcodebytes, nextimage
    Protected.i i, j, y, cc, k
    Protected.u delaytime
    
    If PeekQ(*buffer) & #GIFHEADERMASK <> #GIFHEADER89a And PeekQ(*buffer) & #GIFHEADERMASK <> #GIFHEADER87a
      ProcedureReturn 0 
    EndIf
    *gifobject.GifObject = AllocateMemory(SizeOf(GifObject))
    InitializeStructure(*gifobject, GifObject)
    With *gifobject
      \backgroundcolor = GetBackgroundColor(*buffer) 
      \containerheight = GifImageHeight(*buffer)     
      \containerwidth  = GifImageWidth(*buffer)      
    EndWith
    *readptr = *buffer + 13
    bytes_colortable = IsGlobalColorTable(*buffer)
    If bytes_colortable
      *readptr + bytes_colortable    
    EndIf
    Repeat
      Select PeekA(*readptr)
          
        Case $21 
          extension_label = PeekA(*readptr + 1)
          Select extension_label
            Case $F9 
              *gcereader.GRAPHICS_CONTROL_EXTENSION = *readptr
              transparency   =  *gcereader\PackedByte & 1
              disposalmethod =  (*gcereader\PackedByte & (7<<2))>>2
              delaytime.u    = *gcereader\DelayTime
              If transparency
                tc_index = *gcereader\TransparentColorIndex
              EndIf
              *readptr + SizeOf(GRAPHICS_CONTROL_EXTENSION)
              
            Case $FE, $01 
              *readptr+2
              While PeekA(*readptr)
                *readptr+1
                If *readptr >= *buffer+buffersize
                  Break
                EndIf
              Wend
              *readptr+1
              
              Case $FF
              *readptr + 2
              morebytes = PeekA(*readptr) 
              *readptr + morebytes + 1
              morebytes = PeekA(*readptr)
              repeats = PeekU(*readptr+2)
              *readptr + morebytes+1
              morebytes = PeekA(*readptr)
              While morebytes
                *readptr+morebytes+1
                morebytes = PeekA(*readptr)
              Wend
              *readptr+1
              
            Default 
              Break
              
          EndSelect
          
        Case $3B
          Break
          
        Case $2C
          thisframe = ArraySize(*gifobject\Frame())
          *gifobject\framecount + 1
          ReDim *gifobject\Frame(*gifobject\framecount)
          *gifobject\frame(thisframe)\frameindex=thisframe
          *gifobject\repeats = repeats
          *idreader.IMAGE_DESCRIPTOR = *readptr
          *readptr + SizeOf(IMAGE_DESCRIPTOR)
          With *gifobject\Frame(thisframe)
            \left       = *idreader\ImageLeft
            \top        = *idreader\ImageTop
            \width      = *idreader\ImageWidth
            \height     = *idreader\ImageHeight
            \interlaced = *idreader\PackedByte >> 6 & 1
            \delay      = delaytime * 10
            \transparencyflag = transparency
            \disposalmethod   = disposalmethod
          EndWith
          result = IsLocalColorTable(*idreader) 
          If result 
            bytes_colortable = result
            colorcount = bytes_colortable/3
            *colors.colortable = ReAllocateMemory(*colors, (bytes_colortable/3)*4)
            *readcolors.Long = *readptr
            For i=0 To colorcount-1
              *colors\color[i] = RGBA(PeekA(*readcolors),PeekA(*readcolors+1),PeekA(*readcolors+2), 255)
              *readcolors + 3
            Next
            If *gifobject\Frame(thisframe)\transparencyflag
              *colors\color[tc_index]  &~ $FF000000 
            EndIf
            *readptr + bytes_colortable
          Else
            bytes_colortable = IsGlobalColorTable(*buffer)
            If bytes_colortable
              colorcount = bytes_colortable/3
              *colors.colortable = ReAllocateMemory(*colors, (bytes_colortable/3)*4)
              *readcolors.Long = *buffer + 13
              For i=0 To colorcount-1
                *colors\color[i] = RGBA(PeekA(*readcolors),PeekA(*readcolors+1),PeekA(*readcolors+2), 255)
                *readcolors + 3
              Next
              If *gifobject\Frame(thisframe)\transparencyflag
                *colors\color[tc_index] &~ $FF000000
              EndIf
            EndIf
          EndIf
          If *gifobject\Frame(thisframe)\transparencyflag
            *gifobject\Frame(thisframe)\transparentcolor = *colors\color[tc_index]
          EndIf
          If thisframe=0 And *gifobject\Frame(0)\transparencyflag
            *gifobject\backgroundcolor = *colors\color[tc_index]
          EndIf
          *gifobject\Frame(thisframe)\image = CreateImage(#PB_Any, *gifobject\Frame(thisframe)\width, *gifobject\frame(thisframe)\height, 32, #PB_Image_Transparent)
          min_codesize   = PeekA(*readptr)
          totalcodebytes = 0
          *readptr+1
          nextblock = PeekA(*readptr)
          *packed = AllocateMemory(buffersize<<1)
          *writeptr = *packed
          While nextblock
            *readptr + 1
            CopyMemory(*readptr, *writeptr, nextblock)
            *readptr+nextblock : *writeptr+nextblock
            totalcodebytes+nextblock
            nextblock = PeekA(*readptr)
          Wend
          *packed = ReAllocateMemory(*packed, totalcodebytes)
          *stream.colorstream = ReAllocateMemory(*stream, *gifobject\frame(thisframe)\width * *gifobject\frame(thisframe)\height + SizeOf(colorstream))
          *stream\index=0
          codesize = min_codesize+1
          index=*packed : offset=0 : bytesleft=MemorySize(*packed) : mask = 1<<codesize-1
          clr_code  = 1 << min_codesize
          cur_code  = clr_code
          end_code  = clr_code + 1
          next_code = end_code 
          m_InitCodeTable
          Repeat
            prev_code = cur_code
            cur_code = (PeekL(index) & (mask<<offset))>>offset
            offset+codesize
            While offset>=8
              index+1
              bytesleft-1
              offset-8
            Wend
            If bytesleft > 0
              If cur_code <> end_code
                If cur_code <> clr_code
                  If prev_code <> clr_code
                    If cur_code <= next_code
                      If next_code < 4095
                        next_code + 1                
                        *ct\tblentry[next_code]\prev  = prev_code
                        *ct\tblentry[next_code]\color = OutputCodeString(*ct, cur_code, *stream)
                        *stream\index+*ct\tblentry[cur_code]\size
                        *ct\tblentry[next_code]\size  = *ct\tblentry[prev_code]\size + 1
                      Else
                        OutputCodeString(*ct, cur_code, *stream)
                        *stream\index+*ct\tblentry[cur_code]\size
                      EndIf
                    Else
                      next_code + 1
                      *ct\tblentry[cur_code]\prev  = prev_code
                      *ct\tblentry[cur_code]\color = OutputCodeString(*ct, prev_code, *stream)
                      *stream\index+*ct\tblentry[prev_code]\size
                      *stream\color[*stream\index] = *ct\tblentry[next_code]\color : *stream\index + 1
                      *ct\tblentry[cur_code]\size  = *ct\tblentry[prev_code]\size + 1
                    EndIf
                  Else
                    *stream\color[*stream\index]=cur_code
                    *stream\index + 1
                  EndIf
                Else
                  codesize  = min_codesize + 1
                  mask = 1 << codesize - 1
                  next_code = end_code 
                EndIf
              Else
                Break
              EndIf
            Else
              Break
            EndIf
            
            If next_code = mask And codesize < 12
              codesize + 1
              mask = 1 << codesize - 1
            EndIf
            
          ForEver
          cc=0
          StartDrawing(ImageOutput(*gifobject\Frame(thisframe)\image))
            DrawingMode(#PB_2DDrawing_AllChannels)
            If *gifobject\Frame(thisframe)\interlaced
              For k = 0 To 3
                y = 1 << (3 - k) & 7
                While y < *gifobject\Frame(thisframe)\height
                  For i=0 To *gifobject\Frame(thisframe)\width-1
                    Plot(i,y, *colors\color[*stream\color[cc]])
                    cc+1
                  Next
                  y + (2 << (3 - k) - 1) & 7 + 1
                Wend
              Next
            Else
              For j=0 To *gifobject\Frame(thisframe)\height-1
                For i=0 To *gifobject\Frame(thisframe)\width-1
                  Plot(i,j, *colors\color[*stream\color[cc]])
                  cc+1
                Next
              Next
            EndIf
          StopDrawing()
          FreeMemory(*packed)
          *readptr+1
          
        Default
          Break
          
      EndSelect
      
    ForEver
    
    ; Compose images in container & apply disposal methods
    If *gifobject\Frame(0)\transparencyflag
      *gifobject\globaltransparency = #True
      *gifobject\transparentcolor = *gifobject\Frame(0)\transparentcolor
    EndIf
    
    nextimage = CreateBaseImage(*gifobject, 0)
    For i=0 To *gifobject\framecount-1
      StartDrawing(ImageOutput(nextimage))
        DrawAlphaImage(ImageID(*gifobject\Frame(i)\image), *gifobject\Frame(i)\left, *gifobject\Frame(i)\top)
      StopDrawing()
      FreeImage(*gifobject\Frame(i)\image)
      *gifobject\Frame(i)\image=nextimage
      If i<*gifobject\framecount-1
        Select *gifobject\Frame(i)\disposalmethod
          Case #DISPOSAL_NONE, #DISPOSAL_LEAVEINPLACE
            nextimage = CopyImage(*gifobject\Frame(i)\image, #PB_Any)

          Case #DISPOSAL_FILLBKGNDCOLOR
            nextimage = CopyImage(*gifobject\frame(i)\image, #PB_Any)
            StartDrawing(ImageOutput(nextimage))
              DrawingMode(#PB_2DDrawing_AllChannels)
              Box(*gifobject\Frame(i)\left,*gifobject\Frame(i)\top,*gifobject\Frame(i)\width,*gifobject\Frame(i)\height, *gifobject\backgroundcolor)
            StopDrawing()

          Case #DISPOSAL_RESTORESTATE
            If *gifobject\Frame(0)\disposalmethod = #DISPOSAL_LEAVEINPLACE
              nextimage = CopyImage(*gifobject\Frame(0)\image, #PB_Any)
            Else
              nextimage = CreateBaseImage(*gifobject, i)
            EndIf
            
          Default
            If *gifobject\Frame(0)\disposalmethod = #DISPOSAL_LEAVEINPLACE
              nextimage = CopyImage(*gifobject\Frame(0)\image, #PB_Any)
            Else
              nextimage = CreateBaseImage(*gifobject, i)
            EndIf
            
        EndSelect
      EndIf
      If *gifobject\frame(i)\delay < 20
        If i<>0
          *gifobject\frame(i)\delay = 100
        EndIf
      EndIf
      If *gifobject\framecount = 1 
        *gifobject\repeats = 1
      EndIf
    Next
    
    FreeMemory(*stream)
    FreeMemory(*colors)
    FreeMemory(*ct)

    ProcedureReturn *gifobject
    
  EndProcedure
  
  Procedure.i GifObjectFromFile(file$)
    
    Protected.i buffersize, *buffer, result
    
    If ReadFile(0, file$)
      buffersize = Lof(0)
      *buffer = AllocateMemory(buffersize)
      ReadData(0, *buffer, buffersize)
      CloseFile(0)
      result = ProcessGifData(*buffer, buffersize)
      FreeMemory(*buffer)
      ProcedureReturn result
    Else
      ProcedureReturn 0
    EndIf
  EndProcedure
  
  Procedure.i GifObjectFromBuffer(*buffer, buffersize)
    ProcedureReturn ProcessGifData(*buffer, buffersize)
  EndProcedure
  
  Procedure FreeGifObject(*object.GifObject)
    
    Protected i
    
    If *object
      For i=0 To *object\framecount-1
        If IsImage(*object\frame(i)\image)
          FreeImage(*object\frame(i)\image)
        EndIf
      Next
      ClearStructure(*object, GifObject)
      FreeMemory(*object)
    EndIf
  EndProcedure
  
  ;================================================================
  ;                 CODESECTION: ANIMATION GADGET 
  ;================================================================
  
  Structure frame
    index.i
    image.i
    delay.i
  EndStructure
  
  Structure animation
    globaltransparency.i
    transparentcolor.i
    threadid.i
    repeats.u
    List frames.frame()
  EndStructure
  
  Procedure Animate(gadgetnumber)
    
    Protected *this.animation = GetGadgetData(gadgetnumber), cc
    
    Repeat
      ForEach *this\frames()
        If IsGadget(gadgetnumber) And IsImage(*this\frames()\image)
          SetGadgetState(gadgetnumber, ImageID(*this\frames()\image))
          Delay(*this\frames()\delay)
        EndIf
      Next
      If *this\repeats
        cc + 1
        If cc > *this\repeats
          Break
        EndIf
      EndIf
    ForEver
    
  EndProcedure
  
  Procedure FreeAnimationGadget(gadgetnumber)
    
    Protected *this.animation
    
    If IsGadget(gadgetnumber)
      *this.animation = GetGadgetData(gadgetnumber)
      If *this
        If IsThread(*this\threadid)
          KillThread(*this\threadid)
          WaitThread(*this\threadid)
        EndIf
        ForEach *this\frames()
          If IsImage(*this\frames()\image)
            FreeImage(*this\frames()\image)
          EndIf
        Next
        FreeList(*this\frames())
        ClearStructure(*this, animation)
        FreeMemory(*this)
        FreeGadget(gadgetnumber)
      EndIf
    EndIf
  EndProcedure
  
  Procedure AnimationGadget(gadgetnumber, x, y, width, height, *animation.GifObject, transcolor, flags=0)
    
    Protected result, *this.animation, i
    
    If Not *animation
      ProcedureReturn 0
    EndIf
    
    If gadgetnumber = #PB_Any
      result = ImageGadget(gadgetnumber, x, y, width, height, 0, flags)
    Else
      ImageGadget(gadgetnumber, x, y, width, height, 0, flags)
      result = gadgetnumber
    EndIf
    *this.animation = AllocateMemory(SizeOf(animation))
    InitializeStructure(*this, animation)
    For i=0 To *animation\framecount-1
      AddElement(*this\frames())
      *this\frames()\index = *animation\frame(i)\frameindex
      *this\frames()\delay = *animation\frame(i)\delay
      *this\globaltransparency=*animation\globaltransparency
      *this\transparentcolor=*animation\transparentcolor
      *this\frames()\image = CreateImage(#PB_Any, *animation\containerwidth, *animation\containerheight, 24, transcolor)
      StartDrawing(ImageOutput(*this\frames()\image))
        DrawAlphaImage(ImageID(*animation\frame(i)\image),0,0)
      StopDrawing()
    Next
    *this\repeats = *animation\repeats
    SetGadgetData(result, *this) 
    FreeGifObject(*animation)
    *this\threadid = CreateThread(@Animate(), result)
    ProcedureReturn result
  EndProcedure
  
EndModule

;================================================================
;                END OF CODE: ANIMATION GADGET
;================================================================

All 24bit version, no alpha channel:

Code: Select all

;================================================================================================================
; Project:             Animation Gadget
;
; Author:              netmaestro
; Contributors:        Wilbert
;
; Date:                December 11, 2013
;
; Revision:            1.0.3
; Revision date:       December 30, 2013
;
; Target compiler:     PureBasic 5.21
;
; Target OS:           Microsoft Windows
;                      Mac OSX
;                      Linux                           
;                       
; License:             Free to use, modify or share
;                      NO WARRANTY expressed or implied
;
; Exported commands:   GifObjectFromBuffer(*buffer, buffersize)
;                      GifObjectFromFile(file$)
;                      FreeGifObject(*gifobject)
;                      
;                      AnimationGadget(gadget, x, y, width, height, *obj.GifObject, transparentcolor, flags=0)
;                      FreeAnimationGadget(gadget)
;
;================================================================================================================

;================================================================
;                 CODESECTION: GIF DECODER
;================================================================

DeclareModule GifLib
  
  Global animationgadget_mutex
  
  Structure GIF_Frame
    frameindex.i
    image.i
    left.u
    top.u
    width.u
    height.u
    delay.u
    interlaced.i
    disposalmethod.a
    transparencyflag.a
    transparentcolor.l
  EndStructure
  
  Structure GifObject
    globaltransparency.i
    transparentcolor.i
    containerwidth.i
    containerheight.i
    backgroundcolor.i
    framecount.i
    repeats.u
    Array Frame.GIF_Frame(0)
  EndStructure
  
  Structure GIF_HEADER_AND_LOGICAL_SCREEN_DESCRIPTOR
    HeaderBytes.a[6]
    Width.u
    Height.u
    PackedByte.a
    BackgroundColorIndex.a
    PixelAspectRatio.a
  EndStructure
  
  Structure GRAPHICS_CONTROL_EXTENSION
    Introducer.a
    Label.a
    BlockSize.a
    PackedByte.a
    DelayTime.u
    TransparentColorIndex.a
    BlockTerminator.a
  EndStructure
  
  Structure IMAGE_DESCRIPTOR
    Separator.a
    ImageLeft.w
    ImageTop.w
    ImageWidth.w
    ImageHeight.w
    PackedByte.a
  EndStructure
  
  Structure codetable Align 4
    prev.l
    color.a
    size.l
  EndStructure
  
  Structure codestream
    tblentry.codetable[4096]
  EndStructure
  
  Structure colorstream
    index.i
    color.a[0]
  EndStructure
  
  Structure colortable
    color.l[0]
  EndStructure
  
  #GIFHEADER89a      = $613938464947
  #GIFHEADER87a      = $613738464947
  #GIFHEADERMASK     = $FFFFFFFFFFFF
  #COLORTABLE_EXISTS = $80
  #LOOPFOREVER       = $00
  
  Enumeration
    #DISPOSAL_NONE
    #DISPOSAL_LEAVEINPLACE
    #DISPOSAL_FILLBKGNDCOLOR
    #DISPOSAL_RESTORESTATE
  EndEnumeration
  
  Declare IsLocalColorTable(*buffer)
  Declare IsGlobalColorTable(*buffer)
  Declare GifImageHeight(*buffer)
  Declare GifImageWidth(*buffer)
  Declare GetBackgroundColor(*buffer)
  Declare OutputCodeString(*ct.codestream, this_code, *stream.colorstream)
  Declare CreateBaseImage(*object.GifObject, index=0)
  Declare ProcessGifData(*buffer, buffersize)
  Declare GifObjectFromBuffer(*buffer, size)
  Declare GifObjectFromFile(filename$)
  Declare FreeGifObject(*object.GifObject)
  Declare Animate(gadget)
  Declare FreeAnimationGadget(gadget)
  Declare AnimationGadget(window, gadget, x, y, w, h, *object.GifObject, flags=0)
  Declare TransparentFilter(x, y, sourcecolor, targetcolor)
  Declare SetTransparentColor(color)
  
EndDeclareModule

Module GifLib
  
  Procedure IsLocalColorTable(*buffer)
    
    Protected *ptr.IMAGE_DESCRIPTOR = *buffer
    
    If *ptr\PackedByte & #COLORTABLE_EXISTS
      ProcedureReturn  2 << (*ptr\PackedByte & 7) *3
    Else
      ProcedureReturn 0
    EndIf
  EndProcedure
  
  Procedure IsGlobalColorTable(*gifdata)
    
    Protected *ptr.GIF_HEADER_AND_LOGICAL_SCREEN_DESCRIPTOR = *gifdata
    
    If *ptr\PackedByte & #COLORTABLE_EXISTS
      ProcedureReturn 2 << (*ptr\PackedByte & 7) * 3
    Else
      ProcedureReturn 0
    EndIf
  EndProcedure
  
  Procedure GifImageWidth(*gifdata)
    
    Protected *ptr.GIF_HEADER_AND_LOGICAL_SCREEN_DESCRIPTOR = *gifdata
    
    ProcedureReturn *ptr\Width
  EndProcedure
  
  Procedure GifImageHeight(*gifdata)
    
    Protected *ptr.GIF_HEADER_AND_LOGICAL_SCREEN_DESCRIPTOR = *gifdata
    
    ProcedureReturn *ptr\Height
  EndProcedure
  
  Procedure GetBackgroundColor(*gifdata)
    
    Protected *ptr.GIF_HEADER_AND_LOGICAL_SCREEN_DESCRIPTOR = *gifdata
    Protected index = *ptr\BackgroundColorIndex
    Protected *readcolors.Long
    
    If IsGlobalColorTable(*ptr)
      *readcolors.Long = *gifdata + 13 + (index * 3)
      ProcedureReturn RGB(PeekA(*readcolors),PeekA(*readcolors+1),PeekA(*readcolors+2))
    Else
      ProcedureReturn 0
    EndIf
  EndProcedure
  
  Procedure CreateBaseImage(*obj.GifObject, backgroundcolor=0)
    ProcedureReturn CreateImage(#PB_Any, *obj\containerwidth, *obj\containerheight, 24, backgroundcolor)
  EndProcedure
  
  Procedure OutputCodeString(*ct.codestream, this_code, *stream.colorstream)
    *stream\index + *ct\tblentry[this_code]\size-1
    While *ct\tblentry[this_code]\size > 1
      *stream\color[*stream\index] = *ct\tblentry[this_code]\color
      this_code = *ct\tblentry[this_code]\prev
      *stream\index - 1
    Wend
    *stream\color[*stream\index] = *ct\tblentry[this_code]\color
    ProcedureReturn *ct\tblentry[this_code]\color
  EndProcedure
  
  Macro m_InitCodeTable
    For j=0 To clr_code-1 : *ct\tblentry[j]\color = j : *ct\tblentry[j]\size = 1 : Next
    For j=clr_code To 4095 : *ct\tblentry[j]\color=0 : *ct\tblentry[j]\prev=0 : *ct\tblentry[j]\size=0 : Next
  EndMacro
  
  Procedure ProcessGifData(*buffer, buffersize)
    
    Protected *colors.colortable  = AllocateMemory(1024)
    Protected *stream.colorstream = AllocateMemory(1024)
    Protected *ct.codestream      = AllocateMemory(SizeOf(codestream))
    
    Protected *gifobject.GifObject, *readcolors.Long, *readptr, *gcereader.GRAPHICS_CONTROL_EXTENSION
    Protected *idreader.IMAGE_DESCRIPTOR, *writeptr, *packed
    
    Protected.l codesize, offset, cur_code, mask, clr_code, next_code, prev_code, end_code, bytesleft
    Protected.i index, bytes_colortable, colorcount, extension_label, transparency, tc_index
    Protected.i morebytes, disposalmethod, repeats, thisframe, result, nextblock
    Protected.i min_codesize, totalcodebytes, nextimage
    Protected.i i, j, y, cc, k
    Protected.u delaytime
    
    If PeekQ(*buffer) & #GIFHEADERMASK <> #GIFHEADER89a And PeekQ(*buffer) & #GIFHEADERMASK <> #GIFHEADER87a
      ProcedureReturn 0 
    EndIf
    *gifobject.GifObject = AllocateMemory(SizeOf(GifObject))
    InitializeStructure(*gifobject, GifObject)
    With *gifobject
      \backgroundcolor = GetBackgroundColor(*buffer) 
      \containerheight = GifImageHeight(*buffer)     
      \containerwidth  = GifImageWidth(*buffer)      
    EndWith
    *readptr = *buffer + 13
    bytes_colortable = IsGlobalColorTable(*buffer)
    If bytes_colortable
      *readptr + bytes_colortable    
    EndIf
    Repeat
      Select PeekA(*readptr)
          
        Case $21 
          extension_label = PeekA(*readptr + 1)
          Select extension_label
            Case $F9 
              *gcereader.GRAPHICS_CONTROL_EXTENSION = *readptr
              transparency   =  *gcereader\PackedByte & 1
              disposalmethod =  (*gcereader\PackedByte & (7<<2))>>2
              delaytime.u    = *gcereader\DelayTime
              If transparency
                tc_index = *gcereader\TransparentColorIndex
              EndIf
              *readptr + SizeOf(GRAPHICS_CONTROL_EXTENSION)
              
            Case $FE, $01 
              *readptr+2
              While PeekA(*readptr)
                *readptr+1
                If *readptr >= *buffer+buffersize
                  Break
                EndIf
              Wend
              *readptr+1
              
              Case $FF
              *readptr + 2
              morebytes = PeekA(*readptr) 
              *readptr + morebytes + 1
              morebytes = PeekA(*readptr)
              repeats = PeekU(*readptr+2)
              *readptr + morebytes+1
              morebytes = PeekA(*readptr)
              While morebytes
                *readptr+morebytes+1
                morebytes = PeekA(*readptr)
              Wend
              *readptr+1
              
            Default 
              Break
              
          EndSelect
          
        Case $3B
          Break
          
        Case $2C
          thisframe = ArraySize(*gifobject\Frame())
          *gifobject\framecount + 1
          ReDim *gifobject\Frame(*gifobject\framecount)
          *gifobject\frame(thisframe)\frameindex=thisframe
          *gifobject\repeats = repeats
          *idreader.IMAGE_DESCRIPTOR = *readptr
          *readptr + SizeOf(IMAGE_DESCRIPTOR)
          With *gifobject\Frame(thisframe)
            \left       = *idreader\ImageLeft
            \top        = *idreader\ImageTop
            \width      = *idreader\ImageWidth
            \height     = *idreader\ImageHeight
            \interlaced = *idreader\PackedByte >> 6 & 1
            \delay      = delaytime * 10
            \transparencyflag = transparency
            \disposalmethod   = disposalmethod
          EndWith
          result = IsLocalColorTable(*idreader) 
          If result 
            bytes_colortable = result
            colorcount = bytes_colortable/3
            *colors.colortable = ReAllocateMemory(*colors, (bytes_colortable/3)*4)
            *readcolors.Long = *readptr
            For i=0 To colorcount-1
              *colors\color[i] = RGB(PeekA(*readcolors),PeekA(*readcolors+1),PeekA(*readcolors+2))
              *readcolors + 3
            Next
            *readptr + bytes_colortable
          Else
            bytes_colortable = IsGlobalColorTable(*buffer)
            If bytes_colortable
              colorcount = bytes_colortable/3
              *colors.colortable = ReAllocateMemory(*colors, (bytes_colortable/3)*4)
              *readcolors.Long = *buffer + 13
              For i=0 To colorcount-1
                *colors\color[i] = RGB(PeekA(*readcolors),PeekA(*readcolors+1),PeekA(*readcolors+2))
                *readcolors + 3
              Next
            EndIf
          EndIf
          ; For 24bit processing the transparent color must be unique
          For i=0 To colorcount-1
            If i<>tc_index
              If *colors\color[i]=*colors\color[tc_index]
                If *colors\color[i] < RGB(255,255,255)
                  *colors\color[i] + 1
                Else
                  *colors\color[i] - 1
                EndIf
              EndIf
            EndIf
          Next
          If *gifobject\Frame(thisframe)\transparencyflag
            *gifobject\Frame(thisframe)\transparentcolor = *colors\color[tc_index]
          EndIf
          If thisframe=0 And *gifobject\Frame(0)\transparencyflag
            *gifobject\backgroundcolor = *colors\color[tc_index]
          EndIf
          *gifobject\Frame(thisframe)\image = CreateImage(#PB_Any, *gifobject\Frame(thisframe)\width, *gifobject\frame(thisframe)\height, 24)
          min_codesize   = PeekA(*readptr)
          totalcodebytes = 0
          *readptr+1
          nextblock = PeekA(*readptr)
          *packed = AllocateMemory(buffersize<<1)
          *writeptr = *packed
          While nextblock
            *readptr + 1
            CopyMemory(*readptr, *writeptr, nextblock)
            *readptr+nextblock : *writeptr+nextblock
            totalcodebytes+nextblock
            nextblock = PeekA(*readptr)
          Wend
          *packed = ReAllocateMemory(*packed, totalcodebytes)
          *stream.colorstream = ReAllocateMemory(*stream, *gifobject\frame(thisframe)\width * *gifobject\frame(thisframe)\height + SizeOf(colorstream))
          *stream\index=0
          codesize = min_codesize+1
          index=*packed : offset=0 : bytesleft=MemorySize(*packed) : mask = 1<<codesize-1
          clr_code  = 1 << min_codesize
          cur_code  = clr_code
          end_code  = clr_code + 1
          next_code = end_code 
          m_InitCodeTable
          Repeat
            prev_code = cur_code
            cur_code = (PeekL(index) & (mask<<offset))>>offset
            offset+codesize
            While offset>=8
              index+1
              bytesleft-1
              offset-8
            Wend
            If bytesleft > 0
              If cur_code <> end_code
                If cur_code <> clr_code
                  If prev_code <> clr_code
                    If cur_code <= next_code
                      If next_code < 4095
                        next_code + 1                
                        *ct\tblentry[next_code]\prev  = prev_code
                        *ct\tblentry[next_code]\color = OutputCodeString(*ct, cur_code, *stream)
                        *stream\index+*ct\tblentry[cur_code]\size
                        *ct\tblentry[next_code]\size  = *ct\tblentry[prev_code]\size + 1
                      Else
                        OutputCodeString(*ct, cur_code, *stream)
                        *stream\index+*ct\tblentry[cur_code]\size
                      EndIf
                    Else
                      next_code + 1
                      *ct\tblentry[cur_code]\prev  = prev_code
                      *ct\tblentry[cur_code]\color = OutputCodeString(*ct, prev_code, *stream)
                      *stream\index+*ct\tblentry[prev_code]\size
                      *stream\color[*stream\index] = *ct\tblentry[next_code]\color : *stream\index + 1
                      *ct\tblentry[cur_code]\size  = *ct\tblentry[prev_code]\size + 1
                    EndIf
                  Else
                    *stream\color[*stream\index]=cur_code
                    *stream\index + 1
                  EndIf
                Else
                  codesize  = min_codesize + 1
                  mask = 1 << codesize - 1
                  next_code = end_code 
                EndIf
              Else
                Break
              EndIf
            Else
              Break
            EndIf
            
            If next_code = mask And codesize < 12
              codesize + 1
              mask = 1 << codesize - 1
            EndIf
            
          ForEver
          cc=0
          StartDrawing(ImageOutput(*gifobject\Frame(thisframe)\image))
            If *gifobject\Frame(thisframe)\interlaced
              For k = 0 To 3
                y = 1 << (3 - k) & 7
                While y < *gifobject\Frame(thisframe)\height
                  For i=0 To *gifobject\Frame(thisframe)\width-1
                    Plot(i,y, *colors\color[*stream\color[cc]])
                    cc+1
                  Next
                  y + (2 << (3 - k) - 1) & 7 + 1
                Wend
              Next
            Else
              For j=0 To *gifobject\Frame(thisframe)\height-1
                For i=0 To *gifobject\Frame(thisframe)\width-1
                  Plot(i,j, *colors\color[*stream\color[cc]])
                  cc+1
                Next
              Next
            EndIf
          StopDrawing()
          FreeMemory(*packed)
          *readptr+1
          
        Default
          Break
          
      EndSelect
      
    ForEver
    
    ; Compose images in container & apply disposal methods
    If *gifobject\Frame(0)\transparencyflag
      *gifobject\globaltransparency = #True
      *gifobject\transparentcolor = *gifobject\Frame(0)\transparentcolor
    EndIf
    
    If *gifobject\frame(0)\transparencyflag
      nextimage = CreateBaseImage(*gifobject, *gifobject\Frame(0)\transparentcolor)
    Else
      nextimage = CreateBaseImage(*gifobject, *gifobject\backgroundcolor)
    EndIf
    For i=0 To *gifobject\framecount-1
      StartDrawing(ImageOutput(nextimage))
        If *gifobject\frame(i)\transparencyflag
          SetTransparentColor(*gifobject\frame(i)\transparentcolor)
          DrawingMode(#PB_2DDrawing_CustomFilter)
          CustomFilterCallback(@TransparentFilter())
        EndIf
        DrawImage(ImageID(*gifobject\Frame(i)\image), *gifobject\Frame(i)\left, *gifobject\Frame(i)\top)
      StopDrawing()
      FreeImage(*gifobject\Frame(i)\image)
      *gifobject\Frame(i)\image=nextimage
      If i<*gifobject\framecount-1
        Select *gifobject\Frame(i)\disposalmethod
          Case #DISPOSAL_NONE, #DISPOSAL_LEAVEINPLACE
            nextimage = CopyImage(*gifobject\Frame(i)\image, #PB_Any)
            
          Case #DISPOSAL_FILLBKGNDCOLOR
            nextimage = CopyImage(*gifobject\frame(i)\image, #PB_Any)
            StartDrawing(ImageOutput(nextimage))
              Box(*gifobject\Frame(i)\left,*gifobject\Frame(i)\top,*gifobject\Frame(i)\width,*gifobject\Frame(i)\height, *gifobject\backgroundcolor)
            StopDrawing()

          Case #DISPOSAL_RESTORESTATE
            If *gifobject\Frame(0)\disposalmethod = #DISPOSAL_LEAVEINPLACE
              nextimage = CopyImage(*gifobject\Frame(0)\image, #PB_Any)
            Else
              nextimage = CreateBaseImage(*gifobject, *gifobject\Frame(i)\transparentcolor)
            EndIf
            
          Default
            If *gifobject\Frame(0)\disposalmethod = #DISPOSAL_LEAVEINPLACE
              nextimage = CopyImage(*gifobject\Frame(0)\image, #PB_Any)
            Else
              nextimage = CreateBaseImage(*gifobject, *gifobject\Frame(i)\transparentcolor)
            EndIf
            
        EndSelect
      EndIf
      If *gifobject\frame(i)\delay < 20
        If i<>0
          *gifobject\frame(i)\delay = 100
        EndIf
      EndIf
      If *gifobject\framecount = 1 
        *gifobject\repeats = 1
      EndIf
    Next
 
    FreeMemory(*stream)
    FreeMemory(*colors)
    FreeMemory(*ct)
CallDebugger
    ProcedureReturn *gifobject
    
  EndProcedure
  
  Procedure.i GifObjectFromFile(file$)
    
    Protected.i buffersize, *buffer, result
    
    If ReadFile(0, file$)
      buffersize = Lof(0)
      *buffer = AllocateMemory(buffersize)
      ReadData(0, *buffer, buffersize)
      CloseFile(0)
      result = ProcessGifData(*buffer, buffersize)
      FreeMemory(*buffer)
      ProcedureReturn result
    Else
      ProcedureReturn 0
    EndIf
  EndProcedure
  
  Procedure.i GifObjectFromBuffer(*buffer, buffersize)
    ProcedureReturn ProcessGifData(*buffer, buffersize)
  EndProcedure
  
  Procedure FreeGifObject(*object.GifObject)
    
    Protected i
    
    If *object
      For i=0 To *object\framecount-1
        If IsImage(*object\frame(i)\image)
          FreeImage(*object\frame(i)\image)
        EndIf
      Next
      ClearStructure(*object, GifObject)
      FreeMemory(*object)
    EndIf
  EndProcedure
  
  ;================================================================
  ;                 CODESECTION: ANIMATION GADGET 
  ;================================================================
  
  #SETTRANSPARENTCOLOR = -1
  #MAXALPHA = $FF<<6
  
  Structure frame
    index.i
    image.i
    delay.i
    transparencyflag.l
    transparentcolor.l
  EndStructure
  
  Structure animation
    globaltransparency.l
    transparentcolor.l
    threadid.i
    repeats.u
    List frames.frame()
  EndStructure
  
  Procedure Animate(gadgetnumber)
    
    Protected *this.animation = GetGadgetData(gadgetnumber), cc
    
    Repeat
      ForEach *this\frames()
        If IsGadget(gadgetnumber) And IsImage(*this\frames()\image)
          SetGadgetState(gadgetnumber, ImageID(*this\frames()\image))
          Delay(*this\frames()\delay)
        EndIf
      Next
      If *this\repeats
        cc + 1
        If cc > *this\repeats
          Break
        EndIf
      EndIf
    ForEver
    
  EndProcedure
  
  Procedure FreeAnimationGadget(gadgetnumber)
    
    Protected *this.animation
    
    If IsGadget(gadgetnumber)
      *this.animation = GetGadgetData(gadgetnumber)
      If *this
        If IsThread(*this\threadid)
          KillThread(*this\threadid)
          WaitThread(*this\threadid)
        EndIf
        ForEach *this\frames()
          If IsImage(*this\frames()\image)
            FreeImage(*this\frames()\image)
          EndIf
        Next
        FreeList(*this\frames())
        ClearStructure(*this, animation)
        FreeMemory(*this)
        FreeGadget(gadgetnumber)
      EndIf
    EndIf
  EndProcedure
  
  Procedure TransparentFilter(x, y, sourcecolor, targetcolor)
    Static transcolor
    If x = #SETTRANSPARENTCOLOR
      transcolor = sourcecolor | $FF<<24
      ProcedureReturn
    EndIf
      
    If sourcecolor = transcolor
      ProcedureReturn targetcolor
    Else
      ProcedureReturn sourcecolor
    EndIf
  EndProcedure
  
  Procedure SetTransparentColor(color)
    Transparentfilter(#SETTRANSPARENTCOLOR, 0, color, 0)
  EndProcedure
  
  Procedure AnimationGadget(gadgetnumber, x, y, width, height, *animation.GifObject, transcolor, flags=0)
    
    Protected result, *this.animation, i
    
    If Not *animation
      ProcedureReturn 0
    EndIf
    
    If gadgetnumber = #PB_Any
      result = ImageGadget(gadgetnumber, x, y, width, height, 0, flags)
    Else
      ImageGadget(gadgetnumber, x, y, width, height, 0, flags)
      result = gadgetnumber
    EndIf
    *this.animation = AllocateMemory(SizeOf(animation))
    InitializeStructure(*this, animation)
    For i=0 To *animation\framecount-1
      AddElement(*this\frames())
      *this\frames()\index = *animation\frame(i)\frameindex
      *this\frames()\delay = *animation\frame(i)\delay
      *this\globaltransparency=*animation\globaltransparency
      *this\transparentcolor=*animation\transparentcolor
      *this\frames()\image = CreateImage(#PB_Any, *animation\containerwidth, *animation\containerheight, 24, transcolor)
      StartDrawing(ImageOutput(*this\frames()\image))
        If *this\globaltransparency
          SetTransparentColor(*this\transparentcolor)
          DrawingMode(#PB_2DDrawing_CustomFilter)
          CustomFilterCallback(@TransparentFilter())
        EndIf
        DrawImage(ImageID(*animation\frame(i)\image),0,0)
      StopDrawing()
    Next
    *this\repeats = *animation\repeats
    SetGadgetData(result, *this) 
    FreeGifObject(*animation)
    *this\threadid = CreateThread(@Animate(), result)
    ProcedureReturn result
  EndProcedure
  
EndModule

;================================================================
;                END OF CODE: ANIMATION GADGET
;================================================================

And a test program:

Code: Select all

;///////////////////////////////////////////////////////////////////////
;         BrowseGifs_1: View all the gifs in current folder
;///////////////////////////////////////////////////////////////////////


CompilerIf #PB_Compiler_Debugger
  MessageRequester("","Please turn the debugger off to run these tests!")
  End
CompilerEndIf

CompilerIf #PB_Compiler_Thread = 0
  MessageRequester("","Please turn threadsafe on, the gadget uses a thread!")
  End
CompilerEndIf

XIncludeFile "AnimationGadget.pbi"

UseModule GifLib

Procedure TreeProc()
  Static last=0
  If GetGadgetState(0)<>last
    LockMutex(animationgadget_mutex)
    FreeAnimationGadget(1)
    *this.GifObject = GifObjectFromFile(GetGadgetText(0))
    w=*this\containerwidth
    h=*this\containerheight
    AnimationGadget(1, 210+325-w/2,100+350-h/2, 0, 0, *this, RGB(128,128,128))
    last = GetGadgetState(0)
    UnlockMutex(animationgadget_mutex)
  EndIf
EndProcedure

animationgadget_mutex = CreateMutex()
OpenWindow(0,0,0,1000,900,"",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
SetWindowColor(0, RGB(128,128,128))

ExamineDirectory(0, GetCurrentDirectory(), "*.gif")
TreeGadget(0, 10, 10, 200, 680)
BindGadgetEvent(0, @TreeProc(), #PB_EventType_Change)
While NextDirectoryEntry(0)
  AddGadgetItem(0, -1, DirectoryEntryName(0))
Wend
FinishDirectory(0)
SetActiveGadget(0)

FreeAnimationGadget(1)
SetGadgetState(0, 0)
*this.GifObject = GifObjectFromFile(GetGadgetText(0))
w=*this\containerwidth
h=*this\containerheight
AnimationGadget(1, 210+325-w/2,350-h/2, 0, 0, *this, RGB(128,128,128))

Repeat : Until WaitWindowEvent()=#PB_Event_CloseWindow

UnuseModule GifLib

Here it is: https://lloydsplace.com/GifDecoder.zip (Same as posted code, includes gifs for testing)

Update 2013 Dec 14:
Several bugs found and fixed. Works with many more gifs now.
Added support for interlaced gifs (stole Wilbert's logic for this, thx)

Update 2013 Dec 16:
Fixed a bug in the decoder that could potentially cause a write past the end of a memory block. (that purifier is an invaluable tool, I don't know how we did without it before)
Added support for a wider variety of disposal methods that may be found. (still more to do on this)
Fixed a bug which caused some animated gifs to decode improperly

Update 2013 Dec 17:
Done more work on disposal methods, more 'unusual' gifs will play correctly. More samples in folder.

Update 2013 Dec 18:
Rewrote part of the decoder code, it's cleaner and more streamlined now
Added new functionality to disposal methods, more samples in folder
As of today I can't find a gif that won't play correctly. If you find one, please post a link to it, thanks

Update 2013 Dec 19:
More work done on disposals, much testing. Disposals 'might' be finished now.

Update 2013 Dec 21:
Converted the code in the decoder to create frames at 32bit depth which are then affected to 24bit images in the gadget and freed. This allows me to avoid using the custom drawing callback for transparency, and as I understand it this was the main problem on Mac OS X. I hope this updated version will work on Mac as I would really like it to support all 3 of PureBasic's platforms.
Also went through the code and plugged several memory leaks. Now after loading/playing over 100 gifs and reloading the first one, memory usage is virtually unchanged.

Update 2013 Dec 21 (2):
Thanks to those who tested on Mac, I've made a change to the code removing the use of DrawingBuffer() in the hope of solving the memory access problem on Mac OS X. If anyone can download the latest version (0.0.16) and try it (possibly for the second or third time

) on the Mac, I would appreciate it very much. Thanks again.

Update 2013 Dec 23: (Revision 0.0.17)
New code version today, consolidated the code processing routine with the code extraction loop eliminating the need for an array of codes. As the dim of this array was causing memory access problems on Mac, that's a good thing to do. Also the code is cleaner and approx. 10% faster with the change. Hope it doesn't break anything.

Update 2013 Dec 25: (Revision 0.0.20)
Fixed a bug in the decoder that allowed badly-formed gifs to make it crash
Rewrote the bits extraction routine in assembler, I hope someone can help me optimize it
Made the code into a module so it will behave included in a larger program

Merry Christmas everyone!

Peace and joy to you and yours

Update 2013 Dec 26: (Revision 0.1.0)
Worked with Wilbert's help on getting the Mac OS X port working, it seems OK now. (if you don't click too quickly through the gifs, this isn't an issue on windows) So it now runs on all 3 platforms, x86 and x64. I will probably tweak the gadget event handling (possibly adding a new command to set a new gif to an existing gadget) so that rapid-clicking won't cause a problem. As all known gifs are playing on all 3 platforms, the revision is moved out of alpha into early beta (0.1.0).

Update 2013 Dec 27: (Revision 0.1.4)
New update today, decoder is optimized and significantly more efficient (faster)
Also fixed an issue with the gadget display of single-frame gifs.

Update 2013 Dec 29: (Revision 1.0.0)
New update today, much progress made in clearing up the issues on Mac OSX x64. The program is reported stable everywhere now. Accordingly, this is the first major release, 1.0
(btw, the included test program is now called browsegifs_1.pb)

Also added Wilbert to the masthead as a contributor as his collaboration and help has been integral to the success of this program.

Fixed a bug where a badly-formed gif could have caused a crash (Revision 1.0.1)

Update 2013 Dec 30: (Revision 1.0.2)
More tightening and streamlining of code & flow

Changed: window no longer passed as parameter, transparent color to use is passed instead (see masthead for syntax)

Added: new test program, allows to click "copy" from a gif on the web, paste it to the gadget (it's also saved in your temp folder) Also you can drag gifs from your filesystem and drop them on the window. To summarize, copy/paste only from the web (no drag) and drag-drop only from your filesystem (no copy/paste)

Second update today: (Revision 1.0.3)
After testing north of 200 gifs I found one with invalid disposal methods, which I wasn't handling with a default case. Fixed that in this update, also included a really cool 4-stroke piston engine animation.

IdeasVacuum · Post by **IdeasVacuum** » Thu Dec 12, 2013 4:09 am

What an excellent job you have done netmaestro

I like the examples too.

netmaestro · Post by **netmaestro** » Thu Dec 12, 2013 4:34 am

Thanks, it actually was a lot of work. Most of it is going into my work-in-progress Gif Workshop project so it had to be done anyway and I've seen quite a few coding questions over the years about using animated gifs on a window so some people should be able to make use of it. I struggled for some time over the question of whether to create a UseGifDecoder() command and then Load/CatchImage would work normally. But the problem with that is that a decoded gif is more than an image. It's several images, each with attached data for disposal, transparency and delay time. So a Use() solution really isn't going to be suitable.

wilbert · Post by **wilbert** » Thu Dec 12, 2013 6:16 am

Nice to see you finished the gadget Netmeastro

Unfortunately it doesn't seem to work on OS X (x64).
I get an Invalid Memory Access on this line
Dim codesin(buffersize)

netmaestro · Post by **netmaestro** » Thu Dec 12, 2013 6:28 am

Well, I've done all I can. I downloaded PB for windows x64 and ran the code on that, no errors. I tried with the purifier set to full granularity, nothing. The source is all there, maybe you can find something. I have no apple here. Several orchards but no computers

Post by **idle** » Thu Dec 12, 2013 6:38 am

Worked fine for me on linux after I changed all the file paths to "images/"

Thanks netmaestro very nice!

netmaestro · Post by **netmaestro** » Thu Dec 12, 2013 6:45 am

Thanks Idle! (thx again for the SetBits macro

I'm still using it on the Encoder)
@Wilbert, how about on OS X 32bit? Did it fail there too?

wilbert · Post by **wilbert** » Thu Dec 12, 2013 6:48 am

netmaestro wrote:Thanks Idle! (thx again for the SetBits macro )
@Wilbert, how about on OS X 32bit? Did it fail there too?

Unfortunately yes, also an IMA but on a different line
ForEach *animation\Frame()
It makes no sense to me why this happens and the location where.
It might as well be a bug in the OS X version of PureBasic.

netmaestro · Post by **netmaestro** » Thu Dec 12, 2013 7:07 am

That line is at the gadget level, could you try doing just a decode followed by ShowLibraryViewer("image") and CallDebugger and just see if all the images are there and look ok. If it will run that far also try with the purifier.

wilbert · Post by **wilbert** » Thu Dec 12, 2013 7:43 am

The 32 bit OS X version seems to compile and run with Debugger enabled, with debugger disabled it crashes.
But the results are not what you would expect. The part that should be transparent is colored and the part that should be colored it transparent.
With the custom filter callback disabled it draws the right colors but no transparency.

davido · Post by **davido** » Thu Dec 12, 2013 8:58 am

Very nice!

Lovely demo.

Thank you for sharing after all the hard work you have put into this project.

Karellen · Post by **Karellen** » Thu Dec 12, 2013 10:34 am

absolutely great!

Thanks, Maestro!

Post by **flaith** » Fri Dec 13, 2013 3:16 am

Brilliant, thanks a lot Netmaestro

netmaestro · Post by **netmaestro** » Fri Dec 13, 2013 10:22 am

I made a couple of improvements to the code, it will handle more challenging gifs now. I updated the upload with the new code and two really cool gifs to test with. Thanks to Wilbert for alerting me that my first version wouldn't load these, and for tips on how to improve it.

* Remember to test without debugger *

netmaestro · Post by **netmaestro** » Fri Dec 13, 2013 11:02 am

With the custom filter callback disabled it draws the right colors but no transparency.

@Wilbert, I'd try swapping SourceColor and TargetColor in the callback and see what that does. Based on the images you posted, they're exactly the opposite of what they should be. If that fixes it, I think it's worth a bug report on Mac.

PureBasic Forums - English

Animation Gadget - last update Dec30 2013

Animation Gadget - last update Dec30 2013

Re: Animation Gadget

Re: Animation Gadget

Re: Animation Gadget

Re: Animation Gadget

Re: Animation Gadget

Re: Animation Gadget

Re: Animation Gadget

Re: Animation Gadget

Re: Animation Gadget

Re: Animation Gadget

Re: Animation Gadget

Re: Animation Gadget

Re: Animation Gadget

Re: Animation Gadget - updated Dec 13