Author Topic: [SOLVED]Animated Gif help  (Read 1085 times)

0 Members and 1 Guest are viewing this topic.

Offline Omnikam

  • Atari ST
  • ***
  • Posts: 101
  • Karma: 4
    • View Profile
[SOLVED]Animated Gif help
« on: October 27, 2015 »
Hey guys First help request, ive tried searching around and havnt found a cure to my problem
Creating my first demo and Im trying to load a animated gif using Purebasic, only Purebasic has no native support, im aware that some of you are experts using purebasic, im a noob
this is the first code ive made
Does anyone know how it can be done? Im sorry if this is way below your level, it`s above mine

Code: [Select]
InitSprite()
UseJPEGImageDecoder()
InitKeyboard() 
OpenScreen(800,600,32,"PBWINDOW")
Sprt1 = LoadSprite(#PB_Any, "test.jpg")
Sprt2 = LoadSprite (#PB_Any, "commodore64.jpg")
Repeat
ExamineKeyboard()   
ClearScreen($006600)
DisplaySprite(Sprt1, 0,0)
DisplaySprite(Sprt2, 100, 100)
FlipBuffers()
Until KeyboardPushed (#PB_Key_Escape)
End
DataSection
    Image:
    IncludeBinary "commodore64.jpg"
EndDataSection
The image i trying to use

Attach:c64_1_ani.gif
« Last Edit: October 29, 2015 by Omnikam »

Offline padman

  • Senior Member
  • Pentium
  • ********
  • Posts: 982
  • Karma: 258
    • View Profile
Re: Animated Gif help
« Reply #1 on: October 27, 2015 »
Hey,

I wouldn't recommend using gif files for what you want to achieve. It's way easier for a 'noob' (and in general  ;) ) to take single pictures and animate them yourself. Just google for some freeware that can extract the frames from a gif picture.

Have a look at http://www.dbfinteractive.com/forum/index.php?topic=5229.0  for an example for this sort of animation. It's pretty simple to do that.

The part of the code, that does the magic is the following:

Code: [Select]

CatchSprite(0,?one)      ;<------  Animframe=0
CatchSprite(1,?two)      ;<------  Animframe=1
CatchSprite(2,?three)    ;<------  Animframe=2

-----------------------------

AnimDelay + 1                   
 
   
             If AnimDelay = 7                           ;<--- the higher the value, the slower the animation
                  AnimDelay = 0
   
   
             
                AnimFrame + 1                          ; <--- cycle through the different sprites
                EndIf
      If AnimFrame = 3 : AnimFrame=0 : EndIf           ;<---- Animframe corresponds to the sprite IDs which were catched before. I.e.  0/1/2

-------------------------------

DisplayTransparentSprite(animframe,0,0)                ;<---- Display the animation



If you only want an animated cursor, you can just use a still picture of the C64 screen without the cursor and make little sprites blink by using 2 sprites and switch between them. Saves you memory as well.


Quick'n'dirty sort of 'pseudo' code, as I'm at work and can't test it.


Code: [Select]

InitSprite()
InitKeyboard() 
OpenScreen(640,480,32,"")

CreateSprite(0,16,16)
StartDrawing(SpriteOutput(0))
Box(0,0,16,16,#Black)          ;<---- Put the right background color here
Stopdrawing()


CreateSprite(1,16,16)
StartDrawing(SpriteOutput(1))
Box(0,0,16,16,#Blue)          ;<---- Put the right front color here
Stopdrawing()


Repeat
ExamineKeyboard()   
ClearScreen($000000)


AnimDelay + 1                   
 
   
             If AnimDelay = 10                               
                  AnimDelay = 0
   
   
             
                AnimFrame + 1                                       
                EndIf
      If AnimFrame = 2 : AnimFrame=0 : EndIf   


DisplaySprite(animframe,0,0)


FlipBuffers()
Until KeyboardPushed (#PB_Key_Escape)


Pad :)
Challenge Trophies Won:

Offline Omnikam

  • Atari ST
  • ***
  • Posts: 101
  • Karma: 4
    • View Profile
Re: Animated Gif help
« Reply #2 on: October 27, 2015 »
Thanks Padman, ill look into your suggestions, In the mean time i achived my objective using gif although its horrable code, just hacked. It works but it`s a mess  :boxer:
But your totally right, animating it myself is the way to go, much more flexability
Code: [Select]
EnableExplicit
XIncludeFile "GIFanimation.pbi"

