LOAD PNG TO IMAGE

New to FreeBASIC? Post your questions here.
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: LOAD PNG TO IMAGE

Post by UEZ »

dodicat wrote:If you use windows, then keeping things as simple as possible, please try this.
Does other formats also.

Code: Select all

#if sizeof(integer)=8
#include "windows.bi"
#endif
#Include  "win/gdiplus.bi"

#include "file.bi"
'An idea from UEZ in another thread.
Function Pload(Picture as String,byref i as any ptr=0) as long
   Dim As uinteger TMP 
   GDIPLUS.GdiplusStartup(@TMP,@type<GDIPLUS.GDIPLUSSTARTUPINPUT>(1),0)
   Dim as any Ptr Img
   if GDIPLUS.GdipLoadImageFromFile(Picture,@Img)>0 then return 0
   Dim As Single w,h
   GDIPLUS.GdipGetImageDimension(Img,@w,@h)
   if w*h=0 then return 0
   Dim As GDIPLUS.BitmapData Pdata
   Dim As Rect R=Type(0,0,w-1,h-1)
   GDIPLUS.GdipBitmapLockBits(Img,Cast(Any Ptr,@R),GDIPLUS.ImageLockModeRead,PixelFormat32bppARGB,@Pdata)
   For y as long = 0 To h-1
      For x as long = 0 To w-1 
           pset i,(x,y),Cast(ulong Ptr,Pdata.Scan0)[y*w+x]
      Next
   Next
return w*h
End Function

sub getsize(picture as string,byref w as single,byref h as single) 'unused
    Dim As uinteger TMP 
   GDIPLUS.GdiplusStartup(@TMP,@type<GDIPLUS.GDIPLUSSTARTUPINPUT>(1),0)
   Dim as any Ptr Img
   if GDIPLUS.GdipLoadImageFromFile(Picture,@Img)>0 then exit sub
   GDIPLUS.GdipGetImageDimension(Img,@w,@h)
end sub

screen 20,32
'get the desired image size and load the file to it
dim as single w,h

dim as string picture="bob.png"
if fileexists(picture)=0 then print picture + "  not found"
getsize(picture,w,h)

dim as any ptr i=imagecreate(w,h)
Pload(picture,i)
put(0,0),i,pset
sleep
imagedestroy i

 
 

Additionally, here the save function using GDIPlus:

Code: Select all

'Coded by UEZ build 2019-01-13

#Ifdef __Fb_64bit__
    #Inclib "gdiplus"
    #Include Once "win/gdiplus-c.bi"
#Else
    #Include Once "win/gdiplus.bi"
    Using gdiplus
#Endif


Declare Function ImageSave(Image As Any Ptr, Filename As Wstring, JPGQual As Ulong = 80) As Boolean

'' Create 32-Bit graphics Screen And image.
Dim As Ushort w = 640, h = 640, ww = 512, hh = 512
Screenres w, h, 32
Dim image As Any Ptr = Imagecreate(ww, hh)

Dim pitch As Integer
Dim pixels As Any Ptr

'' Get enough information To iterate through the pixel Data.
If 0 <> Imageinfo(image, ,,, pitch, pixels) Then
    Print "unable To retrieve image information."
    Sleep
    End
End If

'' Draw a pattern on the image by directly manipulating pixel memory.
For y As Integer = 0 To hh - 1
    Dim row As Ulong Ptr = pixels + y * pitch
    For x As Integer = 0 To ww - 1
        row[x] = Rgba(x Shl 1, y Shl 1, (x Xor y) Shl 1, 255 Xor (x Xor y))
    Next x
Next y

'' Draw the image onto the Screen.
Put ((w - ww) Shr 1, (h - hh) Shr 1), image

ImageSave(image, "Test.bmp")
ImageSave(image, "Test.gif")
ImageSave(image, "Test.jpg", 5)
ImageSave(image, "Test.png")
ImageSave(image, "Test.tif")


'' Destroy the image.
Imagedestroy image
? "Done."
Sleep

