[Windows] Load/save GIF images
Posted: Mon Oct 14, 2013 8:45 pm
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