Define.w a
Dim Frames.GIFANIM::GIF_Frame(0)

OpenWindow(0, 0, 0, 768, 544, "Gif_Test", #PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_SizeGadget|#PB_Window_MaximizeGadget)

ImageGadget(1,0,0,0,0,0, #PB_Image_Border)

AddWindowTimer(0, 0, 100)

Repeat
  Select #PB_Event_RightClick     
    Case #PB_Event_RightClick     

       
          Define.s Pattern="All Supported Formats|*.gif"
          Define.s filename="c64_1_ani.gif"
          If filename
            If GIFANIM::GIF_LoadFrames(Frames(), "c64_1_ani.gif")
             
              ;SetGadgetState(0, ImageID(Frames(0)\Image))
            EndIf
          EndIf
      EndSelect
     
   
   
     Select #PB_Event_Timer
    Case #PB_Event_Timer
      RemoveWindowTimer(0, 0)
      If a > ArraySize(Frames()) : a = 0 : EndIf
      If IsImage(Frames(a)\Image)
        SetGadgetState(1, ImageID(Frames(a)\Image))
        AddWindowTimer(0, 0, Frames(a)\DelayTime * 10)
      Else
        AddWindowTimer(0, 0, 100)
      EndIf
      a + 1   
  EndSelect
 
ForEver

if your interested here`s the GIFanimation.pbi
Code: [Select]
; Original PB code by "hagibaba" (Purebasic.fr forums) based on "loadgif.c" for ImageShop32 by John Findlay
; Gif Anim support by localmotion34 (Purebasic.fr forums)
; Updated & Extended by Dean Williams - resplace.net
; APIs free, alpha channel support and bug fixes by Niffo (Purebasic.fr forums)

; #######################################
; enhanced and optimized by Thomas <ts-soft> Schulz (www.realsource.de)
; + added Catch-Support
; + added reading of complete giffile into memory, this should be faster ;-)
; + optimized Variabletypes for better support 64-Bit Programs
; + changed Syntax of GIF_LoadFrames() to:
; GIF_LoadFrames(Array GIF_Frames.GIF_Frame(1), filename.s = "", *memory = 0, memsize = 0)
; changed MessageRequester to Debug.
; #######################################
; Update 23.06.2013 by ts-soft
; changed CreateImage to Syntax from PB5.20+
; changed to Module (GIFANIM)

; Please help development and report any problems or improvements/bug fixes you may have on
; if we all work together we can have some really nice GIF support in PureBasic!
; http://www.purebasic.fr/english/viewtopic.php?f=12&t=27575

DeclareModule GIFANIM
  Structure GIF_Frame
    Image.i
    DelayTime.w
  EndStructure
 
  Declare GIF_LoadFrames(Array GIF_Frames.GIF_Frame(1), filename.s = "", *memory = 0, memsize = 0)
 
EndDeclareModule

Module GIFANIM
  ;{ - Structures
 
  CompilerIf Defined(BITMAPINFOHEADER, #PB_Structure)
  CompilerElse
  Structure BITMAPINFOHEADER
    biSize.l
    biWidth.l
    biHeight.l
    biPlanes.w
    biBitCount.w
    biCompression.l
    biSizeImage.l
    biXPelsPerMeter.l
    biYPelsPerMeter.l
    biClrUsed.l
    biClrImportant.l
  EndStructure
 
  #BI_RGB = 0
 
  Structure RGBQUAD
    rgbBlue.a
    rgbGreen.a
    rgbRed.a
    rgbReserved.a
  EndStructure
  CompilerEndIf
 
  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 GIF_OutLine(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
 
  Procedure.l GIF_NextCode(*mem, mempos, *pos.long, 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 = PeekA(*mem + mempos) : mempos + SizeOf(Byte)
       
        If *cl\BytesLeft<0
          *pos\l = mempos
          ProcedureReturn *cl\BytesLeft ;Return if error
        ElseIf *cl\BytesLeft
          For count=0 To *cl\BytesLeft-1
            Char = PeekA(*mem + mempos) : mempos + SizeOf(Byte)
            *pos\l = mempos
            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 = PeekA(*mem + mempos) : mempos + SizeOf(Byte)
       
        If *cl\BytesLeft<0
          *pos\l = mempos
          ProcedureReturn *cl\BytesLeft ;Return if error
        ElseIf *cl\BytesLeft
          For count=0 To *cl\BytesLeft-1
            Char = PeekA(*mem + mempos) : mempos + SizeOf(Byte)
            *pos\l = mempos
            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
    *pos\l = mempos
    ProcedureReturn ret
   
  EndProcedure
 
  Procedure GIF_CreateDIImage(*dib.BITMAPINFOHEADER, TransColIndex.w)
    Protected *Bits = *dib+*dib\biSize+(*dib\biClrUsed*4)
    Protected Image = CreateImage(#PB_Any, *dib\biWidth, *dib\biHeight, 32)
    Protected.l X, Y, RGBA, Col
    Protected *Pal = *dib + *dib\biSize
    Protected.a ColInd, Alpha
    Protected.l dibPitch = *dib\biSizeImage/*dib\biHeight
   
    StartDrawing(ImageOutput(Image))
    DrawingMode(#PB_2DDrawing_AllChannels)
   
    ;   Define *BufAddr = DrawingBuffer()
    ;   Define.l BufPitch = DrawingBufferPitch()
    For Y = 0 To *dib\biHeight - 1
      For X = 0 To *dib\biWidth - 1
       
        Select *dib\biBitCount
          Case 8
            ColInd = PeekA(*Bits + Y*dibPitch+X)
          Case 4
            ;If X % 2
            ;   ColInd = PeekA(*Bits + Y*dibPitch+X) & $F
            ;Else
            ;   ColInd = PeekA(*Bits + Y*dibPitch+X) >> 4
            ;EndIf
            ColInd = PeekA(*Bits + Y*dibPitch+X/2) >> (4*(1-X%2)) & $F
        EndSelect         
       
        If ColInd = TransColIndex : Alpha = 0 : Else : Alpha = 255 : EndIf
        Col = PeekL(*Pal+ColInd*4)
       
        ; Plot
        RGBA = RGBA(Blue(Col), Green(Col), Red(Col), Alpha)
        Plot(X, *dib\biHeight-1-Y, RGBA)
       
        ;          ; Direct Buffer Write (not faster !?)
        ;          If DrawingBufferPixelFormat() & #PB_PixelFormat_32Bits_RGB
        ;             RGBA = RGBA(Blue(Col), Green(Col), Red(Col), Alpha)
        ;          ElseIf DrawingBufferPixelFormat() & #PB_PixelFormat_32Bits_BGR
        ;             RGBA = RGBA(Red(Col), Green(Col), Blue(Col), Alpha)
        ;          EndIf
        ;          If DrawingBufferPixelFormat() & #PB_PixelFormat_ReversedY
        ;             PokeL(*BufAddr + (Y*BufPitch+X*4), RGBA)
        ;          Else
        ;             PokeL(*BufAddr + ((*dib\biHeight-1-Y)*BufPitch+X*4), RGBA)
        ;          EndIf
       
      Next X
    Next Y
   
    StopDrawing()
   
    ProcedureReturn Image
   
  EndProcedure
 
  Procedure.i GIF_LoadFrames(Array GIF_Frames.GIF_Frame(1), filename.s = "", *memory = 0, memsize = 0)
    ;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
   
    Protected mempos, newpos, *mem
    If filename <> ""
      ;Open the file
      file=ReadFile(#PB_Any,filename)
      If file=0
        Debug "GIF Load Error! Could not open the GIF image file for reading."
        ProcedureReturn #False
      EndIf
      ;Read the file header and logical screen descriptor
      memsize = Lof(file)
      *mem = AllocateMemory(memsize)
      If *mem = 0
        Debug "GIF Load Error! Could not allocate Memory for GIF image."
        ProcedureReturn #False
      EndIf
      ReadData(file, *mem, memsize)
      CloseFile(file)
    ElseIf *memory
      *mem = AllocateMemory(memsize)
      If *mem
        CopyMemory(*memory, *mem, memsize)
      EndIf
    EndIf
    If *mem = 0
      Debug "GIF Load Error! Could not find Memory for GIF image."
      ProcedureReturn #False   
    EndIf
    CopyMemory(*mem, gh, SizeOf(gh))
    mempos + SizeOf(gh)
    sig=PeekS(@gh\ghSig,6,#PB_Ascii) ;Get the header version string
   
    If sig<>"GIF89a" And sig<>"GIF87a"
      FreeMemory(*mem)
      Debug "GIF Load Error! File was not a valid GIF image file"
      ProcedureReturn #False ;NOT_VALID
    EndIf
    Protected.l realwidth=gh\ghWidth
    Protected.l 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 = PeekA(*mem + mempos) : mempos + SizeOf(Byte)
        Green = PeekA(*mem + mempos) : mempos + SizeOf(Byte)
        Blue = PeekA(*mem + mempos) : mempos + SizeOf(Byte)
        GlobalCols(count)=RGB(Red,Green,Blue)
      Next
    EndIf
   
    Protected.w TransColorIndex = -1
    count=0
    While count<>$2C ;Search for im\imSep
      count = PeekA(*mem + mempos) : mempos + SizeOf(Byte)
      If count = $F9
        mempos + SizeOf(Byte)
        Protected.b tflag = PeekB(*mem + mempos) & 1 : mempos + SizeOf(Byte)
        Protected.w delaytime = PeekW(*mem + mempos) : mempos + SizeOf(Word)
        Protected.a transparent = PeekB(*mem + mempos) : mempos + SizeOf(Byte)
        If tflag : TransColorIndex = transparent : EndIf
      EndIf
    Wend
    mempos - SizeOf(byte);Seek to im\imSep
    CopyMemory(*mem + mempos, im, SizeOf(im)) ;Read the image descriptor
    mempos + SizeOf(im)
    ;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 = PeekA(*mem + mempos) : mempos + SizeOf(Byte)
        Green = PeekA(*mem + mempos) : mempos + SizeOf(Byte)
        Blue = PeekA(*mem + mempos) : mempos + SizeOf(Byte)
        localCols(count)=RGB(Red,Green,Blue)
      Next
      ;transcolor=LocalCols(TByte)
    Else ;No local color table
      If cl\bUseGlobalColMap=#False ;No global color table
        FreeMemory(*mem)
        Debug "GIF Load Error! The GIF image does not contain a valid 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 = PeekA(*mem + mempos) : mempos + SizeOf(Byte)
    ;Bit size is normally the same as the color resolution.
    ;i.e. 8 for 256 colors
    If LZWCodeSize<2 Or LZWCodeSize>8
      FreeMemory(*mem)
      Debug "GIF 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)
      FreeMemory(*mem)
      Debug "GIF 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=GIF_NextCode(*mem, mempos, @newpos, CharBuff(),CodeMask(),cl)
      mempos = newpos
      If cc<0 ;If a file error, return without completing the decode
        FreeMemory(lpBUFF)
        FreeMemory(*mem)
        Debug "GIF Load Error! LZW code size is Not valid!"
        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=GIF_NextCode(*mem, mempos, @newpos,CharBuff(),CodeMask(),cl)
           mempos = newpos
        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
          GIF_OutLine(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
            GIF_OutLine(lpBUFF,width,height,cl)
            *lpBuffPtr=lpBUFF
            BufCnt=width
          EndIf
        Wend
       
      EndIf
    Wend
   
    If BufCnt<>width ;If there are any left, output the bytes
      GIF_OutLine(lpBUFF,width-BufCnt-1,height,cl)
    EndIf
    *dib=hDIB
    If *dib=0 ;Avoid errors
      ProcedureReturn #False
    EndIf
   
    Protected.i Bits=*dib+*dib\biSize+(*dib\biClrUsed*4) ;Pointer to bits
   
    ;Create the DDB bitmap
    Protected.i hImage=GIF_CreateDIImage(*dib, TransColorIndex)
    Protected.i pbimage=CreateImage(#PB_Any,realwidth,realheight, 32, #PB_Image_Transparent) ; Create initial "screen"
    StartDrawing(ImageOutput(pbimage))
    DrawingMode(#PB_2DDrawing_AlphaBlend)
    ;Box(0,0,realwidth,realheight,$FFFFFF)
    DrawImage(ImageID(hImage),im\imLeft,im\imTop,im\imWidth,im\imHeight)
    StopDrawing()
    FreeImage(hImage)
    FreeMemory(hDIB)
    ;imageArray(0)=ImageID(pbimage)
    GIF_Frames(0)\Image = pbimage
    GIF_Frames(0)\DelayTime = delaytime
    Protected.l numberimages=1
   
    ;===========================
    ;- continue to other frames
    ;===========================
   
    ; Read through the various image blocks
    Protected NotatEnd=1
    While NotatEnd=1
      TransColorIndex = -1
      Protected.i n
      While n<>$2C
        n=PeekA(*mem + mempos) : mempos + SizeOf(Byte)
        If n=$3B
          NotatEnd=0
          FreeMemory(*mem)
          FreeMemory(lpBUFF)
          ProcedureReturn numberimages
        ElseIf n=$F9
          ;Graphics control extension
          n=PeekA(*mem + mempos) : mempos + SizeOf(Byte)
          Protected.l Size = n
          n=PeekA(*mem + mempos) : mempos + SizeOf(Byte)
          ;Define.b packedfields = n &$FF
          Protected.l disposalmethod = (n & %00011100) >>2
          tflag = n & %00000001
          delaytime = PeekW(*mem + mempos) : mempos + SizeOf(Word)
          transparent = PeekB(*mem + mempos) : mempos + SizeOf(Byte)
          If tflag : TransColorIndex = transparent : EndIf
        ElseIf n=$FF
          ;application extension
        ElseIf n=$FE
          ;comment extention
          n=PeekA(*mem + mempos) : mempos + SizeOf(Byte)
          mempos + 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
      mempos - SizeOf(Byte)
      count=0
      While count<>$2C ;Search for im\imSep
        count = PeekA(*mem + mempos) : mempos + SizeOf(Byte)
      Wend
      mempos - SizeOf(Byte) ;Seek to im\imSep
      CopyMemory(*mem + mempos, im, SizeOf(im)) ;Read the image descriptor
      mempos + SizeOf(im)
      ;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 = PeekA(*mem + mempos) : mempos + SizeOf(Byte)
          Green = PeekA(*mem + mempos) : mempos + SizeOf(Byte)
          Blue = PeekA(*mem + mempos) : mempos + SizeOf(Byte)
          localCols(count)=RGB(Red,Green,Blue)
        Next
        ;loctranscolor=localCols(transparent& $FF)
        ;transcolor=localCols(transparent& $FF)
      Else ;No local color table
        If cl\bUseGlobalColMap=#False ;No global color table
          FreeMemory(*mem)
          Debug "GIF Load Error! The GIF image does not contain a valid color table."
          ProcedureReturn #False ;NO_COLORTABLE
        EndIf
        ;transcolor=GlobalCols(transparent& $FF)
      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 = PeekA(*mem + mempos) : mempos + SizeOf(Byte)
     
      ;Bit size is normally the same as the color resolution.
      ;i.e. 8 for 256 colors
      If LZWCodeSize<2 Or LZWCodeSize>8
        FreeMemory(*mem)
        Debug "GIF 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)
        FreeMemory(*mem)
        Debug "GIF 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=GIF_NextCode(*mem, mempos, @newpos,CharBuff(),CodeMask(),cl)
        mempos = newpos
        If cc<0 ;If a file error, return without completing the decode
          FreeMemory(lpBUFF)
          FreeMemory(*mem)
          Debug "GIF Load Error!GIF image contained an in-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=GIF_NextCode(*mem, mempos, @newpos, CharBuff(), CodeMask(),cl)
            mempos = newpos
          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
            GIF_OutLine(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
              GIF_OutLine(lpBUFF,width,height,cl)
              *lpBuffPtr=lpBUFF
              BufCnt=width
            EndIf
          Wend
         
        EndIf
       
      Wend
     
      If BufCnt<>width ;If there are any left, output the bytes
        GIF_OutLine(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
      hImage = GIF_CreateDIImage(*dib, TransColorIndex)
      pbimage=CreateImage(#PB_Any,realwidth,realheight, 32, #PB_Image_Transparent)
      StartDrawing(ImageOutput(pbimage))
      DrawingMode(#PB_2DDrawing_AlphaBlend)
      ; For some retarded reason, we have to draw and redraw the GIF frames over the previous image imagenumber-1
     
      ;   If bUseGlobalColMap ; if a local color table, then draw previous image in array, and then dray new hbitmap with transparency
      ;     Box(0,0,realwidth,realheight,$FFFFFF)
      ;     DrawImage(imageArray(numberimages-1),0,0)
      ;     If tflag=1
      ;       ;loc
      ;       DrawTransparentImage(drawdc,hBitmap,im\imLeft,im\imTop,im\imWidth,im\imHeight,transcolor)
      ;     Else
      ;       DrawImage(hBitmap,im\imLeft,im\imTop,im\imWidth,im\imHeight)
      ;     EndIf
      ;   Else
     
      If disposalmethod = 1
        ;Box(0,0,realwidth,realheight,$FFFFFF)
        DrawImage(ImageID(GIF_Frames(numberimages-1)\Image),0,0)
        DrawImage(ImageID(hImage),im\imLeft,im\imTop,im\imWidth,im\imHeight)
      ElseIf disposalmethod = 2
        ;Box(0,0,realwidth,realheight,$FFFFFF)
        ;DrawImage(ImageID(GIF_Frames(1)),0,0)
        DrawImage(ImageID(hImage),im\imLeft,im\imTop,im\imWidth,im\imHeight)
      Else
        ;Box(0,0,realwidth,realheight,$FFFFFF)
        DrawImage(ImageID(GIF_Frames(numberimages-1)\Image),0,0)
        ;DrawImage(hBitmap,im\imLeft,im\imTop)
        DrawImage(ImageID(hImage),im\imLeft,im\imTop,im\imWidth,im\imHeight)
      EndIf
      ;   EndIf
      StopDrawing()
      FreeImage(hImage)
      FreeMemory(hDIB) ;Free the DIB
      ReDim GIF_Frames(numberimages)
      GIF_Frames(numberimages)\Image = pbimage
      GIF_Frames(numberimages)\DelayTime = delaytime
      numberimages + 1
    Wend
    FreeMemory(*mem)
    ProcedureReturn numberimages
  EndProcedure
EndModule
« Last Edit: October 27, 2015 by Omnikam »