File "img-rnd-builder.bas"

Path: /img-rnd/img-rnd-builder.bas
File size: 11.3 KB
MIME-type:
Charset: utf-8

#COMPILER PBWIN 9
#COMPILE EXE
#REGISTER NONE
#DIM ALL
#RESOURCE "IRB.PBR"

$VER = "1.1"

'------------------------------------------------------------------------------
' Initial Declares - eliminate unnecessary macros in COMMCTRL.INC
'------------------------------------------------------------------------------
%NOANIMATE         = 1  ' Animate control
%NOBUTTON          = 1  ' Button
%NOCOMBO           = 1  ' Combo box
%NOCOMBOEX         = 1  ' ComboBoxEx
%NODATETIMEPICK    = 1  ' Date/time picker
%NODRAGLIST        = 1  ' Drag list control
%NOEDIT            = 1  ' Edit control
%NOFLATSBAPIS      = 1  ' Flat scroll bar
%NOHEADER          = 1  ' Header control
%NOHOTKEY          = 1  ' HotKey control
%NOIMAGELIST       = 1  ' Image APIs
%NOIPADDRESS       = 1  ' IP Address edit control
%NOLIST            = 1  ' List box control
%NOMENUHELP        = 1  ' Menu help
%NOMONTHCAL        = 1  ' MonthCal
%NOMUI             = 1  ' MUI
%NONATIVEFONTCTL   = 1  ' Native Font control
%NOPAGESCROLLER    = 1  ' Pager
%NOPROGRESS        = 1  ' Progress control
%NOREBAR           = 1  ' Rebar control
%NOSTATUSBAR       = 1  ' Status bar
%NOTABCONTROL      = 1  ' Tab control
%NOTOOLBAR         = 1  ' Tool bar
%NOTOOLTIPS        = 1  ' Tool tips
%NOTRACKBAR        = 1  ' Track bar
%NOTRACKMOUSEEVENT = 1  ' Track Mouse Event
%NOTREEVIEW        = 1  ' TreeView
%NOUPDOWN          = 1  ' Up Down arrow control

'------------------------------------------------------------------------------
' Equates
'------------------------------------------------------------------------------
%IDC_LABEL1    = %WM_USER + 2110 ' control ids
%IDC_BTNPATH   = %WM_USER + 2120
%IDC_BTNBUILD  = %WM_USER + 2121
%IDC_IMAGE     = %WM_USER + 2130
%IDC_TXT1      = %WM_USER + 2140
%IDC_TXT2      = %WM_USER + 2141

'------------------------------------------------------------------------------
' Global variables
'------------------------------------------------------------------------------
GLOBAL gLnkIco     AS STRING  ' Shortcut icon
GLOBAL ghDlg       AS DWORD   ' main dialog's handle
GLOBAL ghIcon      AS DWORD   ' main dialog's icon handle
GLOBAL gFoldrPath  AS STRING  ' path to start search from

'------------------------------------------------------------------------------
' Include files
'------------------------------------------------------------------------------
%USEMACROS = 1

#INCLUDE ONCE "Win32API.inc"
#INCLUDE ONCE "CommCtrl.inc"
#INCLUDE ONCE "InitCtrl.inc"
#INCLUDE ONCE "SavePos.inc"
#INCLUDE ONCE "DragnDrop.inc"
#INCLUDE ONCE "RunCmd.inc"
#INCLUDE ONCE "CreateShortcut.inc"

'------------------------------------------------------------------------------
' Util functions
'------------------------------------------------------------------------------
MACRO DisplayIcon
    IF ghIcon <> 0 THEN DestroyIcon ghIcon
    ghIcon = LoadImage(BYVAL %NULL, (gLnkIco), %IMAGE_ICON, 32, 32, %LR_LOADFROMFILE)
    CONTROL SEND ghDlg, %IDC_IMAGE, %STM_SETIMAGE, %IMAGE_ICON, ghIcon
END MACRO

'------------------------------------------------------------------------------
SUB ConvertIco()
    LOCAL r AS STRING
    LOCAL i AS LONG

    ' Prepare command to convert to .ico
    r  = "magick convert " + $DQ + gLnkIco + $DQ
    r += " -define png:color-type=6 icon:auto-resize"
    r += "=16,24,32,48,64,72,96,128,256 "
    i = INSTR(-1, gLnkIco, ".")
    gLnkIco = LEFT$(gLnkIco, i) + "ico"
    r += $DQ + gLnkIco + $DQ

    ' Delete icon if it already exists
    IF EXISTS(gLnkIco) THEN KILL gLnkIco

    ' Create icon
    r = DUMP_CMD(r)
    DisplayIcon()
