Load GIF into PB

[Adaz]

I really need to load GIF's into PB, so I've written a small routine.
It uses two free external programs:
gifsicle  http://www.lcdf.org/gifsicle/   for unoptimizing such gif's where the frames are not the same size
gif2png http://gnuwin32.sourceforge.net/downlinks/pngutils-bin-zip.php  for converting gif's to png's

I attached them, and a book.gif too.
The program unoptimizes then converts a gif animation to png images, then plays it.

Place all files to the same dir!

Code Select Expand


file$="book"

Dim img(1000)

If FileExist("gif2png.exe")=0: Print "gif2png.exe not found": Sync: WaitKey: End: EndIf
If FileExist("gifsicle.exe")=0: Print "gifsicle.exe not found": Sync: WaitKey: End: EndIf
If FileExist(file$+".gif")=0: Print file$+".gif not found": Sync: WaitKey: End: EndIf

;We create a bat file:
WriteFile "GIFconvert.bat",1
WriteString 1,"@echo off"
WriteString 1,Left$(dir$,2)
WriteString 1,"cd "+dir$
;Don't bother the original gif
WriteString 1,"ren "+file$+".gif "+file$+"old.gif"
;First we have to unoptimize the GIF file, because in the worst case in an optimized GIF every frame has a different size
WriteString 1,"gifsicle.exe -U "+file$+"old.gif -o "+file$+".gif --careful"
;We convert the unoptimized GIF to PNG frames
WriteString 1,"gif2png.exe -O "+file$+".gif"
;If the file "Finished" exitsts, the external program is finished.
WriteString 1,"echo >Finished"
CloseFile 1

;Run the batch
ExeFile "GIFconvert.bat",""

;Wait for the file "Finished"
Repeat
Cls 0: Print "Waiting for conversion to complete...": Sync
Until FileExist("Finished")
DeleteFile "Finished"
DeleteFile "GIFconvert.bat"

index=1
If FileExist(file$+".png")=0
Print "Conversion failed."
  Sync: WaitKey: End
Else
img(index)=GetFreeImage()
LoadImage file$+".png",img(index)
DeleteFile file$+".png"
EndIf

Do
If FileExist(file$+".p"+Digits$(index,2))
MoveFile file$+".p"+Digits$(index,2),file$+".png"
Inc index
img(index)=GetFreeImage()
LoadImage file$+".png",img(index)
DeleteFile file$+".png"
Else
  ExitDo
EndIf
Loop

DeleteFile file$+".gif"
MoveFile file$+"old.gif",file$+".gif"

i=1
Repeat
Cls 0
Print i
  DrawImage img(i),100,100,True
Sync
  Wait 100
  Inc i: If i>index: i=1: EndIf
Until LeftMouseButton()


[kevin]

or use Free Image

[Adaz]

Of course I've tried FreeImage, but we have a very old FreeImage.dll and wrapper in our Slib folder which doesn't load any gif's.
I downloaded the latest dll, but it displays this gif upside down, and don't know how to extract the frames or play this gif.
Please show me how to do this.

Thanks

[Adaz]

Load GIF with FreeImage (LGFI)

Solved.

1. Download the latest FreeImage.dll from http://freeimage.sourceforge.net/download.html

2. Insert these lines into your FreeImage.pba in Slib folder:

Code Select Expand

Constant FreeImage_GIF_DEFAULT=0
Constant FreeImage_GIF_LOAD256=1
Constant FreeImage_GIF_PLAYBACK=2

FreeImage_GetPageCount(bitmap) Alias "_FreeImage_GetPageCount@4" As Integer
FreeImage_CloseMultiBitmap(bitmap,flags) Alias "_FreeImage_CloseMultiBitmap@8" As Integer
FreeImage_LockPage(bitmap,page) Alias "_FreeImage_LockPage@8" As Integer
FreeImage_UnlockPage(bitmap,page,changed) Alias "_FreeImage_UnlockPage@12"
FreeImage_GetPixelColor(dib,x,y,valuepointer) Alias "_FreeImage_GetPixelColor@16" As Integer
FreeImage_OpenMultiBitmap(fif,File$,create_new,read_only,keep_cache_in_memory,Flags) Alias "_FreeImage_OpenMultiBitmap@24" As Integer