Function ImageSave(Image As Any Ptr, Filename As Wstring, JPGQual As Ulong = 80) As Boolean 'coded by UEZ
	Dim As Integer w, h, bypp, pitch
	Dim pixdata As Any Ptr
	If Imageinfo(Image, w, h, bypp, pitch, pixdata) <> 0 Then Return False
	
	#Define PixelGet(_x, _y)	(*Cptr(Ulong ptr, pixdata + (_y) * pitch + (_x) Shl 2))
	
	Dim GDIPlusStartupInput As GDIPLUSSTARTUPINPUT 
	Dim As ULONG_PTR GDIPlusToken 
	GDIPlusStartupInput.GdiplusVersion = 1   
	If (GdiplusStartup(@GDIPlusToken, @GDIPlusStartupInput, NULL) <> 0) Then Return 0
	Dim As Uinteger  x, y, RowOffset
	Dim As Any Ptr hBitmap
	Dim As BitmapData tBitmapData
	Dim As Rect tRect = Type(0, 0, w - 1, h - 1)
	GdipCreateBitmapFromScan0(w, h, 0, PixelFormat32bppARGB, 0, @hBitmap)
	GdipBitmapLockBits(hBitmap, Cast(Any Ptr, @tRect), ImageLockModeWrite, PixelFormat32bppARGB, @tBitmapData)
	For y = 0 To h - 1
		RowOffset = y * w
		For x = 0 To w - 1
			Cast(ULong Ptr, tBitmapData.Scan0)[RowOffset + x] = PixelGet(x, y)
		Next      
	Next
	GdipBitmapUnlockBits(hBitmap, @tBitmapData)
   
	Dim As Byte iErr = 0

	Dim As Ulong count, size
	GdipGetImageEncodersSize(@count, @size)
   
	Dim As CLSID clsid
	Dim As ImageCodecInfo Ptr pImageCodecInfo
	pImageCodecInfo = Allocate(size)
	GdipGetImageEncoders(count, size, pImageCodecInfo)
	
	#Define _MimeType(x)	(*Cast(Wstring Ptr, pImageCodecInfo[x].MimeType))
	#Define FnSuffix	(Right(Filename, 4))	
	
	For i As Ulong = 0 To count - 1
		If _MimeType(i) = "image/bmp" And FnSuffix = ".bmp" Then
			If (GdipSaveImageToFile(hBitmap, Wstr(Filename), @pImageCodecInfo[i].Clsid, NULL) <> 0) Then iErr += 1
		Elseif _MimeType(i) = "image/jpeg" And (FnSuffix = ".jpg" Or Right(Filename, 5) = ".jpeg") Then
			JPGQual = Iif(JPGQual < 0, 0, Iif(JPGQual > 100, 100, JPGQual))
			Dim tParams As EncoderParameters
			Dim EncoderQuality As String = "{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"
			tParams.Count = 1
			CLSIDFromString(Wstr(EncoderQuality), @tParams.Parameter(0).GUID)
			With tParams.Parameter(0)
				.NumberOfValues = 1
				.Type = EncoderParameterValueTypeLong
				.Value = Varptr(JPGQual)
			End With
			If GdipSaveImageToFile(hBitmap, Wstr(Filename), @pImageCodecInfo[i].Clsid, @tParams) <> 0 Then iErr += 1          
		Elseif _MimeType(i) = "image/gif" And FnSuffix = ".gif" Then
			If (GdipSaveImageToFile(hBitmap, Wstr(Filename), @pImageCodecInfo[i].Clsid, NULL) <> 0) Then iErr += 1
		Elseif _MimeType(i) = "image/tiff" And (FnSuffix = ".tif" Or Right(Filename, 5) = ".tiff") Then
			If (GdipSaveImageToFile(hBitmap, Wstr(Filename), @pImageCodecInfo[i].Clsid, NULL) <> 0) Then iErr += 1
		Elseif _MimeType(i) = "image/png" And FnSuffix = ".png" Then
			If (GdipSaveImageToFile(hBitmap, Wstr(Filename), @pImageCodecInfo[i].Clsid, NULL) <> 0) Then iErr += 1     
		Else
			iErr += 1
		End If
	Next

	Deallocate(pImageCodecInfo)

	GdipDisposeImage(hBitmap)
	GdiplusShutdown(GDIPlusToken)
	If iErr > 0 Then Return False

	Return True
End Function
Edit1: added 32-bit support
Michele16
Posts: 3
Joined: Dec 17, 2019 12:44

Re: LOAD PNG TO IMAGE

Post by Michele16 »

Thanks for this code. I tried it, it works well.
But the procedure GDIPLUS.GdipBitmapLockBits() takes memory according to the size of the clipart, and this memory is not restored by imagedestroy…
Is there a simple way to debug that (to restore the memory)?
Josep Roca
Posts: 564
Joined: Sep 27, 2016 18:20
Location: Valencia, Spain

Re: LOAD PNG TO IMAGE

Post by Josep Roca »

The memory used by the temporary buffer created by GdipBitmapLockBits is freed when you call GdipBitmapUnlockBits. GdipBitmapLockBits and GdipBitmapUnlockBits must always be used as a pair.
Michele16
Posts: 3
Joined: Dec 17, 2019 12:44

Re: LOAD PNG TO IMAGE

Post by Michele16 »

Thank you for your help. I tried, but, unfortunaly, GdipBitmapUnlockBits() don't free the memory, even with Imagedestroy().
What is missing?
Michele16
Posts: 3
Joined: Dec 17, 2019 12:44

Re: LOAD PNG TO IMAGE

Post by Michele16 »

I think it was missing GdipDisposeImage() . With that all seem OK
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: LOAD PNG TO IMAGE

Post by D.J.Peters »

You can use fbImage with Windows and Linux 32/64-bit and no runtime library needed (it's a static lib).
You can load png, jpg, tga, bmp, dds ... as fbgfx image from file or from memory.
You can save your fbgfx image as png file (optinal with alpha channel) also.

Joshy
Post Reply