listing hundreds of tabs in PureBasic forum, trying tens of ways of choosing the problem did not give the wanted result.
I have tried GDI+ and GraphicMagic with following codes:
Code: Select all
*image3 = ScaleImage(*image, 300, 300, @ExceptionInf)
If *image3
PokeS(@*image3\filename[0], OutFile$ + "_scale.jpg", -1, #PB_Ascii)
If WriteImage(*imageInfo, *image3)
Debug "Scale Ok"
EndIf
DestroyImage(*image3)
Else
Debug PeekS(ExceptionInf\description, -1, #PB_Ascii)
EndIf
*image3 = SampleImage(*image, 300, 300, @ExceptionInf)
If *image3
PokeS(@*image3\filename[0], OutFile$ + "_sample.jpg", -1, #PB_Ascii)
If WriteImage(*imageInfo, *image3)
Debug "Sample Ok"
EndIf
DestroyImage(*image3)
EndIf
and:
Code: Select all
Procedure GDIp_GetEncoderClsid(libGDI, format$, *Clsid.CLSID)
Protected number
Protected Size
Protected *pImageCodecInfo.ImageCodecInfo
Protected i, *memory
CallFunction(libGDI,"GdipGetImageEncodersSize",@number, @Size)
If Size = 0
ProcedureReturn -1
EndIf
*memory = AllocateMemory(Size)
If *memory = #Null
ProcedureReturn -1
EndIf
*pImageCodecInfo = *memory
CallFunction(libGDI,"GdipGetImageEncoders",number, Size, *pImageCodecInfo)
For i = 1 To number
If format$ = PeekS(*pImageCodecInfo\MimeType, -1, #PB_Unicode)
CopyMemory(*pImageCodecInfo\clsid, *Clsid, SizeOf(CLSID))
FreeMemory(*memory)
ProcedureReturn i
EndIf
*pImageCodecInfo + SizeOf(ImageCodecInfo)
Next
FreeMemory(*memory)
ProcedureReturn -1
EndProcedure
Procedure.l GDIp_HBitmap2File(libGDI, *image, sFile$, *encoderCLSID.GUID, Compression = 0)
Define Result.i = CallFunction(libGDI,"GdipSaveImageToFile",*Image, StringToBStr(sFile$), *encoderCLSID, Compression)
ProcedureReturn Result
EndProcedure
Procedure.l GDIp_HBitmap2AutoFile(libGDI, *image, sFile$)
Define encoderCLSID.GUID
Define ext$ = LCase(GetExtensionPart(sFile$))
If ext$ = "bmp" Or ext$ = "jpg" Or ext$ = "jpeg" Or ext$ = "png" Or ext$ = "tif" Or ext$ = "gig"
Select ext$
Case "bmp"
GDIp_GetEncoderClsid(libGDI, #Bmp_Encoder, @encoderCLSID)
Case "jpg", "jpeg"
GDIp_GetEncoderClsid(libGDI, #Jpeg_Encoder, @encoderCLSID)
Case "png"
GDIp_GetEncoderClsid(libGDI, #Png_Encoder, @encoderCLSID)
Case "tif"
GDIp_GetEncoderClsid(libGDI, #Tif_Encoder, @encoderCLSID)
Case "gif"
GDIp_GetEncoderClsid(libGDI, #Gif_Encoder, @encoderCLSID)
EndSelect
GDIp_HBitmap2File(libGDI, *Image, sFile$, @encoderCLSID)
EndIf
EndProcedure
Procedure.f GDIp_GetHBitmapHOResolution(libGDI, *image)
Define hRes.f
CallFunction(libGDI,"GdipGetImageHorizontalResolution",*image, @hRes)
ProcedureReturn hRes
EndProcedure
Procedure.f GDIp_GetHBitmapVEResolution(libGDI, *image)
Define vRes.f
Define Result.i = CallFunction(libGDI,"GdipGetImageVerticalResolution",*image, @vRes)
ProcedureReturn vRes
EndProcedure
Procedure GDIp_SetHBitmapResolution(libGDI, *image, xdpi.f, ydpi.f)
Define Result.i = CallFunction(libGDI,"GdipBitmapSetResolution",*image, xdpi, ydpi)
ProcedureReturn Result
EndProcedure
Define hRes.f = GDIp_GetHBitmapHOResolution(libGDI, *image):Debug "hResolution : "+ StrF(hRes,0) +" DPI"
Define vRes.f = GDIp_GetHBitmapVEResolution(libGDI, *image):Debug "vResolution : "+ StrF(vRes,0) +" DPI"
GDIp_SetHBitmapResolution(libGDI, *image, 300, 300)
Define hRes.f = GDIp_GetHBitmapHOResolution(libGDI, *image):Debug "PostHorizontal resolution : "+ StrF(hRes,0) +" DPI"
Define vRes.f = GDIp_GetHBitmapVEResolution(libGDI, *image):Debug "PostVertical resolution : "+ StrF(vRes,0) +" DPI"
Define sFile$ = GetPathPart(file$)+GetFilePart(file$, #PB_FileSystem_NoExtension)+"_300."+"bmp"
GDIp_HBitmap2AutoFile(libGDI, *image, sFile$)
Code: Select all
Procedure SetChunk_pHYs(*mem, dpi)
!mov eax, [p.v_dpi]
; convert dpi to pixels / meter
!mov ecx, 0x9d7af5ec
!mul ecx
!add eax, 0x02000000
!adc edx, 0
!shrd eax, edx, 26
; calculate crc
!bswap eax
!mov ecx, 0x69789a9c
!mov edx, 64
!.l0:
!test edx, 31
!jnz .l1
!xor ecx, eax
!.l1: shr ecx, 1
!jnc .l2
!xor ecx, 0xedb88320
!.l2: sub edx, 1
!jnz .l0
!xor ecx, 1
!mov edx, 8
!.l3: shr ecx, 1
!jnc .l4
!xor ecx, 0xedb88320
!.l4: sub edx, 1
!jnz .l3
!not ecx
!bswap ecx
CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
!mov rdx, [p.p_mem]
!mov dword [rdx], 0x09000000 ; length
!mov dword [rdx+4], 0x73594870 ; type
!mov dword [rdx+8], eax ; data (9 bytes)
!mov dword [rdx+12],eax
!mov byte [rdx+16],1
!mov dword [rdx+17],ecx ; crc
CompilerElse
!mov edx, [p.p_mem]
!mov dword [edx], 0x09000000 ; length
!mov dword [edx+4], 0x73594870 ; type
!mov dword [edx+8], eax ; data (9 bytes)
!mov dword [edx+12],eax
!mov byte [edx+16],1
!mov dword [edx+17],ecx ; crc
CompilerEndIf
EndProcedure
Procedure PNG_SetDPI(PNGFile.s, dpi)
If FileSize(PNGFile) > 0
UsePNGImageEncoder()
UsePNGImageDecoder()
imgPNG = LoadImage(#PB_Any, PNGFile)
If IsImage(imgPNG)
*PNGData = EncodeImage(imgPNG, #PB_ImagePlugin_PNG)
*pHYsChunk = AllocateMemory(21)
SetChunk_pHYs(*pHYsChunk, dpi); 300 dpi
FreeImage(imgPNG)
pngHandle = CreateFile(#PB_Any, PNGFile)
WriteData(pngHandle, *PNGData, 33)
WriteData(pngHandle, *pHYsChunk, 21)
WriteData(pngHandle, *PNGData + 33, MemorySize(*PNGData)-33)
CloseFile(pngHandle)
FreeMemory(*pHYsChunk)
FreeMemory(*PNGData)
Debug "Done"
Else
Debug "Failed2LoadPNG"
EndIf
Else
Debug "Failed2OpenFile"
EndIf
EndProcedure