Mix smaller png's onto bigger backgrounds.

Share your advanced PureBasic knowledge/code with the community.
User avatar
Fangbeast
PureBasic Protozoa
PureBasic Protozoa
Posts: 4790
Joined: Fri Apr 25, 2003 3:08 pm
Location: Not Sydney!!! (Bad water, no goats)

Mix smaller png's onto bigger backgrounds.

Post by Fangbeast »

I had a lot of help in the forums to create glowy, inverted and hovered code for PNG buttons but I still had the problem to manually resize them onto bigger transparent backgrounds so there was room for the outlined effects.

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
Amateur Radio/VK3HAF, (D-STAR/DMR and more), Arduino, ESP32, Coding, Crochet