#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