[Windows] Load/save GIF images

[netmaestro]

Someone asked about coding images to GIF recently and I dug out my 256bitcolors code. Looking it over, I realized that with the recent updates to PureBasic, most of the work my code was doing is now native. I was converting an image to 8bits depth using a colortable generated with Anthony Dekker's NeuQuant code (ported to PB by luis) and applying a Floyd-Steinberg dither. Since PureBasic 5.10's EncodeImage arrived, the compiler will do all this for you. So I thought I'd put EncodeImage to use in a GIF converter for those who want to save images as GIF. Or you can rip the LoadGIF code from it for use in loading GIF images into your programs. Here it is, please let me know of any bugs or omissions:

Code: Select all

;////////////////////////////////////////////////////////////////////////////////////
;
; Library:                  GIF image loader/saver
;
; Author:                   Lloyd Gallant (netmaestro)
; 
; Date:                     October 14, 2013
;
; Compiler version:         PureBasic 5.10 and later (EncodeImage)
;
; License:                  Usage is unrestricted
;                           No Warranty expressed Or implied
;
;////////////////////////////////////////////////////////////////////////////////////

Declare ConvertTo8Bit(hImageIn, dither=1)
Declare LoadGIF(imagenumber, *hImageIn, inpath$)
Declare SaveGIF(hImageIn, outpath$)

UsePNGImageDecoder()
UseJPEGImageDecoder()
UseJPEG2000ImageDecoder()
UseTIFFImageDecoder()
UsePNGImageEncoder()

