; --------------------------------------------------------------
; Procedure: GenerateTempFilename
; Description: Generates a unique temporary filename using Windows API.
; Returns: Unique temporary filename or empty string on failure.
; --------------------------------------------------------------
;Declare GetTempFileNameA Lib "kernel32.dll" (lpPathName.s, lpPrefixString.s, uUnique.l, lpTempFileName.s) As Long
;Declare GetTempPathA Lib "kernel32.dll" (nBufferLength.l, lpBuffer.s) As Long
; --------------------------------------------------------------
; --------------------------------------------------------------
; This procedure generates a unique temporary filename.
; It uses the Windows API functions GetTempPathA and GetTempFileNameA to achieve this.
; Returns: Unique temporary filename with path as a string.
; --------------------------------------------------------------
Procedure.s GenerateTempFilename()
Protected tempBuffer.s = Space(256)
Protected tempPath.s = Space(256)
Protected UniqueTempFilePath.s
; Call the Windows API function to get the temporary file path
If GetTempPath_(256, @tempPath) = 0
Set_Error("Failed to get temporary path.")
ProcedureReturn ""
EndIf
tempPath = PeekS(@tempPath, StringByteLength(PeekS(@tempPath)), #PB_Ascii)
; Call the Windows API function to get a unique temporary filename
If GetTempFileName_(tempPath, "TMP", 0, @tempBuffer) <> 0
UniqueTempFilePath = PeekS(@tempBuffer, StringByteLength(PeekS(@tempBuffer)), #PB_Ascii)
Else
; Set error message if the API call fails
Set_Error("Failed to generate a unique temporary filename.")
UniqueTempFilePath = ""
EndIf
; Return the unique temporary filename
ProcedureReturn UniqueTempFilePath
EndProcedure
; --------------------------------------------------------------
; Function to generate a unique temporary filename with a given extension
;
Procedure.s GenerateUniqueTempFilename(TempFilePath.s, Extension.s)
Protected UniqueTempFilename.s
Protected Counter.l = 1
Protected MaxAttempts = 100000 ; Set a maximum limit for attempts
; Validate inputs
If Len(TempFilePath) = 0 Or Len(Extension) = 0
Set_Error("Invalid input: Either TempFilePath or Extension is empty.")
ProcedureReturn ""
EndIf
; Append the extension to the filename
UniqueTempFilename = TempFilePath + "." + Extension
; Check if the file already exists
While FileSize(UniqueTempFilename) <> -1
; Break if maximum attempts reached
If Counter >= MaxAttempts
Set_Error("Maximum attempts reached. Could not generate a unique filename.")
ProcedureReturn ""
EndIf
; If the file exists, append a counter to the filename and check again
UniqueTempFilename = TempFilePath + "_" + Str(Counter) + "." + Extension
Counter = Counter + 1
Wend
; At this point, UniqueTempFilename should be unique
ProcedureReturn UniqueTempFilename
EndProcedure
; --------------------------------------------------------------
; Sample usage
;tempFile = GetTempFileNameWithExtension("png")
;Debug "Temporary file with .png extension: " + tempFile
;
; Procedure to get a temporary filename with a specific extension using the Windows API
Procedure.s GetTempFileNameWithExtension(Extension.s = "")
Protected tempBuffer.s = Space(256)
Protected tempPath.s = Space(256)
Protected tempFileName.s
; Get the temp path
GetTempPath_(256, @tempPath)
tempPath = PeekS(@tempPath, StringByteLength(PeekS(@tempPath)), #PB_Ascii)
; Get a temporary file name
GetTempFileName_(tempPath, "TMP", 0, @tempBuffer)
tempFileName = PeekS(@tempBuffer, StringByteLength(PeekS(@tempBuffer)), #PB_Ascii)
; If an extension is provided, rename the file to have that extension
If Extension <> ""
tempFileName = GenerateUniqueTempFilename(tempFileName, Extension)
RenameFile(PeekS(@tempBuffer), tempFileName)
EndIf
ProcedureReturn tempFileName
EndProcedure
; --------------------------------------------------------------
;----------------------------------------------------------------
; Procedure: GenerateUniqueFilename
; Description: Generates a unique filename based on the given file path.
; If unable to generate a unique name in the same folder,
; it uses Windows API to generate a temporary file.
; --------------------------------------------------------------
; Generate a unique filename based on the original file path.
; If unable to do so, it will generate a unique temporary filename.
ProcedureDLL.s GenerateUniqueFilename(OriginalFilePath.s)
Protected UniqueFilePath.s, FileBase.s, FileExtension.s, Counter.l, Pos.l
Protected MaxAttempts = 100000
Protected ErrorMessage.s
Protected.l Attempt
; Extract base filename and extension
FileBase = GetFilePart(OriginalFilePath, #PB_FileSystem_NoExtension)
FileExtension = ExtractFileExtension(OriginalFilePath)
; Validate file extension
If Len(FileExtension) = 0
ErrorMessage = "Invalid file extension."
Goto enx
EndIf
; Extract counter from FileBase if present
Pos = FindString(FileBase, "_", -1)
If Pos > 0
Counter = Val(Right(FileBase, Len(FileBase) - Pos))
If Counter > 0
FileBase = Left(FileBase, Pos - 1)
Else
Counter = 1
EndIf
Else
Counter = 1
EndIf
; Try to generate a unique filename by appending a counter
For Attempt = 1 To MaxAttempts
UniqueFilePath = GetPathPart(OriginalFilePath) + FileBase + "_" + Str(Counter) + "." + FileExtension
If FileSize(UniqueFilePath) = -1
ErrorMessage = ""
Goto enx
EndIf
Counter = Counter + 1
Next Attempt
; If a unique name could not be generated, use GenerateUniqueTempFilename() to get a temp file
UniqueFilePath = GenerateUniqueTempFilename(GetTempFileNameWithExtension(FileExtension), FileExtension)
If Len(UniqueFilePath) = 0
ErrorMessage = "Failed to generate a unique filename."
Else
ErrorMessage = ""
EndIf
enx:
If Len(ErrorMessage) > 0
Set_Error(ErrorMessage)
UniqueFilePath = ""
EndIf
ProcedureReturn UniqueFilePath
EndProcedure
;--------------------------------------------------------------------
Procedure.s GetImageDimensions(FilePath.s)
Protected.l ImageID, Width, Height
Protected.s Dimensions, ErrorMessage.s
; Load the image
ImageID = LoadImage(#PB_Any, FilePath)
; Check if the image was loaded successfully
If ImageID = 0
ErrorMessage = "Failed to load image: " + FilePath
Goto enx
EndIf
; Get the dimensions of the image
Width = ImageWidth(ImageID)
Height = ImageHeight(ImageID)
; Validate the dimensions
If Width <= 0 Or Height <= 0
ErrorMessage = "Invalid image dimensions."
Goto enx
EndIf
; Concatenate the dimensions into a string
Dimensions = Str(Width) + "x" + Str(Height)
; Free the loaded image
FreeImage(ImageID)
enx:
; If there is an error message, set the error and return an empty string
If Len(ErrorMessage) > 0
Set_Error(ErrorMessage)
Dimensions = ""
EndIf
SD_Return=Dimensions
ProcedureReturn Dimensions
EndProcedure
;--------------------------------------------------------------------
; Returns Width from String "512x768"
; Returns Width from String "512x768"
Procedure.l GetWidthFromDimensions(Dimensions.s)
Protected.s WidthString
Protected.l Width, Pos, i
Protected Separators.s = "x,;"
Protected Separator.s
Protected ErrorMessage.s
; Trim the input string to remove any leading or trailing spaces
Dimensions = Trim(Dimensions)
; Loop through each possible separator
For i = 1 To Len(Separators)
Separator = Mid(Separators, i, 1)
Pos = FindString(Dimensions, Separator, 1)
If Pos > 0
Goto FoundSeparator
EndIf
Next i
; If no valid separator is found, set error message
ErrorMessage = "Invalid dimensions format: " + Dimensions
Goto enx
FoundSeparator:
; Extract the width substring from the dimensions string
WidthString = Left(Dimensions, Pos - 1)
; Check if the extracted string is numeric
If Not IsNumeric(WidthString)
ErrorMessage = "Invalid width value: " + WidthString
Goto enx
EndIf
; Convert the width substring to a long integer
Width = Val(WidthString)
; Validate if the width is a positive number
If Width <= 0
ErrorMessage = "Width must be a positive number."
Goto enx
EndIf
enx:
; If there is an error message, set the error and return 0
If Len(ErrorMessage) > 0
Set_Error(ErrorMessage)
Width = 0
EndIf
ProcedureReturn Width
EndProcedure
;--------------------------------------------------------------------
; Returns Height from String "512x768"
Procedure.l GetHeightFromDimensions(Dimensions.s)
Protected.s HeightString
Protected.l Height, Pos, i
Protected Separators.s = "x,;"
Protected Separator.s
Protected ErrorMessage.s
; Trim the input string to remove any leading or trailing spaces
Dimensions = Trim(Dimensions)
; Loop through each possible separator
For i = 1 To Len(Separators)
Separator = Mid(Separators, i, 1)
Pos = FindString(Dimensions, Separator, 1)
If Pos > 0
Goto FoundSeparator
EndIf
Next i
; If no valid separator is found, set error message
ErrorMessage = "Invalid dimensions format: " + Dimensions
Goto enx
FoundSeparator:
; Extract the height substring from the dimensions string
HeightString = Right(Dimensions, Len(Dimensions) - Pos)
; Check if the extracted string is numeric
If Not IsNumeric(HeightString)
ErrorMessage = "Invalid height value: " + HeightString
Goto enx
EndIf
; Convert the height substring to a long integer
Height = Val(HeightString)
; Validate if the height is a positive number
If Height <= 0
ErrorMessage = "Height must be a positive number."
Goto enx
EndIf
enx:
; If there is an error message, set the error and return 0
If Len(ErrorMessage) > 0
Set_Error(ErrorMessage)
Height = 0
EndIf
ProcedureReturn Height
EndProcedure
;--------------------------------------------------------------------
; Checks if the file is already a PNG and, if so, simply returns the file path.
; Otherwise, it loads the image And optionally resizes it If XS And YS are specified.
; It generates a unique filename For the new PNG file.
; It saves the image As a PNG.
; Finally, it frees the image And returns the path To the new PNG file.
;
ProcedureDLL.s EnsurePNGFile(FilePath.s, XS.l = 0, YS.l = 0)
Protected.s FileExtension, TempFileName, TempFilePath, ErrorMessage
Protected.l ImageID, SaveResult, ResizeResult
; Extract the file extension
FileExtension = ExtractFileExtension(FilePath)
; If it's already a PNG, just return the file path
If LCase(FileExtension) = "png"
ProcedureReturn FilePath
EndIf
; Load the image
ImageID = LoadImage(#PB_Any, FilePath)
If ImageID = 0
ErrorMessage = "Failed to load image: " + FilePath
Goto enx
EndIf
; Optional: Resize the image to a specific resolution if XS and YS are not zero
If XS <> 0 And YS <> 0
ResizeResult = ResizeImage(ImageID, XS, YS, #PB_Image_Smooth)
If ResizeResult = 0
ErrorMessage = "Failed to resize image."
Goto enx
EndIf
EndIf
; Generate a unique file name for the temporary PNG file
TempFileName = GenerateUniqueFilename(FilePath)
If Len(TempFileName) = 0
ErrorMessage = "Failed to generate a unique filename."
Goto enx
EndIf
; Construct the temporary file path
TempFilePath = TempFileName + ".png"
; Save the image as a PNG
SaveResult = SaveImage(ImageID, TempFilePath, #PB_ImagePlugin_PNG)
If SaveResult = 0
ErrorMessage = "Failed to save temporary PNG file: " + TempFilePath
Goto enx
EndIf
; Free the loaded image
FreeImage(ImageID)
; No errors encountered
ErrorMessage = ""
enx:
If Len(ErrorMessage) > 0
Set_Error(ErrorMessage)
TempFilePath = ""
EndIf
SD_Return=TempFilePath
; Single exit point
ProcedureReturn TempFilePath
EndProcedure
;--------------------------------------------------------------------
ProcedureDLL.s EnsureFormat(FilePath.s, DesiredFormat.s, XS.l = 0, YS.l = 0)
Protected.s FileExtension, TempFileName, TempFilePath, ErrorMessage
Protected.l ImageID, SaveResult, ResizeResult, ImagePlugin
; Validate the desired format
DesiredFormat = LCase(DesiredFormat)
If DesiredFormat <> "png" And DesiredFormat <> "jpg" And DesiredFormat <> "bmp"
ErrorMessage = "Invalid desired format specified: " + DesiredFormat
Goto enx
EndIf
; Extract the file extension
FileExtension = LCase(ExtractFileExtension(FilePath))
; If it's already in the desired format, just return the file path
If FileExtension = DesiredFormat
ProcedureReturn FilePath
EndIf
; Load the image
ImageID = LoadImage(#PB_Any, FilePath)
If ImageID = 0
ErrorMessage = "Failed to load image: " + FilePath
Goto enx
EndIf
; Optional: Resize the image to a specific resolution if XS and YS are not zero
If XS <> 0 And YS <> 0
ResizeResult = ResizeImage(ImageID, XS, YS, #PB_Image_Smooth)
If ResizeResult = 0
ErrorMessage = "Failed to resize image."
Goto enx
EndIf
EndIf
; Generate a unique file name for the temporary file in the desired format
TempFileName = GenerateUniqueFilename(FilePath)
If Len(TempFileName) = 0
ErrorMessage = "Failed to generate a unique filename."
Goto enx
EndIf
; Map the desired format to the corresponding image plugin constant
ImagePlugin = DetermineImagePlugin(DesiredFormat)
; Construct the temporary file path
TempFilePath = TempFileName + "." + DesiredFormat
; Save the image in the desired format
SaveResult = SaveImage(ImageID, TempFilePath, ImagePlugin)
If SaveResult = 0
ErrorMessage = "Failed to save temporary " + DesiredFormat + " file: " + TempFilePath
Goto enx
EndIf
; Free the loaded image
FreeImage(ImageID)
; No errors encountered
ErrorMessage = ""
enx:
If Len(ErrorMessage) > 0
Set_Error(ErrorMessage)
TempFilePath = ""
EndIf
SD_Return=TempFilePath
; Single exit point
ProcedureReturn TempFilePath
EndProcedure
;--------------------------------------------------------------------
; Enshures that the Image Dimensions from the returned Temp-Image-File are equal to those in Filepath.s
; U01 - Mask Image to resize eventually
; U02 - Original Image to get DImensions from
; This Variant will bot return an image path if the Reference Image is invalid
;
ProcedureDLL.s EnsureEqualDimensionIfpossible(FilePath.s, ReferenceFilePath.s)
Protected.s FileExtension, TempFileName, TempFilePath, ErrorMessage
Protected.s RefDimensions, Dimensions
Protected.l ImageID, SaveResult, ResizeResult
Protected.l RefXS, RefYS, XS, YS
; Validate the input file paths
If FileSize(FilePath) = -1 Or FileSize(ReferenceFilePath) = -1
ErrorMessage = "One or both of the provided file paths are invalid or do not exist."
Goto enx
EndIf
; Extract the file extension
FileExtension = ExtractFileExtension(FilePath)
; If it's already a PNG, just return the file path
If LCase(FileExtension) = "png"
ErrorMessage = ""
TempFilePath = FilePath
Goto enx
EndIf
; Load the image
ImageID = LoadImage(#PB_Any, FilePath)
If ImageID = 0
ErrorMessage = "Failed to load image: " + FilePath
Goto enx
EndIf
; Get dimensions of the reference image
RefDimensions = GetImageDimensions(ReferenceFilePath)
If Len(RefDimensions) = 0
ErrorMessage = "Failed to get dimensions of the reference image."
Goto enx
EndIf
RefXS = GetWidthFromDimensions(RefDimensions)
RefYS = GetHeightFromDimensions(RefDimensions)
; Validate the extracted dimensions
If RefXS = 0 Or RefYS = 0
ErrorMessage = "Invalid dimensions in the reference image."
Goto enx
EndIf
; Get dimensions of the current image
Dimensions = GetImageDimensions(FilePath)
If Len(Dimensions) = 0
ErrorMessage = "Failed to get dimensions of the target image."
Goto enx
EndIf
XS = GetWidthFromDimensions(Dimensions)
YS = GetHeightFromDimensions(Dimensions)
; Validate the extracted dimensions
If XS = 0 Or YS = 0
ErrorMessage = "Invalid dimensions in the target image."
Goto enx
EndIf
; Optional: Resize the image to match the reference dimensions if they differ
If XS <> RefXS Or YS <> RefYS
ResizeResult = ResizeImage(ImageID, RefXS, RefYS, #PB_Image_Smooth)
If ResizeResult = 0
ErrorMessage = "Failed to resize image."
Goto enx
EndIf
EndIf
; Generate a unique file name for the temporary PNG file
TempFileName = GenerateUniqueFilename(FilePath)
If Len(TempFileName) = 0
ErrorMessage = "Failed to generate a unique filename."
Goto enx
EndIf
; Construct the temporary file path
TempFilePath = TempFileName + ".png"
; Save the image as a PNG
SaveResult = SaveImage(ImageID, TempFilePath, #PB_ImagePlugin_PNG)
If SaveResult = 0
ErrorMessage = "Failed to save temporary PNG file: " + TempFilePath
Goto enx
EndIf
; Free the loaded image
FreeImage(ImageID)
; No errors encountered
ErrorMessage = ""
enx:
If Len(ErrorMessage) > 0
Set_Error(ErrorMessage)
TempFilePath = ""
EndIf
; Single exit point
SD_Return=TempFilePath
ProcedureReturn TempFilePath
EndProcedure
;--------------------------------------------------------------------
; U01 - Imagepath to return or generate an temp-Image with the proper size
; U02 - Reference Image, if its invalid we will return the original Path
;
ProcedureDLL.s EnsureEqualDimension(FilePath.s, ReferenceFilePath.s)
Protected.s FileExtension, TempFileName, TempFilePath, ErrorMessage
Protected.s RefDimensions, Dimensions
Protected.l ImageID, SaveResult, ResizeResult
Protected.l RefXS, RefYS, XS, YS
; Validate the input file paths
If FileSize(FilePath) = -1 Or FileSize(ReferenceFilePath) = -1
ErrorMessage = "One or both of the provided file paths are invalid or do not exist."
Goto enx
EndIf
; Extract the file extension
FileExtension = ExtractFileExtension(FilePath)
; If it's already a PNG, just return the file path
If LCase(FileExtension) = "png"
ErrorMessage = ""
TempFilePath = FilePath
Goto enx
EndIf
; Load the image
ImageID = LoadImage(#PB_Any, FilePath)
If ImageID = 0
ErrorMessage = "Failed to load image: " + FilePath
TempFilePath = FilePath
Goto enx
EndIf
; Get dimensions of the reference image
RefDimensions = GetImageDimensions(ReferenceFilePath)
If Len(RefDimensions) = 0
ErrorMessage = "Failed to get dimensions of the reference image."
TempFilePath = FilePath
Goto enx
EndIf
RefXS = GetWidthFromDimensions(RefDimensions)
RefYS = GetHeightFromDimensions(RefDimensions)
; Validate the extracted dimensions
If RefXS = 0 Or RefYS = 0
ErrorMessage = "Invalid dimensions in the reference image."
TempFilePath = FilePath
Goto enx
EndIf
; Get dimensions of the current image
Dimensions = GetImageDimensions(FilePath)
If Len(Dimensions) = 0
ErrorMessage = "Failed to get dimensions of the target image."
TempFilePath = FilePath
Goto enx
EndIf
XS = GetWidthFromDimensions(Dimensions)
YS = GetHeightFromDimensions(Dimensions)
; Validate the extracted dimensions
If XS = 0 Or YS = 0
ErrorMessage = "Invalid dimensions in the target image."
TempFilePath = FilePath
Goto enx
EndIf
; Optional: Resize the image to match the reference dimensions if they differ
If XS <> RefXS Or YS <> RefYS
ResizeResult = ResizeImage(ImageID, RefXS, RefYS, #PB_Image_Smooth)
If ResizeResult = 0
ErrorMessage = "Failed to resize image."
TempFilePath = FilePath
Goto enx
EndIf
EndIf
; Generate a unique file name for the temporary PNG file
TempFileName = GenerateUniqueFilename(FilePath)
If Len(TempFileName) = 0
ErrorMessage = "Failed to generate a unique filename."
TempFilePath = FilePath
Goto enx
EndIf
; Construct the temporary file path
TempFilePath = TempFileName + ".png"
; Save the image as a PNG
SaveResult = SaveImage(ImageID, TempFilePath, #PB_ImagePlugin_PNG)
If SaveResult = 0
ErrorMessage = "Failed to save temporary PNG file: " + TempFilePath
TempFilePath = FilePath
Goto enx
EndIf
; Free the loaded image
FreeImage(ImageID)
; No errors encountered
ErrorMessage = ""
enx:
If Len(ErrorMessage) > 0
Set_Error(ErrorMessage)
EndIf
; Single exit point
SD_Return=TempFilePath
ProcedureReturn TempFilePath
EndProcedure
;--------------------------------------------------------------------
Procedure.b IsBitSet(bit, value)
Protected T01.l,T02.b
T01=(value & (1 << bit))
If T01<>0
T02=1
Else
T02=0
EndIf
ProcedureReturn T02
EndProcedure
;--------------------------------------------------------------------
;######################################################################
;
;######################################################################
; Fill an image with a given color
; &HFFFFFFFF, where the first pair of "FF" bytes represents the alpha
; if you want a fully transparent image, you could set the color code to &H00FFFFFF.
;
; Fill an image with a given color
; Procedure to fill an image with a specific color
; Parameters:
; ImageID: Image ID of the image to be filled
; ColorCode: Color code in RGB or RGBA format
Procedure FillImageWithColor(ImageID.l, ColorCode.l)
Protected Width, Height, y
; Get the dimensions of the image
Width = ImageWidth(ImageID)
Height = ImageHeight(ImageID)
; Start drawing to the image
StartDrawing(ImageOutput(ImageID))
; Loop through each y-coordinate and draw a line from x=0 to x=Width
For y = 0 To Height - 1
LineXY(0, y, Width - 1, y, ColorCode)
Next y
; Stop drawing to the image
StopDrawing()
EndProcedure
;--------------------------------------------------------------------
; Place one image onto another based on a position code
; ----------------------------------------------------------------------------
; Procedure PlaceImageOnImage
; Description: This procedure places one image (SrcImageID) onto another (DestImageID)
; based on a position code (e.g., "LC" - Left Center).
; If the source image is larger than the destination, it will be cut to fit.
; ----------------------------------------------------------------------------
; This will not work if the Mask is larger then the Destination Image
Procedure PlaceMaskImageOnImage(DestImageID.l, SrcImageID.l, Position.s)
Protected.l DestWidth, DestHeight, SrcWidth, SrcHeight
Protected.l X, Y
Protected.s ErrorMessage
; Validate Image IDs
If ImageWidth(DestImageID) = 0 Or ImageHeight(DestImageID) = 0
ErrorMessage = "Invalid Destination Image ID"
Goto enx
EndIf
If ImageWidth(SrcImageID) = 0 Or ImageHeight(SrcImageID) = 0
ErrorMessage = "Invalid Source Image ID"
Goto enx
EndIf
; Validate Position Parameter
If Len(Position) <> 2
ErrorMessage = "Invalid Position Parameter"
Goto enx
EndIf
; Get dimensions of both images
DestWidth = ImageWidth(DestImageID)
DestHeight = ImageHeight(DestImageID)
SrcWidth = ImageWidth(SrcImageID)
SrcHeight = ImageHeight(SrcImageID)
; Determine X coordinate based on Position
Select Left(Position, 1)
Case "L"
X = 0
Case "R"
X = DestWidth - SrcWidth
Case "C"
X = (DestWidth - SrcWidth) / 2
EndSelect
; Determine Y coordinate based on Position
Select Right(Position, 1)
Case "U"
Y = 0
Case "D"
Y = DestHeight - SrcHeight
Case "C"
Y = (DestHeight - SrcHeight) / 2
EndSelect
; Check for Dimension Compatibility
If X < 0 Or Y < 0 Or (X + SrcWidth) > DestWidth Or (Y + SrcHeight) > DestHeight
ErrorMessage = "Source Image Does Not Fit Into Destination Image"
Goto enx
EndIf
; Place SrcImageID onto DestImageID at (X, Y)
StartDrawing(ImageOutput(DestImageID))
DrawImage(SrcImageID, X, Y)
StopDrawing()
; No errors encountered
ErrorMessage = ""
enx:
If Len(ErrorMessage) > 0
Set_Error(ErrorMessage)
EndIf
EndProcedure
;--------------------------------------------------------------------
; Procedure to paste one image onto another at specific coordinates
; Procedure to paste one image onto another at specific coordinates
Procedure PasteImage(SrcImageID.l, DestImageID.l, X.l, Y.l)
; Start drawing to the destination image
StartDrawing(ImageOutput(DestImageID))
; Draw the source image onto the destination image
DrawImage(SrcImageID, X, Y)
; Stop drawing to the image
StopDrawing()
EndProcedure
;--------------------------------------------------------------------
; Procedure to place one image onto another based on a position code
; Parameters:
; DestImageID: Image ID of the destination image
; SrcImageID: Image ID of the source (mask) image
; Position: 2-letter code representing the position (e.g., 'LC' for Left-Center)
Procedure PlaceImageOnImage(DestImageID.l, SrcImageID.l, Position.s)
Protected.l DestWidth, DestHeight, SrcWidth, SrcHeight
Protected.l X, Y, CutX, CutY, NewSrcImageID
Protected.s ErrorMessage
; Get the dimensions of both images
DestWidth = ImageWidth(DestImageID)
DestHeight = ImageHeight(DestImageID)
SrcWidth = ImageWidth(SrcImageID)
SrcHeight = ImageHeight(SrcImageID)
; Initial coordinates to start pasting the source image
X = 0
Y = 0
; Determine if the source image needs to be cut to fit into the destination image
If SrcWidth > DestWidth Or SrcHeight > DestHeight
; Calculate how much to cut from the source image
CutX = SrcWidth - DestWidth
CutY = SrcHeight - DestHeight
; Crop the source image accordingly
; Create a new cropped image from the source image based on the destination dimensions
NewSrcImageID = GrabImage(SrcImageID, #PB_Any, 0, 0, DestWidth, DestHeight)
; Replace the original SrcImageID with the cropped one
FreeImage(SrcImageID)
SrcImageID = NewSrcImageID
EndIf
; Calculate X, Y based on Position (L=Left, R=Right, C=Center, U=Up, D=Down)
If Left(Position, 1) = "L"
X = 0
ElseIf Left(Position, 1) = "R"
X = DestWidth - SrcWidth
ElseIf Left(Position, 1) = "C"
X = (DestWidth - SrcWidth) / 2
EndIf
If Right(Position, 1) = "U"
Y = 0
ElseIf Right(Position, 1) = "D"
Y = DestHeight - SrcHeight
ElseIf Right(Position, 1) = "C"
Y = (DestHeight - SrcHeight) / 2
EndIf
; Paste SrcImageID onto DestImageID at (X, Y)
PasteImage(SrcImageID, DestImageID, X, Y)
; No errors encountered
ErrorMessage = ""
enx:
If Len(ErrorMessage) > 0
Set_Error(ErrorMessage)
EndIf
EndProcedure
;--------------------------------------------------------------------
; Save an image to a file
; Parameters:
; ImageID: The ID of the image to save
; FilePath: The path where to save the image
; Returns:
; 1 if the image was saved successfully, 0 otherwise
Procedure.l SaveImageToFile(ImageID.l, FilePath.s)
Protected.l Result, SaveStatus
Protected.s FileExtension, ErrorMessage
Protected.l ImagePlugin
; Extract the file extension from the FilePath
FileExtension = ExtractFileExtension(FilePath)
; Determine the image plugin to use based on the file extension
ImagePlugin = DetermineImagePlugin(FileExtension)
; Check if an unsupported extension is provided
If ImagePlugin = 0
ErrorMessage = "Unsupported file extension: " + FileExtension
Goto enx
EndIf
; Save the image using the appropriate plugin
SaveStatus = SaveImage(ImageID, FilePath, ImagePlugin)
; Check if the image was saved successfully
If SaveStatus = 0
ErrorMessage = "Failed to save image to: " + FilePath
Goto enx
EndIf
; Image was saved successfully
Result = 1
enx:
If Len(ErrorMessage) > 0
Set_Error(ErrorMessage)
Result = 0
EndIf
; Single exit point
ProcedureReturn Result
EndProcedure
;--------------------------------------------------------------------
; Main Procedure
; Procedure to ensure that the dimensions of the mask image match those of the original image
Procedure.s EnsureMaskDimensions(OriginalImageFilePath.s, MaskImageFilePath.s, BorderColor.s, Position.s)
Protected.s ErrorMessage
Protected.l OriginalImageID, MaskImageID, NewMaskImageID
Protected.l OriginalWidth, OriginalHeight, MaskWidth, MaskHeight
Protected.l ColorCode
Protected.s NewMaskFilePath
; Load the original image
OriginalImageID = LoadImage(#PB_Any, OriginalImageFilePath)
If OriginalImageID = 0
ErrorMessage = "Failed to load original image: " + OriginalImageFilePath
Goto enx
EndIf
; Get dimensions of the original image
OriginalWidth = ImageWidth(OriginalImageID)
OriginalHeight = ImageHeight(OriginalImageID)
; Load the mask image
MaskImageID = LoadImage(#PB_Any, MaskImageFilePath)
If MaskImageID = 0
ErrorMessage = "Failed to load mask image: " + MaskImageFilePath
Goto enx
EndIf
; Get dimensions of the mask image
MaskWidth = ImageWidth(MaskImageID)
MaskHeight = ImageHeight(MaskImageID)
; Check color format
If Left(BorderColor, 2) = "&H"
ColorCode = Val(Mid(BorderColor, 3))
Else
ColorCode = Val(BorderColor)
EndIf
; Create new mask image with dimensions of the original image
NewMaskImageID = CreateImage(#PB_Any, OriginalWidth, OriginalHeight)
If NewMaskImageID = 0
ErrorMessage = "Failed to create new mask image."
Goto enx
EndIf
; Fill new mask image with BorderColor
FillImageWithColor(NewMaskImageID, ColorCode)
; Place the original mask image on the new mask based on the 'Position' parameter
PlaceImageOnImage(NewMaskImageID, MaskImageID, Position)
; Generate a save file path for the new mask image
NewMaskFilePath = GetTempFileNameWithExtension("png")
; Save the new mask image
SaveImage(NewMaskImageID, NewMaskFilePath, #PB_ImagePlugin_PNG)
; Free loaded images
FreeImage(OriginalImageID)
FreeImage(MaskImageID)
FreeImage(NewMaskImageID)
; No errors encountered
ErrorMessage = ""
enx:
If Len(ErrorMessage) > 0
Set_Error(ErrorMessage)
NewMaskFilePath = ""
EndIf
; Single exit point
ProcedureReturn NewMaskFilePath
EndProcedure
;######################################################################
;
;######################################################################
Page created in 0.302 seconds with 14 queries.