LOAD PNG TO IMAGE

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

Re: LOAD PNG TO IMAGE

Postby UEZ » Jan 13, 2019 13:12

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

Postby Michele16 » Dec 17, 2019 13:06

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: 492
Joined: Sep 27, 2016 18:20
Location: Valencia, Spain

Re: LOAD PNG TO IMAGE

Postby Josep Roca » Dec 17, 2019 14:20

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

Postby Michele16 » Dec 18, 2019 8:37

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

Postby Michele16 » Dec 18, 2019 8:50

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

Re: LOAD PNG TO IMAGE

Postby D.J.Peters » Dec 18, 2019 14:11

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

Return to “Beginners”

Who is online

Users browsing this forum: No registered users and 4 guests