pattern$ = "PNG, BMP, JPEG, TIFF|*.png;*.bmp;*.jpg;*.jpeg;*.tiff|PNG (*.png)|*.png|BMP (*.bmp)|*.bmp|JPEG (*.jpg)|*.jpg|TIFF (*.tif)|*.tif"
inpath$ = OpenFileRequester("Choose an image to convert to GIF:","",pattern$, 0)
prompt$ = RemoveString(GetFilePart(inpath$),"."+GetExtensionPart(inpath$))
prompt$ +".gif"
If FileSize(inpath$) < 1
  MessageRequester("Info:","No file selected. Ending...",#MB_ICONINFORMATION)
  End
EndIf

If inpath$
  hImage = LoadImage(#PB_Any, inpath$) 
Else
  End
EndIf

*hImage8 = ConvertTo8bit(hImage) 

If *hImage8
  pattern$ = "GIF (*.gif)|*.gif;"
  outpath$ = SaveFileRequester("Choose a path to save the .gif file:",prompt$,pattern$, 0)
  outpath$ = RemoveString(outpath$, ".gif")
  If outpath$
    outpath$ + ".gif"
    result = SaveGIF(*hImage8, outpath$)
  Else
    MessageRequester("","No save location chosen... ending.")
  EndIf
Else
  MessageRequester("Error:","Problem encoding image... ending.")
EndIf

If result
  If MessageRequester("Success!","Image successfully converted and saved as "+outpath$+" Would you like to view it now?", #PB_MessageRequester_YesNo)
    ReadFile(0, outpath$)
    *this = AllocateMemory(Lof(0))
    If *this 
      ReadData(0, *this, Lof(0))
      imagefromgif = LoadGIF(#PB_Any, *this, outpath$)
      If imagefromgif
        OpenWindow(0,0,0,ImageWidth(imagefromgif), ImageHeight(imagefromgif),"GIF Viewer - "+outpath$, #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
        ImageGadget(0,0,0,0,0,ImageID(imagefromgif))
        Repeat:Until WaitWindowEvent() = #PB_Event_CloseWindow
      EndIf
    EndIf
  EndIf
  
Else
  MessageRequester("Error:","Problem saving image... ending.")
EndIf

Procedure ConvertTo8Bit(hImageIn, dither=1)
  *result = EncodeImage(hImageIn, #PB_ImagePlugin_PNG, #PB_Image_FloydSteinberg, 8)
  ProcedureReturn *result
EndProcedure

;=============================================================
;{            Gdiplus GIFstuff Section
;=============================================================

Prototype GdiplusStartup( *token, *input, mode ) 
Prototype GdipCreateBitmapFromStream(stream.ISTREAM, *image)
Prototype GdipSetImagePalette(*image, *palette)
Prototype GdipSaveImageToFile(*image, *path, *clsid, *enc)
Prototype GdipGetImageWidth(*image, *width)
Prototype GdipGetImageHeight(*image, *height)
Prototype GdipCreateFromHDC( hdc, *gfx) 
Prototype GdipDrawImageRectI( *gfx, *image, x, y, Width, Height ) 
Prototype GdipDeleteGraphics( *gfx )
Prototype GdipDisposeImage( *image ) 
Prototype GdiplusShutdown( *token ) 

CompilerIf Defined(GdiplusStartupInput, #PB_Structure) = 0
  Structure GdiplusStartupInput 
    GdiPlusVersion.l 
    *DebugEventCallback.Debug_Event
    SuppressBackgroundThread.l 
    SuppressExternalCodecs.l 
  EndStructure 
CompilerEndIf  

Structure StreamObject
  block.l
  *bits
  stream.ISTREAM
EndStructure

Procedure LoadGIF(imagenumber, *hImageIn, inpath$)
  Protected *token, lib.i, width.i, height.i, *gfx
  Protected Stream.StreamObject
  Protected input.GdiplusStartupInput
  input\GdiPlusVersion = 1
  
  lib = OpenLibrary(#PB_Any, "gdiplus.dll")
  If Not lib
    MessageRequester("Error","Required component gdiplus.dll is not found. Please install it and retry    ", #MB_ICONERROR)
    ProcedureReturn
  EndIf
  
  GdiplusStartup.GdiplusStartup                           = GetFunction( lib, "GdiplusStartup" )          
  GdipCreateBitmapFromStream.GdipCreateBitmapFromStream   = GetFunction( lib, "GdipCreateBitmapFromStream") 
  GdipGetImageWidth.GdipGetImageWidth                     = GetFunction( lib, "GdipGetImageWidth")
  GdipGetImageHeight.GdipGetImageHeight                   = GetFunction( lib, "GdipGetImageHeight")
  GdipCreateFromHDC.GdipCreateFromHDC                     = GetFunction( lib, "GdipCreateFromHDC" )
  GdipDrawImageRectI.GdipDrawImageRectI                   = GetFunction( lib, "GdipDrawImageRectI" )
  GdipDeleteGraphics.GdipDeleteGraphics                   = GetFunction( lib, "GdipDeleteGraphics" )  
  GdipDisposeImage.GdipDisposeImage                       = GetFunction( lib, "GdipDisposeImage" )        
  GdiplusShutdown.GdiplusShutdown                         = GetFunction( lib, "GdiplusShutdown" )    
  
  GdiplusStartup( @*token, @input, #Null)
  
  Length = MemorySize(*hImageIn)
  Stream\block = GlobalAlloc_(#GHND, Length)
  Stream\bits = GlobalLock_(Stream\block)
  CopyMemory(*hImageIn, stream\bits, Length)
  If CreateStreamOnHGlobal_(stream\bits, 0, @Stream\stream) = #S_OK
    GdipCreateBitmapFromStream(Stream\stream , @*gifcandidate)
  Else
    GdiplusShutdown(*token)
    CloseLibrary(lib)
    ProcedureReturn 0
  EndIf
  
  GdipGetImageWidth(*gifcandidate, @width)
  GdipGetImageHeight(*gifcandidate, @height)
  
  If imagenumber = #PB_Any
    result = CreateImage(#PB_Any, width, height, 24)
  Else
    CreateImage(imagenumber, width, height, 24)
    result = imagenumber
  EndIf
  
  hdc=StartDrawing(ImageOutput(result))
    GdipCreateFromHDC( hdc, @*gfx)
    GdipDrawImageRectI(*gfx, *gifcandidate, 0, 0, width, height)
  StopDrawing()
  
  Stream\stream\Release()
  GlobalUnlock_(Stream\bits)
  GlobalFree_(Stream\block)
  
  GdipDeleteGraphics(*gfx)  
  GdipDisposeImage(*gifcandidate)
  GdiplusShutdown(*token)
  CloseLibrary(lib)
  
  ProcedureReturn result
  
EndProcedure

Procedure SaveGIF(*hImageIn, outpath$)
  Protected *token, lib
  Protected Stream.StreamObject
  Protected input.GdiplusStartupInput
  input\GdiPlusVersion = 1
  
  lib = OpenLibrary(#PB_Any, "gdiplus.dll")
  If Not lib
    MessageRequester("Error","Required component gdiplus.dll is not found. Please install it and retry    ", #MB_ICONERROR)
    ProcedureReturn
  EndIf
  
  GdiplusStartup.GdiplusStartup                           = GetFunction( lib, "GdiplusStartup" )          
  GdipCreateBitmapFromStream.GdipCreateBitmapFromStream   = GetFunction( lib, "GdipCreateBitmapFromStream") 
  GdipSaveImageToFile.GdipSaveImageToFile                 = GetFunction( lib, "GdipSaveImageToFile" )
  GdipDisposeImage.GdipDisposeImage                       = GetFunction( lib, "GdipDisposeImage" )        
  GdiplusShutdown.GdiplusShutdown                         = GetFunction( lib, "GdiplusShutdown" )    
  
  GdiplusStartup( @*token, @input, #Null)
  
  Length = MemorySize(*hImageIn)
  Stream\block = GlobalAlloc_(#GHND, Length)
  Stream\bits = GlobalLock_(Stream\block)
  CopyMemory(*hImageIn, stream\bits, Length)
  If CreateStreamOnHGlobal_(stream\bits, 0, @Stream\stream) = #S_OK
    GdipCreateBitmapFromStream(Stream\stream , @*gifcandidate)
  Else
    GdiplusShutdown(*token)
    CloseLibrary(lib)
    ProcedureReturn 0
  EndIf
  
  CompilerIf #PB_Compiler_Unicode = 0
    Unicode$=Space(Len(outpath$)*2+2)
    PokeS(@Unicode$, outpath$, -1, #PB_Unicode) 
    *outpath = SysAllocString_(@Unicode$) 
  CompilerElse
    *outpath = @outpath$
  CompilerEndIf
  
  If GdipSaveImageToFile( *gifcandidate, *outpath, ?clsid_gif, 0) = #S_OK 
    result = #True 
  Else
    result = #False
  EndIf
  
  Stream\stream\Release()
  GlobalUnlock_(Stream\bits)
  GlobalFree_(Stream\block)  
  
  GdipDisposeImage(*gifcandidate)
  GdiplusShutdown(*token)
  CloseLibrary(lib)
  
  ProcedureReturn result
  
EndProcedure

DataSection 
  clsid_gif: ; clsid for gif image format 
  Data.l $557cf402 
  Data.w $1a04 
  Data.w $11d3 
  Data.b $9a,$73,$00,$00,$f8,$1e,$f3,$2e 
EndDataSection 

[davido]

@netmaestro,

Works like magic! Thank you for sharing.

Just one question, if I may:

In another thread you seemed to indicate that this version would not require a dll, yet line 182 would seem to indicate otherwise. Am I missing something?

[jassing]

this version would not require a dll, yet line 182

Probably meant that it would not require any "3rd party" dll's -- gdiplus.dll is a standard windows file...

[davido]

@jassing,

Thank you for the explanation; I guess you are right.
Checking my system I found 24 instances of it!

[Kwai chang caine]

I have try your code and it works very well.
For try i have use a picture at random

This is the résult:


So like you see, obviously like i start from a BMP, i have a static picture and loose your splendid smile that i admire since 8 years

If a day you can do this miracle to copy/paste and load/save a animated GIF...i maried you

So thanks a lot, for sharing

[netmaestro]

I'm definitely considering adding multiple frames and creating a sort of gif animation studio but right now I'm fighting with adding transparency. Currently it's winning but I ripped the page out of my dictionary with the word quit on it

[Kwai chang caine]

If it's difficult for THE maestro of the net...i begin to understand why FRED have never create the GIF plugin
Numerous big programmers have fought with the GIF format, and nobody have really win against them

It's incredible that, at the time of the 3D, and other splendides technology, the GIF is always so much mysterious
The GIF is a little bite the MD5 of the picture
And again..the MD5 is nearly not a mystery now ....

So thanks again for all the great help you give since all this time
Have a good day