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