This tiny routine that I had help with as well can create an arbitrary transparent background image; read in a directory of PNG files, write each smaller PNG onto the larger background with AlphaBlending and save it again.
Can process an entire directory.
Okay, maybe not a huge thing for smarter folks but an incredible time saver for me.
Code: Select all
; Need a unicode aware version of the API directory creator
Import "shell32.lib"
SHCreateDirectory(*hwnd, pszPath.p-unicode)
EndImport
;
UsePNGImageDecoder()
UsePNGImageEncoder()
;
Global Currentdirectory.s = GetCurrentDirectory()
Global ConvertFrom.s = Currentdirectory.s + "Images\_48x48\"
Global ConvertTo.s = Currentdirectory.s + "Images\_54x54\"
;
Declare GetIcons(ConvertFrom.s, ConvertTo.s, BackSize.i, IconSize.i)
Declare.s MakeSureDirectoryPathExists(Directory.s)
; Need a unicode aware version of the API directory creator
Procedure.s MakeSureDirectoryPathExists(Directory.s)
;
ErrorCode.i = SHCreateDirectory(#Null, Directory.s)
;
Select ErrorCode.i
Case #ERROR_SUCCESS : Message.s ="Okay" ; ResultCode = 0
Case #ERROR_BAD_PATHNAME : Message.s ="Bad directory path" ; ResultCode = 161
Case #ERROR_FILENAME_EXCED_RANGE : Message.s ="Directory path too long" ; ResultCode = 206
Case #ERROR_FILE_EXISTS : Message.s ="Directory already exists" ; ResultCode = 80
Case #ERROR_ALREADY_EXISTS : Message.s ="Directory already exists" ; ResultCode = 183
; Case #ERROR_CANCELLED : Message.s ="The user canceled the operation." ; ResultCode = ??. Not defined in compiler residents
EndSelect
;
ProcedureReturn Message.s
EndProcedure
;
Procedure GetIcons(ConvertFrom.s, ConvertTo.s, BackSize.i, IconSize.i)
DirectoryId.i = ExamineDirectory(#PB_Any, ConvertFrom.s, "*.png")
If DirectoryId.i
Repeat
TypeOfFile = NextDirectoryEntry(DirectoryId.i)
FileName.s = DirectoryEntryName(DirectoryId.i)
If TypeOfFile = 1
;
CurrentIcon.i = LoadImage(#PB_Any, ConvertFrom.s + FileName.s)
ImageCreateResult = CreateImage(#PB_Any, BackSize.i, BackSize.i, 32, #PB_Image_Transparent)
If ImageCreateResult
StartDrawing(ImageOutput(ImageCreateResult))
DrawingMode(#PB_2DDrawing_AlphaBlend)
Position.i = (BackSize.i - IconSize.i) / 2
DrawImage(ImageID(CurrentIcon.i), Position.i, Position.i, IconSize.i, IconSize.i)
StopDrawing()
;
SaveImage(ImageCreateResult, ConvertTo.s + FileName.s, #PB_ImagePlugin_PNG)
;
FreeImage(ImageCreateResult)
EndIf
;
EndIf
Until TypeOfFile = 0
EndIf
EndProcedure
; Need a unicode aware version of the API directory creator
ResultCode.s = MakeSureDirectoryPathExists(ConvertFrom.s)
;
If ResultCode.s = "Okay" Or ResultCode.s = "Directory already exists"
;
ResultCode.s = MakeSureDirectoryPathExists(ConvertTo.s)
If ResultCode.s = "Okay" Or ResultCode.s = "Directory already exists"
GetIcons(ConvertFrom.s, ConvertTo.s, 54, 48)
Else
Select ResultCode.s
Case "Bad directory path" : CreateMessage.s = "The specified directory path contains illegal characters"
Case "Directory path too long" : CreateMessage.s = "The specified directory path exceeds 255 characters i length"
EndSelect
MessageRequester("Target directory error", "Could not create : " + ConvertTo.s, #PB_MessageRequester_Ok)
EndIf
;
Else
Select ResultCode.s
Case "Bad directory path" : CreateMessage.s = "The specified directory path contains illegal characters"
Case "Directory path too long" : CreateMessage.s = "The specified directory path exceeds 255 characters i length"
EndSelect
MessageRequester("Source directory error", "Could not create : " + ConvertFrom.s, #PB_MessageRequester_Ok)
EndIf
;
End