END SUB

'------------------------------------------------------------------------------
SUB SetNewPath()
    ' Set new folder path
    gFoldrPath = RTRIM$(gFoldrPath, ANY "\/") + "\"
    CONTROL SET TEXT ghDlg, %IDC_TXT1, gFoldrPath
    CONTROL ENABLE   ghDlg, %IDC_BTNBUILD
END SUB

'------------------------------------------------------------------------------
FUNCTION EXISTS(BYVAL fileOrFolder AS STRING) AS LONG
    LOCAL Dummy&
    Dummy& = GETATTR(fileOrFolder)
    FUNCTION = (ERRCLEAR = 0)
END FUNCTION

'------------------------------------------------------------------------------
' Main callback
'------------------------------------------------------------------------------
CALLBACK FUNCTION DlgProc () AS LONG
    LOCAL r AS STRING
    LOCAL i AS LONG

    ' Callback handlers
    CB_DRAGNDROP
    CB_SAVEPOS

    SELECT CASE CB.MSG

    CASE %WM_SETCURSOR ' change cursor to link-hand when hovering over icons
        i = GetDlgCtrlId(CB.WPARAM)
        IF i = %IDC_IMAGE OR i = %IDC_TXT2 THEN
            SetCursor LoadCursor(%NULL, BYVAL %IDC_HAND)
            SetWindowLong CB.HNDL, %dwl_msgresult, 1
            FUNCTION = 1
        END IF

    CASE %WM_COMMAND
        IF CB.CTLMSG <> %BN_CLICKED THEN EXIT SELECT

        SELECT CASE CB.CTL

        CASE %IDCANCEL
            DIALOG END CB.HNDL

        CASE %IDC_TXT2
            IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
                ShellExecute %NULL, "open", "http://mougino.free.fr/freeware", "", "", %SW_SHOW
            END IF

        CASE %IDC_BTNPATH
            ' Change path of image folder
            DISPLAY BROWSE CB.HNDL,,, "", "", %BIF_RETURNONLYFSDIRS OR %BIF_DONTGOBELOWDOMAIN OR %BIF_NONEWFOLDERBUTTON TO gFoldrPath
            IF LEN(gFoldrPath) THEN
                SetNewPath()
            END IF

        CASE %IDC_IMAGE
            ' Pick image to use for shortcut
            DISPLAY OPENFILE CB.HNDL,,, "Select shortcut icon", _
                "", CHR$("Image", 0, "*.ico;*.jpg;*.png", 0), _
                "", "", %OFN_FILEMUSTEXIST TO gLnkIco
            IF LEN(gLnkIco) THEN
                r = LCASE$(RIGHT$(gLnkIco,4))
                IF r = ".jpg" OR r = "jpeg" _     ' If it's an image, convert to icon and use
                  OR r = ".png" OR r = ".bmp" THEN
                    ConvertIco()
                ELSEIF r = ".ico" THEN            ' If it's an icon, use directly
                    DisplayIcon()
                ELSE
                    BEEP
                END IF
            END IF

        CASE %IDC_BTNBUILD
            ' Save shortcut as... (ask to replace if it already exists)
            DISPLAY SAVEFILE 0,,, "Save as...", LEFT$(gFoldrPath,3), _
                "Shortcut" + CHR$(0) + "*.lnk" + CHR$(0), _
                PATHNAME$(NAME, gLnkIco)+".lnk", "lnk", _
                %OFN_PATHMUSTEXIST OR %OFN_OVERWRITEPROMPT TO r
            IF r = "" THEN EXIT FUNCTION ' Cancelled by user

            ' Replace if existing
            IF EXISTS(r) THEN KILL r

            ' Create shortcut
            CreateShortcut _
              r,   _                                ' 1. the link file to be created
              EXE.PATH$ + "img-rnd.exe",          _ ' 2. the file/document where the shortcut should point to
              "",                                 _ ' 3. command-line parameters
              gFoldrPath,                         _ ' 4. the folder where the executable file should start in
              %SW_SHOW,                           _ ' 5. %SW_SHOW, %SW_HIDE etc.
              gLnkIco,                            _ ' 6. icon file or executable file containing an icon
              0,                                  _ ' 7. icon index in the aforementioned file
              ("(c) mougino.free.fr 2024")          ' 8. any comment (stored in the shortcut)

            ' Display created shortcut in Windows Explorer
            ShellExecute 0, "open", "explorer.exe" + CHR$(0), "/select," _
              + $DQ + r + $DQ + CHR$(0), "", %SW_SHOW

        END SELECT

    CASE %WM_DESTROY

    END SELECT

