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