3. Download the attached book.gif

4. Run this example:

Code Select Expand

; PROJECT : LGFI
; AUTHOR  : Ádáz
; CREATED : 2008.02.11.
; EDITED  : 2008.02.11.
; ---------------------------------------------------------------------

#Include "FreeImage"

handle=FreeImage_OpenMultiFunction("book.gif") ;load multi bitmap

pcount=FreeImage_GetPageCount(handle)
Dim himage(pcount)

FreeImage_ReadMultiFunction(handle,pcount) ;read bitmap to image

FreeImage_CloseMultiBitmap(handle,0) ;free from memory

fdelay=100 ;anim image frame speed, millisecs

time=Timer()

frame=0

While Not LeftMouseButton()

If Timer()-time>fdelay
time=Timer()
  frame=frame+1
  If frame>=pcount Then frame=0
EndIf

Cls 0
DrawImage himage(frame),50,50,False

Text 0,0,"handle="+Str$(handle)+" image="+Str$(image)
Text 0,12,"pcount="+Str$(pcount)+" frame="+Str$(frame)+" fdelay="+Str$(fdelay)

Sync
EndWhile


Psub FreeImage_ReadMultiFunction(hdib,npages)

Local pcolor,hpage,width,height,himage,i,hclone,x,y

freebank=GetFreeBank()
CreateBank freebank,4
pcolor=GetBankPtr(freebank)
hpage=FreeImage_LockPage(hdib,0) ;load page 1 in memory
width=FreeImage_GetWidth(hpage)
height=FreeImage_GetHeight(hpage)
FreeImage_UnlockPage(hdib,hpage,0) ;free from memory

For i=0 To npages-1
himage(i)=GetFreeImage()
  CreateImage himage(i),width,height
Next i

For i=0 To npages-1
  hpage=FreeImage_LockPage(hdib,i) ;load next page in memory
  hclone=FreeImage_ConvertTo24Bits(hpage) ;copy to 24bits, no palette
  FreeImage_UnlockPage(hdib,hpage,0) ;free from memory

  RenderToImage himage(i) ;next image frame
  LockBuffer
  For y=0 To height-1
   For x=0 To width-1
    FreeImage_GetPixelColor(hclone,x,height-1-y,pcolor) ;invert y
    DotC x,y,PeekInt(pcolor) ;pixel value
   Next
  Next
  UnLockBuffer
  RenderToScreen

  FreeImage_Unload(hclone) ;free from memory
Next
DeleteBank freebank
EndPsub



Function FreeImage_OpenMultiFunction(filename$)
Local fif,hdib
fif=FreeImage_GetFIFFromFilename(filename$)
If fif>=0 ;format valid
  hdib=FreeImage_OpenMultiBitmap(fif,filename$,0,True,0,FreeImage_GIF_PLAYBACK) ;default=0
Else
  Message "Unknown file format."
EndIf
EndFunction hdib ;multi bitmap handle


Psub Message(s$)
Print s$
  Sync
  WaitKey: WaitNoKey
EndPsub

I ported this code to Playbasic from Blitzbasic. Code found at http://www.blitzbasic.com/codearcs/codearcs.php?code=1732

[Adaz]

No comment? Nobody cares this example?

[thaaks]

Perhaps nobody needs it at the moment...

I am sure you'll get feedback as soon as someone wants to use it and detects a bug  ;)
And normally people don't come back to tell you it's working great - they'll just use it and keep quiet...

Don't be sad - at least this thread has been read more than 50 times so some people are interested!

Cheers,
Tommy