END FUNCTION


'------------------------------------------------------------------------------
' Main entry point for the application
'------------------------------------------------------------------------------
FUNCTION PBMAIN () AS LONG
    LOCAL r AS STRING

    ' Check presence of "img-rnd.exe"
    IF NOT EXISTS("img-rnd.exe") THEN
        MSGBOX "Error: ""img-rnd.exe"" not found!",%MB_ICONWARNING,EXE.NAME$
        EXIT FUNCTION
    END IF

    ' Check that ImageMagick is installed on the system
    r = DUMP_CMD("magick convert -version")
    IF INSTR(r, "ImageMagick") = 0 THEN
        MSGBOX "Error: ImageMagick not installed on the system!",%MB_ICONWARNING,EXE.NAME$
        ShellExecute 0, "open", "https://imagemagick.org/script/download.php"+ $NUL, _
          "", "", %SW_SHOW
        EXIT FUNCTION
    END IF

    ' Initialize the common control library with standard Windows classes
    InitComCtl32

    ' Create dialog
    DIALOG NEW %HWND_DESKTOP, EXE.NAME$ + $SPC + $VER,,, 248, 40, _
        %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU, 0 TO ghDlg
    DIALOG SET ICON    ghDlg, "ICO1"

    CONTROL ADD LABEL, ghDlg, -1,          "Folder :",        5,  6,  35, 12
    CONTROL ADD TEXTBOX, ghDlg, %IDC_TXT1, "",               40,  4, 150, 12

    r = "Browse for a folder or drag'n drop one here ^"
    CONTROL ADD LABEL, ghDlg, %IDC_LABEL1, r,                 5, 22, 155, 10, _
      %SS_PATHELLIPSIS OR %WS_CHILD OR %WS_VISIBLE, %WS_EX_LEFT OR %WS_EX_LTRREADING

    CONTROL ADD BUTTON, ghDlg, %IDC_BTNPATH, "...",     190,  4, 12, 12
    CONTROL ADD BUTTON, ghDlg, %IDC_BTNBUILD, "&Build", 162,  22, 40, 14, %WS_TABSTOP OR %BS_DEFAULT ' 207,  3, 40, 14
    CONTROL DISABLE     ghDlg, %IDC_BTNBUILD

    CONTROL ADD LABEL,  ghDlg,         -1, "", 215, 5, 22, 22, %SS_GRAYRECT ' Acts as shadow...
    CONTROL ADD IMAGE,  ghDlg, %IDC_IMAGE, "", 213, 4, 22, 22, %WS_BORDER OR %SS_NOTIFY

    CONTROL ADD LABEL, ghDlg,  %IDC_TXT2,  "[?]", 236, 29, 8, 12, %SS_NOTIFY
    CONTROL SET COLOR  ghDlg,  %IDC_TXT2,  %BLUE, -1

    ' Show dialog
    DIALOG SHOW MODAL ghDlg CALL DlgProc

END FUNCTION


'------------------------------------------------------------------------------
' File dropped management
'------------------------------------------------------------------------------
SUB FileDropped(BYVAL myfile AS STRING)
    LOCAL hSearch AS DWORD                      ' Search handle
    LOCAL WFD     AS WIN32_FIND_DATA            ' FindFirstFile structure
    LOCAL imglst  AS STRING                     ' Path to existing image list
    LOCAL xt      AS STRING                     ' File extension
    LOCAL r       AS STRING                     ' Cmd result
    LOCAL i       AS LONG                       ' Enumerator

    hSearch = FindFirstFile((myfile), WFD)      ' Get search handle
    FindClose hSearch

    IF hSearch <> %INVALID_HANDLE_VALUE THEN

        IF (WFD.dwFileAttributes AND _
            %FILE_ATTRIBUTE_DIRECTORY) _        ' If it's a directory
          = %FILE_ATTRIBUTE_DIRECTORY THEN
            gFoldrPath = myfile                 ' Set the path
            SetNewPath()

        ELSE
            xt = LCASE$(RIGHT$(WFD.cFileName,4))

            IF xt = ".jpg" OR xt = "jpeg" _     ' If it's an image, convert to icon and use
              OR xt = ".png" OR xt = ".bmp" THEN
                gLnkIco = myfile
                ConvertIco()

            ELSEIF xt = ".ico" THEN             ' If it's an icon, use directly
                gLnkIco = myfile
                DisplayIcon()
            ELSE
                BEEP
            END IF
        END IF

    END IF

END SUB