File "img-rnd.bas"
Path: /img-rnd/img-rnd.bas
File size: 12.8 KB
MIME-type:
Charset: utf-8
#COMPILE EXE
#DIM ALL
#RESOURCE "IR.PBR"
%LOGME = 0
$VER = "1.1"
#INCLUDE "Win32Api.inc"
#INCLUDE "CommCtrl.inc"
#INCLUDE "SavePos.inc"
#INCLUDE "INI.inc"
GLOBAL IV_exe AS STRING ' IrfanView executable filepath
GLOBAL IV_ini AS STRING ' IrfanView ini filepath
GLOBAL Fldr() AS STRING ' Array of subfolders
GLOBAL FldrCnt AS LONG ' Number of subfolders
'-----------------------------------------------------------------------------------------------
SUB GetIVPaths()
LOCAL e AS STRING
' Get path for Portable IrfanView
IV_exe = DIR$(EXE.PATH$ + "IrfanViewPortable*", ONLY %SUBDIR) : DIR$ CLOSE
IF IV_exe <> "" THEN
IV_exe = EXE.PATH$ + IV_exe + "\"
e = DIR$(IV_exe + "IrfanView*.exe") : DIR$ CLOSE
IF e <> "" THEN
IV_ini = IV_exe + "Data\IrfanView\"
IV_exe += e
LogMe "Irfan Viewer (Portable) location = " + $DQ + IV_exe + $DQ
e = DIR$(IV_ini + "i_view??.ini") : DIR$ CLOSE
IV_ini += e
LogMe "Found IrfanViewPortable settings in " + $DQ + IV_ini + $DQ
ELSE
IV_exe = ""
LogMe "Irfan Viewer Portable location = " + $DQ + IV_exe + $DQ
END IF
END IF
IF IV_exe = "" THEN
' Get path for Local IrfanView
IV_ini = RoamingAppData + "IrfanView\"
e = DIR$(IV_ini + "i_view??.ini") : DIR$ CLOSE
IV_ini += e
LogMe "Found IrfanView settings in " + $DQ + IV_ini + $DQ
IV_exe = GetIniS (IV_ini, "Others", "ExternalViewer3")
LogMe "Irfan Viewer location = " + $DQ + IV_exe + $DQ
END IF
END SUB
'-----------------------------------------------------------------------------------------------
'-----------------------------------------------------------------------------------------------
SUB KillAnyPreviousInstance(BYVAL caption AS STRING)
LOCAL hDlg, hBtn AS DWORD
hDlg = FindWindow(BYVAL 0, (caption))
IF hDlg <> %NULL THEN ' Program probably already running ?
hBtn = GetDlgItem(hDlg, 888)
PostMessage hBtn, %BM_CLICK, 0, 0 ' Force close previous instance
DIALOG DOEVENTS
END IF
END SUB
'-----------------------------------------------------------------------------------------------
'-----------------------------------------------------------------------------------------------
FUNCTION PBMAIN () AS LONG
LOCAL hD, hFnt AS DWORD
' Kill any previous running instance
KillAnyPreviousInstance "RND"
' Create dialog
DIALOG NEW PIXELS, 0, "RND",,, 60, 40 TO hD
FONT NEW "", 6 TO Hfnt
CONTROL ADD LISTVIEW, hD, 777, "", -5,0,65,65, %LVS_ICON OR %LVS_AUTOARRANGE OR %WS_DISABLED
LISTVIEW INSERT COLUMN hD, 777, 1, "icon", 32, 0
CONTROL ADD TEXTBOX, hD, 887, "1", 90, 70, 2, 2 ' this textbox (active) is apparently mandatory (?)
CONTROL ADD BUTTON, hD, 888, "&Close", 100, 80, 2, 2 ' hidden close button
CONTROL ADD LABEL, hD, 666, $VER, 2,31,56,9, %SS_RIGHT
CONTROL SET COLOR hD, 666, -1, -2
CONTROL SET FONT hD, 666, hFnt
' Set Always On Top
SetWindowLong hD, %GWL_style, %WS_POPUP OR %WS_BORDER OR %WS_DLGFRAME _
OR %WS_SYSMENU OR %WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME _
OR %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT OR %WS_CAPTION
SetWindowLong hD, %GWL_EXstyle, %WS_EX_WINDOWEDGE OR %WS_EX_CONTROLPARENT _
OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR OR %WS_EX_TOOLWINDOW
SetWindowPos hD, %HWND_TOPMOST, 0, 0, 0, 0, %SWP_NOMOVE OR %SWP_NOSIZE
SetWindowPos hD, %HWND_TOPMOST, 0, 0, 0, 0, %SWP_NOMOVE OR %SWP_NOSIZE
' Set dialog icon and display it!
SetDialogIconFromDll hD, "Shell32.dll", 46
DIALOG SHOW MODAL hD, CALL ProcMain
FONT END hFnt
END FUNCTION
'-----------------------------------------------------------------------------------------------
'-----------------------------------------------------------------------------------------------
SUB Set_LV_Icon(BYVAL hD AS DWORD, BYVAL idx AS LONG)
LOCAL hImgLst, hIco AS DWORD
IMAGELIST NEW ICON 32, 32, 24, 6 TO hImgLst
LISTVIEW SET IMAGELIST hD, 777, hImgLst, %LVSIL_NORMAL
hIco = ExtractIcon(BYVAL 0, "Shell32.dll", idx)
IMAGELIST ADD ICON hImgLst, hIco
LISTVIEW INSERT ITEM hD, 777, 1, 1, "1"
DestroyIcon hIco
END SUB
'-----------------------------------------------------------------------------------------------
'-----------------------------------------------------------------------------------------------
MACRO LaunchRandomImg
IF IV_ini = "" THEN
?"IrfanView not detected." + $CR + "Please install it then re-launch this program.",, EXE.NAME$
EXIT FUNCTION
END IF
ShellExecute 0, "open", (IV_exe), "/killmesoftly", "", %SW_HIDE ' close all IrfanView instances
'KillDialogsWithClass "IrfanView"
SLEEP 600
IF FldrCnt <= 2 THEN
lidx = 0
ELSE
lidx = RND(1, FldrCnt)
END IF
e = FirstJpg(Fldr(lidx))
LogMe "Launching random " + $DQ + e + $DQ + " (folder #" + TRIM$(STR$(lidx)) + "/" + TRIM$(STR$(FldrCnt)) + ")"
ShellExecute 0, "open", (IV_exe), $DQ + e + $DQ + " /random", "", %SW_SHOW
END MACRO
'-----------------------------------------------------------------------------------------------
'-----------------------------------------------------------------------------------------------
MACRO Jump2NextFolder
IF IV_ini = "" THEN
?"IrfanView not detected." + $CR + "Please install it then re-launch this program.",, EXE.NAME$
EXIT FUNCTION
END IF
ShellExecute 0, "open", (IV_exe), "/killmesoftly", "", %SW_HIDE ' close all IrfanView instances
'KillDialogsWithClass "IrfanView"
SLEEP 200
IF FldrCnt <= 2 THEN
lidx = 0
ELSE
INCR lidx
IF lidx > FldrCnt THEN lidx = 1
END IF
e = FirstJpg(Fldr(lidx))
LogMe "Launching next " + $DQ + e + $DQ + " (folder #" + TRIM$(STR$(lidx)) + "/" + TRIM$(STR$(FldrCnt)) + ")"
ShellExecute 0, "open", (IV_exe), $DQ + e + $DQ + " /random", "", %SW_SHOW
END MACRO
'-----------------------------------------------------------------------------------------------
'-----------------------------------------------------------------------------------------------
CALLBACK FUNCTION ProcMain
STATIC hThread AS DWORD
STATIC idEvent, tic, hr, lidx AS LONG
LOCAL e AS STRING
LOCAL i AS LONG
CB_SAVEPOS
IF CB.MSG = %WM_INITDIALOG THEN ' dialog initialization
' Reset log file, Init randomizer
KILL EXE.PATH$ + EXE.NAME$ + ".log"
RANDOMIZE TIMER
' Search for IrfanView program
e = DIR$(RoamingAppData + "IrfanView\*.ini") : DIR$ CLOSE
IF LEN(e) = 0 THEN ' IrfanView not detected
Set_LV_Icon CB.HNDL, 77 ' warning icon
EXIT FUNCTION
END IF
' Initialize IrfanView paths
GetIVPaths()
' Launch background thread
Set_LV_Icon CB.HNDL, 46 ' randomizer icon
idEvent = SetTimer(CB.HNDL, 401, 500, BYVAL %NULL)
ELSEIF CB.MSG = %WM_TIMER THEN ' scan folders in background
IF hThread = 0 THEN
THREAD CREATE ScanSubfolders(CB.HNDL) TO hThread
ELSE
' Visual anim
tic = -1 - tic
CONTROL SHOW STATE CB.HNDL, 777, IIF(tic,%SW_HIDE,%SW_RESTORE)
' Check on thread every 500 ms
THREAD STATUS hThread TO hr
LogMe "Background thread returned code " + FORMAT$(hr)
IF hr <> &H103 AND hr <> 0 THEN
KillTimer CB.HNDL, idEvent : idEvent = 0
THREAD CLOSE hThread TO tic : hThread = 0
CONTROL SHOW STATE CB.HNDL, 777, %SW_RESTORE
LaunchRandomImg
END IF
END IF
ELSEIF CB.MSG = %WM_CONTEXTMENU THEN ' right-click on the dialog
LogMe "User right-clicked. idEvent = " + FORMAT$(idEvent) + " ; hr = " + FORMAT$(hr)
IF idEvent <> 0 THEN EXIT FUNCTION ' background thread still in progress
' launch next folder
Jump2NextFolder
ELSEIF CB.MSG = %WM_LBUTTONDOWN THEN ' left-click in the dialog
LogMe "User left-clicked. idEvent = " + FORMAT$(idEvent) + " ; hr = " + FORMAT$(hr)
IF idEvent <> 0 THEN EXIT FUNCTION ' background thread still in progress
' launch random folder
LaunchRandomImg
ELSEIF CB.MSG = %WM_COMMAND AND CB.CTL = 888 THEN ' close button (Alt+C)
DIALOG END CB.HNDL
ELSEIF CB.MSG = %WM_DESTROY THEN ' program quitting > cleanup!
IF IV_ini = "" THEN EXIT FUNCTION
ShellExecute 0, "open", (IV_exe), "/killmesoftly", "", %SW_HIDE ' close all IrfanView instances
SLEEP 200
'KillDialogsWithClass "IrfanView"
SetIni IV_ini, "Open", "OpenDir", ""
FOR i = 1 TO 28
SetIni IV_ini, "Thumbnails", "MRUD" + FORMAT$(i), ""
NEXT
FOR i = 1 TO 14
SetIni IV_ini, "RecentFiles", "File" + FORMAT$(i), ""
NEXT
END IF
END FUNCTION
'-----------------------------------------------------------------------------------------------
'-----------------------------------------------------------------------------------------------
THREAD FUNCTION ScanSubfolders(BYVAL hD AS LONG) AS LONG
LogMe "Scanning subfolders from " + $DQ + CURDIR$ + $DQ + "..."
ListSubFolders CURDIR$
LogMe "Done - " + TRIM$(STR$(FldrCnt)) + " subfolder()s found"
FUNCTION = 1
END FUNCTION
'-----------------------------------------------------------------------------------------------
'-----------------------------------------------------------------------------------------------
SUB LogMe (e AS STRING)
IF ISFALSE %LOGME THEN EXIT SUB
LOCAL ff AS LONG
LOCAL d, t AS STRING
' Create TimeStamp
d = DATE$
d = RIGHT$(d,4) + LEFT$(d,2) + MID$(d, 4, 2)
t = TIME$
REPLACE ":" WITH "" IN t
t = d + "-" + t + ","
t = t + FORMAT$((TIMER*1000) MOD 1000, "000")
' Write To Log File
ff = FREEFILE
OPEN EXE.PATH$ + EXE.NAME$ + ".log" FOR APPEND AS #ff
PRINT #ff, "[" + t + "] " + e
CLOSE #ff
END SUB
'-----------------------------------------------------------------------------------------------
'-----------------------------------------------------------------------------------------------
SUB SetDialogIconFromDll(hDlg AS DWORD, windll AS STRING, iconId AS LONG)
LOCAL hIconBig AS DWORD
LOCAL hIconSmall AS DWORD
ExtractIconEx((windll), iconId, BYVAL VARPTR(hIconBig), BYVAL VARPTR(hIconSmall), 1)
SetClassLong hDlg, %GCL_HICONSM, hIconSmall
SetClassLong hDlg, %GCL_HICON, hIconBig
SendMessage hDlg, %WM_SETICON, %ICON_SMALL, hIconSmall
SendMessage hDlg, %WM_SETICON, %ICON_BIG, hIconBig
END SUB
'-----------------------------------------------------------------------------------------------
'-----------------------------------------------------------------------------------------------
FUNCTION SizeMb(fs AS LONG) AS STRING ' File size, in B, KB or MB
LOCAL n AS LONG
n = fs ' filesize
IF n < 1024 THEN
FUNCTION = FORMAT$(n) + " B"
ELSE
n \= 1024
IF n < 1024 THEN
FUNCTION = FORMAT$(n) + " KB"
ELSE
n \= 1024
FUNCTION = FORMAT$(n) + " MB"
END IF
END IF
END FUNCTION
'-----------------------------------------------------------------------------------------------
'-----------------------------------------------------------------------------------------------
SUB ListSubFolders(BYVAL startfolder AS STRING)
' Fill Fldr() with the list of subfolders (full paths) - unsorted
' Fldr(0) = root folder
' Fldr(1 TO FldrCnt) = subfolders
LOCAL temp AS STRING
REDIM Fldr(9999)
FldrCnt = 0
Fldr(0) = RTRIM$(startfolder, "\")
temp = DIR$(BUILD$(Fldr(0), "\*.*"), ONLY %SUBDIR) 'subfolders only
WHILE LEN(temp)
INCR FldrCnt
IF FldrCnt > UBOUND(Fldr) THEN REDIM PRESERVE Fldr(FldrCnt + 100)
Fldr(FldrCnt) = BUILD$(Fldr(0), "\", temp)
temp = DIR$(NEXT)
WEND
DIR$ CLOSE
REDIM PRESERVE Fldr(FldrCnt)
END SUB
'-----------------------------------------------------------------------------------------------
'-----------------------------------------------------------------------------------------------
FUNCTION FirstJpg(BYVAL rep AS STRING) AS STRING
LOCAL e AS STRING
e = DIR$(RTRIM$(rep, "\") + "\*.jpg") : DIR$ CLOSE
FUNCTION = RTRIM$(rep, "\") + "\" + e
END FUNCTION
'-----------------------------------------------------------------------------------------------