File "ShuffleGUI.bas"
Path: /ShuffleGUI/ShuffleGUI.bas
File size: 30.18 KB
MIME-type:
Charset: utf-8
#COMPILE EXE "ShuffleGUI.exe"
#RESOURCE "ShuffleGUI.pbr"
#INCLUDE ONCE "inc\ReadShortcut.inc"
#INCLUDE ONCE "inc\Registry.inc"
#INCLUDE ONCE "inc\Tooltip.inc"
#INCLUDE ONCE "inc\Ini.inc"
#INCLUDE ONCE "inc\RunCmd.inc"
#INCLUDE ONCE "inc\Icon.inc"
#INCLUDE ONCE "inc\RTF.inc"
#INCLUDE ONCE "inc\Unix.inc"
$VER = "1.5"
' Changelog:
' v1.5 (2025-08-29)
' [X] Add Linux support when program runs through Wine
' v1.4 (2025-08-19)
' [X] Display shadow folders at startup
' v1.3 (2025-07-22)
' [X] Disable icon (grayed) if target doesn't exist
' v1.2 (2025-07-02)
' [X] Right-click on a shortcut opens its target folder
' [X] Display last media launched in footbar
' v1.1 (2025-06-03)
' [X] Add "Video filter" button (need ickvdo.exe near the program)
' [X] Handle vlc 64-bit installation folder
' [X] Speed-up startup by 10x factor by improving icons refresh
' v1.0 (2025-01-28)
' [X] Initial release
GLOBAL g_sc() AS STRING ' Shortcuts
GLOBAL g_pc() AS LONG ' Pics (index in shortcuts)
GLOBAL g_vd() AS LONG ' Vidz (index in shortcuts)
GLOBAL g_an() AS LONG ' Anything (index in shortcuts)
GLOBAL g_vlcpath AS STRING ' VLC path
GLOBAL g_ratio AS SINGLE ' Grid aspect ratio
GLOBAL g_icow AS LONG ' Grid icon size in pixels
GLOBAL g_magick AS LONG ' Whether ImageMagick is installed or not
GLOBAL g_onunix AS LONG ' Whether this program runs on Linux or not
MACRO DlgBgCol = GETSYSCOLOR(%COLOR_BTNFACE)
'-------------------------------------------------------------------------------------------
FUNCTION EXISTS(BYVAL f AS STRING) AS LONG
LOCAL i AS LONG
i = GETATTR(f)
FUNCTION = (ERRCLEAR = 0)
END FUNCTION
'-------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------
FUNCTION LoadResCursor(ResName AS STRING) AS DWORD
LOCAL lRet1 AS LONG,lRet2 AS LONG, dRet1 AS DWORD,dRet2 AS DWORD
LOCAL sBuff AS STRING, szName AS ASCIIZ * 40, lFile AS LONG, hProcess AS LONG
hProcess = 0 ' use null for current process
szName = ResName ' change string to asciiz for api calls
lRet1 = FindResource(hProcess, szName, BYVAL %RT_RCDATA)
IF ISFALSE lRet1 THEN FUNCTION = 0 : EXIT FUNCTION ' could not find the res so exit
dRet1 = SizeofResource(hProcess, lRet1)
lRet2 = LoadResource(hProcess, lRet1)
IF ISFALSE lRet2 THEN FUNCTION = 0 : EXIT FUNCTION ' could not load res to mem so exit
dRet2 = LockResource(lRet2)
sBuff = PEEK$(dRet2, dRet1) ' load sBuff with the info we just put in memory
' now save the item from memory to a file
ResName = ENVIRON$("TEMP") + "\" + ResName + ".cur"
KILL ResName ' kill any previous cursor
lFile = FREEFILE ' find next open file number
OPEN ResName FOR BINARY AS #lFile ' open it
PUT$ #lFile, sBuff ' write the buffer to the file
CLOSE #lFile ' close the file
FUNCTION = LoadImage(GetModuleHandle(""), (ResName), _
%IMAGE_CURSOR, 0, 0, %LR_LOADFROMFILE)
END FUNCTION
'-------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------
SUB WriteIni()
LOCAL ff AS LONG
ff = FREEFILE
OPEN LEFT$(EXE.FULL$,-3)+"ini" FOR OUTPUT AS #ff
PRINT #ff, "[ShuffleGUI-Config]"
PRINT #ff, "# Grid aspect ratio, can be 16:9 or 4:3 or 1:1 etc."
PRINT #ff, "grid-aspect-ratio=4:3"
PRINT #ff, "# Size of grid icons, in pixel. For best aspect use 64"
PRINT #ff, "grid-icon-size=64"
CLOSE #ff
END SUB
'-------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------
SUB ReadPrefs()
LOCAL e AS STRING
LOCAL w, h, i AS LONG
' Get grid aspect ratio e.g. 16:9, 4:3, 1:1 etc.
e = GetIniS(LEFT$(EXE.FULL$,-3)+"ini", "ShuffleGUI-Config", "grid-aspect-ratio")
i = INSTR(e, ":")
IF i = 0 THEN ' syntax error
g_ratio = 4/3
ELSE
w = VAL(LEFT$(e,i-1))
h = VAL( MID$(e,i+1))
IF w = 0 OR h = 0 THEN ' out of bounds
g_ratio = 4/3
ELSE
g_ratio = w/h
IF g_ratio <= 0.1 OR g_ratio >= 9 THEN g_ratio = 4/3 ' security
END IF
END IF
' Get grid icon size in pixels
g_icow = GetIniV(LEFT$(EXE.FULL$,-3)+"ini", "ShuffleGUI-Config", "grid-icon-size")
END SUB
'-------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------
FUNCTION ReadShortcut2(BYVAL LnkPath AS STRING) AS STRING
' Returns "P|Path\To\Shortcut.lnk|Path\To\Icon.ico|TargetFolder|Arguments" if a Picture folder
' or "V|Path\To\Shortcut.lnk|Path\To\Icon.ico|TargetFolder|Arguments" if a Video folder
LOCAL Link AS LinkType
LOCAL r, e AS STRING
Link.zLinkName = (PATHNAME$(NAMEX, LnkPath))
Link.zLinkFolder = (PATHNAME$(PATH, LnkPath))
LinkQuery(Link)
IF ISTRUE INSTR(Link.zExeName, "img-rnd") THEN r = "P|" ELSE r = "V|"
r += LnkPath + "|"
' If shortcut created by img-rnd-builder or manually: take its icon
IF ISFALSE INSTR(LCASE$(Link.zExeName), "vlc") _
OR ISTRUE INSTR(LCASE$(Link.zArguments), "m3u8") THEN
r + = Link.zIconFile
' If no specific icon (or vlc icon): is there an icon file at the same root?
' ImageMagick installed: any ico/bmp/png/jpg... will do (calls ConvertIco if needed)
ELSEIF ISTRUE g_magick THEN
r += SearchForIco((Link.zWorkDir))
' ImageMagick NOT installed: need a .ico only!
ELSEIF EXISTS((Link.zWorkDir)+".ico") THEN
r += (Link.zWorkDir) + ".ico"
ELSE
r += "!"
END IF
r += "|" + Link.zWorkDir
r += "|" + Link.zArguments
FUNCTION = r
END FUNCTION
'-------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------
FUNCTION g_sc_pty(BYVAL g_sc_idx AS LONG, BYVAL pty_nb AS LONG) AS STRING
' Returns the property/field #pty_nb of g_sc(g_sc_idx)
' g_sc() = (1)|(2)|(3)|(4)|(5)
' (1) = P|V
' (2) = Path\To\Shortcut.lnk
' (3) = Path\To\Icon.ico
' (4) = TargetFolder
' (5) = Arguments
FUNCTION = PARSE$(g_sc(g_sc_idx), "|", pty_nb)
END FUNCTION
'-------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------
FUNCTION CheckTargetExists(BYVAL idx AS LONG) AS LONG
LOCAL pl AS STRING
LOCAL e AS STRING
LOCAL ret AS LONG
LOCAL ff AS LONG
ret = %TRUE ' by default
IF NOT EXISTS(g_sc_pty(idx, 4)) THEN ret = %FALSE ' Target folder does not exist
pl = g_sc_pty(idx, 5)
IF ".m3u8" = LCASE$(RIGHT$(pl, 5)) THEN ' Target is a playlist
IF NOT EXISTS(pl) THEN
ret = %FALSE ' Playlist target does not exist
ELSE
' Playlist exists >> check that at least the first video in the playlist also exists
ff = FREEFILE
OPEN pl FOR INPUT AS #ff
DO
LINE INPUT #ff, e
IF LEN(e) > 0 AND LEFT$(TRIM$(e),1) <> "#" THEN
REPLACE "/" WITH "\" IN e
REPLACE "%20" WITH " " IN e
e = PATHNAME$(PATH, pl) + e
IF NOT EXISTS(e) THEN ret = %FALSE
EXIT LOOP
END IF
LOOP UNTIL EOF(#ff)
CLOSE #ff
END IF
END IF
FUNCTION = ret
END FUNCTION
'-------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------
SUB DetectAllShortcuts()
' list all *.lnk files in current folder
LOCAL e AS STRING
REDIM g_sc(0)
e = DIR$("*.lnk")
WHILE LEN(e)
' Add to shortcuts
REDIM PRESERVE g_sc(1 + UBOUND(g_sc))
g_sc(UBOUND(g_sc)) = CURDIR$ + "\" + e
' Continue with next shortcut
e = DIR$(NEXT)
WEND
DIR$ CLOSE
END SUB
'-------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------
SUB ReadAllShortcuts()
' from the list of *.lnk files, parse the shortcuts into:
' g_sc() = (1)|(2)|(3)|(4)|(5)
' (1) = P|V
' (2) = Path\To\Shortcut.lnk
' (3) = Path\To\Icon.ico
' (4) = TargetFolder
' (5) = Arguments
LOCAL e, tmp() AS STRING
LOCAL i AS LONG
REDIM g_vd(0), g_pc(0), g_an(0)
DIM tmp(UBOUND(g_sc))
FOR i = LBOUND(g_sc) TO UBOUND(g_sc)
' Extract shortcut name
tmp(i) = PATHNAME$(NAME, g_sc(i))
' Read shortcut info
g_sc(i) = ReadShortcut2(g_sc(i))
NEXT
' Sort alphabetically (pics & vidz folders mixed)
ARRAY SORT tmp(), COLLATE UCASE, TAGARRAY g_sc()
' Create pic/vid/anything lists
REDIM g_an(UBOUND(g_sc))
FOR i = LBOUND(g_sc) TO UBOUND(g_sc)
' Add to anything
g_an(i) = i
' Add to pics or vidz
IF LEFT$(g_sc(i), 1) = "V" THEN
REDIM PRESERVE g_vd(1 + UBOUND(g_vd))
g_vd(UBOUND(g_vd)) = i
ELSE
REDIM PRESERVE g_pc(1 + UBOUND(g_pc))
g_pc(UBOUND(g_pc)) = i
END IF
NEXT
' Randomize pics/vidz/anything lists
RANDOMIZE TIMER
FOR i = 1 TO UBOUND(g_pc)
SWAP g_pc(RND(1,UBOUND(g_pc))), g_pc(RND(1,UBOUND(g_pc)))
NEXT
FOR i = 1 TO UBOUND(g_vd)
SWAP g_vd(RND(1,UBOUND(g_vd))), g_vd(RND(1,UBOUND(g_vd)))
NEXT
FOR i = 1 TO UBOUND(g_an)
SWAP g_an(RND(1,UBOUND(g_an))), g_an(RND(1,UBOUND(g_an)))
NEXT
END SUB
'-------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------
FUNCTION NextRndPic() AS LONG
STATIC n AS LONG
INCR n
IF n > UBOUND(g_pc) THEN n = 1
FUNCTION = g_pc(n)
END FUNCTION
'-------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------
FUNCTION NextRndVid() AS LONG
STATIC n AS LONG
INCR n
IF n > UBOUND(g_vd) THEN n = 1
FUNCTION = g_vd(n)
END FUNCTION
'-------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------
FUNCTION NextRndAnything() AS LONG
STATIC n AS LONG
INCR n
IF n > UBOUND(g_an) THEN n = 1
FUNCTION = g_an(n)
END FUNCTION
'-------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------
SUB GetVlcPath
LOCAL e AS STRING
' Favorise vlcrun.exe over vlc.exe ...
IF EXISTS("vlcrun.exe") THEN g_vlcpath += EXE.PATH$ + "\vlcrun.exe" : GOTO VlcFound
' Get VLC path from registry
LET g_vlcpath = GETREGVALUE(%HKEY_LOCAL_MACHINE, "SOFTWARE\VideoLAN\VLC", "")
IF g_vlcpath <> "" THEN GOTO VlcFound
' Not found in default key > try another key
LET g_vlcpath = GETREGVALUE(%HKEY_LOCAL_MACHINE, "SOFTWARE\VideoLAN\VLC", "InstallDir")
IF g_vlcpath <> "" THEN g_vlcpath += "\vlc.exe" : GOTO VlcFound
' Not found via registry > try a manual method
g_vlcpath = "C:\Program Files (x86)\VideoLAN\VLC\"
e = DIR$(g_vlcpath + "vlc.exe") : DIR$ CLOSE
IF e <> "" THEN g_vlcpath += e : GOTO VlcFound
' Last attempt...
g_vlcpath = "C:\Program Files\VideoLAN\VLC\"
e = DIR$(g_vlcpath + "vlc.exe") : DIR$ CLOSE
IF e <> "" THEN g_vlcpath += e : GOTO VlcFound
' Definitely not found :(
g_vlcpath = ""
VlcFound:
' IF EXISTS("vlcrun.exe") THEN h = SHELL("vlcrun.exe /hidden")
END SUB
'-------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------
FUNCTION PBMAIN () AS LONG
LOCAL hDlg AS DWORD
LOCAL i, j, x, y AS LONG
LOCAL w, h, n AS LONG
' Check if we are running on Linux
g_onunix = IsOnUnix()
' Check if ImageMagick is installed on the system
g_magick = IsImageMagickInstalled()
' Get VLC path
GetVlcPath()
' GetPreferences
IF NOT EXISTS(LEFT$(EXE.FULL$,-3)+"ini") THEN WriteIni()
ReadPrefs()
' Search for all shortcuts in current directory
DetectAllShortcuts()
n = CEIL(g_ratio * CEIL(SQR(UBOUND(g_sc))))
w = MAX(420, 10 + (g_icow+10) * n)
h = MAX(240, 60 + (g_icow+10) * CEIL(UBOUND(g_sc)/n) + 30)
' Create dialog
DIALOG NEW PIXELS, 0, "Shuffle GUI", , , w, h, %WS_POPUP _
OR %WS_BORDER OR %WS_DLGFRAME OR %WS_CAPTION OR %WS_SYSMENU OR _
%WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR _
%DS_NOFAILCREATE OR %DS_SETFONT OR %WS_MINIMIZEBOX, %WS_EX_CONTROLPARENT OR _
%WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg
DIALOG SET ICON hDlg, "AICO"
' No shortcut found near program > readme
IF n = 0 THEN
' Create RTF control
LoadLibrary("RICHED32.DLL")
CONTROL ADD "RichEdit", hDlg, 991, "", 8, 8, w-16, h-40, _
%WS_CHILD OR %WS_VISIBLE OR %ES_MULTILINE _
OR %ES_READONLY OR %WS_VSCROLL
Fill_RichEdit hDlg, 991
CONTROL ADD BUTTON, hDlg, %IDCANCEL, "OK", (w-60)\2, h-32, 60, 24
' Shortcuts found near the program > GUI
ELSE
' Build header:
' Any picture
CONTROL ADD GRAPHIC, hDlg, 771, "", 5, 22, 16, 16
GRAPHIC ATTACH hDlg, 771 : GRAPHIC CLEAR DlgBgCol
DrawSmallPicIconIn hDlg, 771
CONTROL ADD BUTTON, hDlg, 991, "Any picture", 21, 20, 80, 20
' Any video
CONTROL ADD GRAPHIC, hDlg, 772, "", 110, 22, 16, 16
GRAPHIC ATTACH hDlg, 772 : GRAPHIC CLEAR DlgBgCol
DrawSmallVidIconIn hDlg, 772
CONTROL ADD BUTTON, hDlg, 992, "Any video", 126, 20, 80, 20
' Video filter
CONTROL ADD GRAPHIC, hDlg, 773, "", 215, 22, 16, 16
GRAPHIC ATTACH hDlg, 773 : GRAPHIC CLEAR DlgBgCol
GRAPHIC RENDER "BICK", (0,0)-(15,15)
CONTROL ADD BUTTON, hDlg, 993, "Video filter", 231, 20, 80, 20
IF NOT EXISTS("ickvdo.exe") THEN CONTROL DISABLE hDlg, 993
' Anything
CONTROL ADD GRAPHIC, hDlg, 774, "", 320, 22, 16, 16
GRAPHIC ATTACH hDlg, 774: GRAPHIC CLEAR DlgBgCol
IF g_onunix THEN ' Draw Linux heart icon
GraphicDrawIconDll hDlg, 774, "shell32.dll", 82, 0, 0, 16, 16
ELSE ' Draw prettier Win10+ running dialog icon
GraphicDrawIconDll hDlg, 774, "imageres.dll", 95, 0, 0, 16, 16
END IF
CONTROL ADD BUTTON, hDlg, 994, "Anything!", 336, 20, 80, 20
' Build footer:
CONTROL ADD LINE, hDlg, 888, "", 2, h-23, w-4, 1
CONTROL ADD LABEL, hDlg, 997, "v" + $VER + " (c) mougino.free.fr 2025", 10, h-18, 150, 16, %SS_NOTIFY
CONTROL ADD GRAPHIC, hDlg, 998, "", 160, h-19, 16, 16, %SS_NOTIFY
GRAPHIC ATTACH hDlg, 998
GRAPHIC CLEAR DlgBgCol
IF g_onunix THEN ' Draw Linux question mark icon
GraphicDrawIconDll hDlg, 998, "shell32.dll", 25, 0, 0, 16, 16
ELSE ' Draw prettier Win10+ information icon
GraphicDrawIconDll hDlg, 998, "imageres.dll", 76, 0, 0, 16, 16
END IF
CONTROL ADD LINE, hDlg, 888, "", 185, h-21, 1, h-2
CONTROL ADD LABEL, hDlg, 999, "", 194, h-18, w-198, 16
' Build body (shadow shortcuts for the moment)
FOR j = 1 TO CEIL(UBOUND(g_sc)/n)
FOR i = 1 TO n
IF n*(j-1)+i > UBOUND(g_sc) THEN EXIT FOR
x = 4 + (g_icow + 10) * (i - 1)
y = 60 + (g_icow + 10) * (j - 1)
' Create graphic controls
CONTROL ADD GRAPHIC, hDlg, 1000 + n*(j-1)+i, "", x, y, g_icow, g_icow+2, %SS_NOTIFY
GRAPHIC ATTACH hDlg, 1000 + n*(j-1)+i, REDRAW
' Draw shadow folder icon
GRAPHIC BOX (6,0)-(6+g_icow,g_icow), 0, %RGB_LIGHTGRAY, %RGB_LIGHTGRAY
' Carve the icon to make it look like a folder:
GRAPHIC BOX (6,0)-(10,g_icow+6), 0, DlgBgCol, DlgBgCol ' left border
GRAPHIC BOX (g_icow+2,0)-(g_icow+6,g_icow+6), 0, DlgBgCol, DlgBgCol ' right border
GRAPHIC BOX (6,0)-(g_icow+6,8), 0, DlgBgCol, DlgBgCol ' top border
GRAPHIC BOX (6,g_icow-10)-(g_icow+6,g_icow+6), 0, DlgBgCol, DlgBgCol ' bottom border
GRAPHIC BOX (36,0)-(g_icow+12,15), -2, DlgBgCol, DlgBgCol ' top right carving
NEXT i
NEXT j
END IF
' Show dialog
DIALOG SHOW MODAL hDlg CALL DlgProc
END FUNCTION
'-------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------
MACRO LaunchShortcut(sc_ini)
' g_sc() = (1)|(2)|(3)|(4)
' (1) = P|V
' (2) = Path\To\Shortcut.lnk
' (3) = Path\To\Icon.ico
' (4) = TargetFolder
MACROTEMP sc_n
DIM sc_n AS LONG
sc_n = sc_ini
IF ISFALSE CheckTargetExists(sc_n) THEN BEEP : EXIT FUNCTION
IF g_sc_pty(sc_n, 1) = "P" OR ickvdo = 0 THEN
ShellExecute %NULL, "open", g_sc_pty(sc_n, 2), "", "", %SW_SHOW
ELSE
ShellExecute %NULL, "open", "ickvdo.exe", g_sc_pty(sc_n, 4), "", %SW_SHOW
END IF
IF ISTRUE ickvdo THEN
ickvdo = 0
SetCursor LoadCursor(%NULL, BYVAL %IDC_HAND)
DIALOG DOEVENTS
END IF
CONTROL SET TEXT CB.HNDL, 999, "Launching random " _
+ IIF$(g_sc_pty(sc_n, 1) = "P","pic","vid") _
+ " from " + g_sc_pty(sc_n, 4)
FOR i = 1 TO 3
CONTROL SHOW STATE CB.HNDL, 1000+sc_n, %SW_HIDE
DIALOG REDRAW CB.HNDL
SLEEP 450
CONTROL SHOW STATE CB.HNDL, 1000+sc_n, %SW_SHOW
DIALOG REDRAW CB.HNDL
SLEEP 450
NEXT
END MACRO
'-------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------
SUB DrawSmallPicIconIn(BYVAL hDlg AS DWORD, BYVAL iCtl AS LONG)
' Draw a small 16x16 overlay picture icon in the top left corner of the control
IF g_onunix THEN ' Draw Linux image icon
GraphicDrawIconDll hDlg, iCtl, "shell32.dll", 113, 0, 0, 16, 16
ELSE ' Draw prettier Win10+ image icon
GraphicDrawIconDll hDlg, iCtl, "imageres.dll", 190, 0, 0, 16, 16
END IF
END SUB
'-------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------
SUB DrawSmallVidIconIn(BYVAL hDlg AS DWORD, BYVAL iCtl AS LONG)
' Draw a small 16x16 overlay video icon in the top left corner of the control
IF g_onunix THEN ' Draw Linux video icon
GraphicDrawIconDll hDlg, iCtl, "shell32.dll", 111, 0, 0, 16, 16
ELSEIF LEN(g_vlcpath) THEN ' Draw Windows vlc|vlcrun icon
GraphicDrawIconDll hDlg, iCtl, (g_vlcpath), 0, 0, 0, 16, 16
ELSE ' Draw prettier Win10+ video icon
GraphicDrawIconDll hDlg, iCtl, "imageres.dll", 192, 0, 0, 16, 16
END IF
END SUB
'-------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------
CALLBACK FUNCTION DlgProc () AS LONG
STATIC hCursor AS DWORD
STATIC ickvdo AS LONG
LOCAL i, j, k, n, w, h, x, y AS LONG
LOCAL hFnt AS DWORD
LOCAL r AS STRING
SELECT CASE CB.MSG
CASE %WM_INITDIALOG
DIALOG REDRAW CB.HNDL
hCursor = LoadResCursor("CICK")
SetTimer(CB.HNDL, 0, 50, 0) ' start prebuffer monitoring
CASE %WM_SETCURSOR ' change cursor to link-hand/ickvdo when hovering over controls
i = GetDlgCtrlId(CB.WPARAM)
IF i >= 997 AND i <= 1000 + UBOUND(g_sc) THEN
IF i >= 999 AND ISTRUE ickvdo THEN
SetCursor hCursor
ELSE
SetCursor LoadCursor(%NULL, BYVAL %IDC_HAND)
END IF
SetWindowLong CB.HNDL, %dwl_msgresult, 1
FUNCTION = 1
END IF
CASE %WM_TIMER
KillTimer(CB.HNDL, 0)
DIALOG REDRAW CB.HNDL
n = CEIL(g_ratio * CEIL(SQR(UBOUND(g_sc))))
FONT NEW "", 7, 0, 0, 0, 0 TO hFnt
ReadAllShortcuts()
FOR j = 1 TO CEIL(UBOUND(g_sc)/n)
FOR i = 1 TO n
IF n*(j-1)+i > UBOUND(g_sc) THEN EXIT FOR
x = 4 + (g_icow + 10) * (i - 1)
y = 60 + (g_icow + 10) * (j - 1)
' Fill graphic controls
' CONTROL ADD GRAPHIC, CB.HNDL, 1000 + n*(j-1)+i, "", x, y, g_icow, g_icow+2, %SS_NOTIFY
GRAPHIC ATTACH CB.HNDL, 1000 + n*(j-1)+i, REDRAW
r = g_sc_pty(n*(j-1)+i, 5) ' in case it's a playlist: display its path
IF INSTR(LCASE$(r), ".m3u8") = 0 THEN r = g_sc_pty(n*(j-1)+i, 4) ' in any other case: display target folder
SetTooltip CB.HNDL, 1000 + n*(j-1)+i, r + IIF$(CheckTargetExists(n*(j-1)+i), "", " (missing on disk)")
r = g_sc_pty(n*(j-1)+i, 3) ' shortcut icon path
IF r = "!" OR r = "" THEN
' Draw custom folder icon
GRAPHIC BOX (6,0)-(6+g_icow,g_icow), 0, RGB(235,199,100), RGB(235,199,100)
ELSE
' Render pic shortcut icon
GraphicDrawIconFile CB.HNDL, 1000 + n*(j-1)+i, r, 6, 0, g_icow, g_icow
END IF
' Carve the icon to make it look like a folder:
GRAPHIC BOX (6,0)-(10,g_icow+6), 0, DlgBgCol, DlgBgCol ' left border
GRAPHIC BOX (g_icow+2,0)-(g_icow+6,g_icow+6), 0, DlgBgCol, DlgBgCol ' right border
GRAPHIC BOX (6,0)-(g_icow+6,8), 0, DlgBgCol, DlgBgCol ' top border
GRAPHIC BOX (6,g_icow-10)-(g_icow+6,g_icow+6), 0, DlgBgCol, DlgBgCol ' bottom border
GRAPHIC BOX (36,0)-(g_icow+12,15), -2, DlgBgCol, DlgBgCol ' top right carving
' Print shortcut name
r = PATHNAME$(NAME, g_sc_pty(n*(j-1)+i, 2))
IF MID$(r, LEN(r)-2, 1) = "_" AND RIGHT$(r, 1) = "c" THEN r = LEFT$(r, -3)
GRAPHIC SET FONT hFnt
GRAPHIC COLOR -1, -1
GRAPHIC TEXT SIZE r TO w, h
GRAPHIC SET POS (MAX(0,6+(g_icow-w)\2), g_icow-10)
GRAPHIC PRINT r
' Draw scale on left if applicable
GRAPHIC ATTACH CB.HNDL, 1000 + n*(j-1)+i, REDRAW
r = PATHNAME$(NAME, g_sc_pty(n*(j-1)+i, 2))
IF RIGHT$(r, 3) = "_hc" THEN
GRAPHIC BOX (0,12+1*(g_icow-16)\8)-(9,11+2*(g_icow-16)\8), -1, RGB(177,30,12), RGB(177,30,12)
GRAPHIC BOX (1,12+2*(g_icow-16)\8)-(9,11+3*(g_icow-16)\8), -1, RGB(249,65,30), RGB(249,65,30)
END IF
IF RIGHT$(r, 3) = "_hc" OR RIGHT$(r, 3) = "_mc" THEN
GRAPHIC BOX (2,12+3*(g_icow-16)\8)-(9,11+4*(g_icow-16)\8), -1, RGB(254,183,7), RGB(254,183,7)
GRAPHIC BOX (3,12+4*(g_icow-16)\8)-(9,11+5*(g_icow-16)\8), -1, RGB(250,210,50), RGB(250,210,50)
END IF
IF RIGHT$(r, 3) = "_hc" OR RIGHT$(r, 3) = "_mc" OR RIGHT$(r, 3) = "_sc" THEN
GRAPHIC BOX (4,12+5*(g_icow-16)\8)-(9,11+6*(g_icow-16)\8), -1, RGB(124,188,3), RGB(124,188,3)
GRAPHIC BOX (5,12+6*(g_icow-16)\8)-(9,11+7*(g_icow-16)\8), -1, RGB(153,209,46), RGB(153,209,46)
END IF
' Picture folder -> draw system image icon
IF g_sc_pty(n*(j-1)+i, 1) = "P" THEN
DrawSmallPicIconIn CB.HNDL, 1000 + n*(j-1)+i
' Video folder -> draw VLC icon in overlay
ELSE
DrawSmallVidIconIn CB.HNDL, 1000 + n*(j-1)+i
END IF
' Disable (convert to grayscale) shortcuts to non-existing folders
IF ISFALSE CheckTargetExists(n*(j-1)+i) THEN
Graphic2Grayscale CB.HNDL, 1000 + n*(j-1)+i
END IF
' Display full shortcut
GRAPHIC REDRAW
IF n*(j-1)+i MOD 5 = 0 THEN DIALOG DOEVENTS
NEXT i
IF n*(j-1)+i > UBOUND(g_sc) THEN EXIT FOR
NEXT j
DIALOG REDRAW CB.HNDL
' Process RTF hyperlinks
CASE %WM_NOTIFY
IF CB.NMID = 991 AND CB.NMCODE = %EN_LINK THEN RTF_hyperlink CB.HNDL, 991, CB.LPARAM
' Right-click on a shortcut: open its target path
CASE %WM_CONTEXTMENU
i = GETDLGCTRLID(CB.WPARAM)
IF i <= 1000 OR i > 1000 + UBOUND(g_sc) THEN EXIT FUNCTION
IF ISFALSE CheckTargetExists(i - 1000) THEN BEEP : EXIT FUNCTION
r = "/select," + $DQ + g_sc_pty(i - 1000, 5) + $DQ ' in case it's a playlist: select it in the file explorer
IF INSTR(LCASE$(r), ".m3u8") = 0 THEN r = $DQ + g_sc_pty(i - 1000, 4) + $DQ ' in any other case: open target folder
ShellExecute 0, "open", "explorer.exe", (r), "", %SW_SHOW
' Process user clicks
CASE %WM_COMMAND
' Anything other than single left click: ignore
IF CB.CTLMSG <> %BN_CLICKED THEN EXIT FUNCTION
' Click on the footer
IF CB.CTL = 997 OR CB.CTL = 998 THEN
ShellExecute %NULL, "open", "http://mougino.free.fr/freeware", "", "", %SW_SHOW
' Click on a shortcut
ELSEIF CB.CTL > 1000 AND CB.CTL <= 1000 + UBOUND(g_sc) THEN
LaunchShortcut (CB.CTL - 1000)
' Click on "Any picture"
ELSEIF CB.CTL = 991 THEN
LaunchShortcut (NextRndPic())
' Click on "Any video"
ELSEIF CB.CTL = 992 THEN
LaunchShortcut (NextRndVid())
' Click on "Video filter"
ELSEIF CB.CTL = 993 THEN
ickvdo = 1 - ickvdo
' Click on "Anything!"
ELSEIF CB.CTL = 994 THEN
LaunchShortcut (NextRndAnything())
' Click on "OK" in the readme
ELSEIF CB.CTL = %IDCANCEL THEN
DIALOG END CB.HNDL
END IF
END SELECT
END FUNCTION
'-------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------
SUB Fill_RichEdit (hD AS DWORD, CtlId AS LONG)
LOCAL richtext AS STRING
richtext = "[black][c]"
richtext += "[font:o,11][b]ShuffleGUI.exe v" + $VER + "[/b][eol][l]"
richtext += "[font:o,9][black][c][eol]"
richtext += "This program works best displaying the shortcuts produced by[eol]"
richtext += "[blue]img-rnd[black] (http://mougino.free.fr/freeware/#imgrnd) and[eol]"
richtext += "[blue]VLC Folder[black] (http://mougino.free.fr/freeware/#vspf).[eol]"
richtext += "[eol]"
richtext += "If you want to see a small demo, double-click on "
richtext += "[blue]UnpackDemo.exe [black], provided in the download archive, "
richtext += "then run this program again.[eop]"
richtext += "[eol]"
richtext += "[c][b][maroon]C[red]r[fuschia]e[purple]a[blue]t[teal]e[green]d [lime]b"
richtext += "[grey]y [maroon]m[red]o[fuschia]u[purple]g[blue]i[teal]n[green]o[lime]"
richtext += " - http://mougino.free.fr[/b]"
richtext += "[eol]"
richtext += "[eop]"
RTF_SET hD, CtlId, richtext
END SUB
'-------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------
SUB Graphic2Grayscale(BYVAL hDlg AS DWORD, BYVAL grId AS LONG)
LOCAL hBmp AS DWORD
LOCAL grW, grH AS LONG
' Copy content of graphic control to new bitmap object
CONTROL GET SIZE hDlg, grId TO grW, grH
GRAPHIC BITMAP NEW grW, grH TO hBmp
GRAPHIC ATTACH hBmp, 0, REDRAW
GRAPHIC COPY hDlg, grId, (0, 0)-(grW-1, grH-1) TO (0, 0)
' Convert bitmap to grayscale
CreateGrayScale hBmp
' Draw back grayed bitmap to graphic control
GRAPHIC ATTACH hDlg, grId, REDRAW
GRAPHIC COPY hBmp, 0
' Clean-up gray bitmap object
GRAPHIC ATTACH hBmp, 0, REDRAW
GRAPHIC BITMAP END
END SUB
'-------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------
SUB CreateGrayScale(BYVAL hBMP AS DWORD)
LOCAL R, G, B AS SINGLE
LOCAL i, w, h AS LONG
LOCAL iColor AS DWORD
LOCAL p AS LONG PTR
LOCAL bmp$
LOCAL map AS BITMAP
'get bitmap size and binary string
GetObject hBmp, LEN(map), map
w = map.bmWidth
h = map.bmHeight
GRAPHIC ATTACH hBMP, 0
GRAPHIC GET BITS TO bmp$
p = STRPTR(bmp$)+8 'position of starting position for bits in string
FOR i = 1 TO w * h
'get RGB component values
iColor = @p 'result is a BGR color value 0-R-G-B
B = iColor MOD 256
G = (iColor\256) MOD 256
R = (iColor\256\256) MOD 256
iColor = 0.299*R + 0.587*G + 0.114*B
@p = BGR(iColor, iColor, iColor) 'modify string at that position
INCR p
NEXT
'put the modified string back into selected Graphic target
GRAPHIC SET BITS bmp$
END SUB
'-------------------------------------------------------------------------------------------