Interactive PowerBasic Forum
Purebasic-Tipps and Code => Purebasic-Code => Topic started by: Theo Gottwald on November 14, 2023, 08:12:10 AM
QuoteThe following procedure in Purebasic will resize an loaded image in that way that the smaller side (x or y) will be upscaled to 512 pixels keeping the aspect ratio, if the picture size of the smaller side is smaller then 512 Pixels.
This option should be possibly deactivated using a parameter. And the resulting picture must be a JPG.
ProcedureDLL.s EnsureAndResizeJPG(FilePath.s, ResizeFlag.l = 1)
Protected.s FileExtension, TempFilePath, ErrorMessage
Protected.l ImageID, SaveResult, ResizeResult
Protected.f AspectRatio, NewWidth.f, NewHeight.f
Protected.i OriginalWidth, OriginalHeight, SmallerSide
FilePath = Trim(FilePath)
; Extract the file extension
FileExtension = LCase(ExtractFileExtension(FilePath))
; Check if the file exists
If Not FileExist(FilePath)
ErrorMessage = "Failed to load image: " + FilePath
Goto ExitPoint
EndIf
; Load the image
ImageID = LoadImage(#PB_Any, FilePath)
If ImageID = 0
ErrorMessage = "Failed to load image: " + FilePath
Goto ExitPoint
EndIf
; Get original dimensions
OriginalWidth = ImageWidth(ImageID)
OriginalHeight = ImageHeight(ImageID)
AspectRatio = OriginalWidth / OriginalHeight
; Determine the smaller side
SmallerSide = Min(OriginalWidth, OriginalHeight)
; If the file is a JPG and the smaller side is larger than 511 pixels, retain the original file
If FileExtension = "jpg" Or FileExtension = "jpeg"
If SmallerSide > 511
TempFilePath = FilePath
Goto ExitPoint
EndIf
EndIf
; Resize if the smaller side is less than 512 pixels and ResizeFlag is set
If ResizeFlag And SmallerSide < 512
If OriginalWidth <= OriginalHeight
NewWidth = 512
NewHeight = NewWidth / AspectRatio
Else
NewHeight = 512
NewWidth = NewHeight * AspectRatio
EndIf
ResizeResult = ResizeImage(ImageID, NewWidth, NewHeight, #PB_Image_Smooth)
If ResizeResult = 0
ErrorMessage = "Failed to resize image."
Goto ExitPoint
EndIf
EndIf
; Generate a unique file name for the temporary JPG file
TempFilePath = GetTempFileNameWithExtension("jpg")
If Len(TempFilePath) = 0
ErrorMessage = "Failed to generate a unique filename."
Goto ExitPoint
EndIf
; Save the image as a JPG
SaveResult = SaveImage(ImageID, TempFilePath, #PB_ImagePlugin_JPEG)
If SaveResult = 0
ErrorMessage = "Failed to save temporary JPG file: " + TempFilePath
Goto ExitPoint
EndIf
; Free the loaded image
FreeImage(ImageID)
; No errors encountered
ErrorMessage = ""
ExitPoint:
If Len(ErrorMessage) > 0
Set_Error(ErrorMessage)
TempFilePath = ""
EndIf
; Single exit point
ProcedureReturn TempFilePath
EndProcedure