+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: Chatting and Socializing (https://qb64phoenix.com/forum/forumdisplay.php?fid=11)
+--- Forum: General Discussion (https://qb64phoenix.com/forum/forumdisplay.php?fid=2)
+--- Thread: Got an idea will it work ? (/showthread.php?tid=3709)
Got an idea will it work ? - doppler - 05-25-2025
Before I go off and try this. I will ask it here to see if "Yes you can and it would work". Generally the best idea's stay private and nobody benefits. I hate that approach.
What i do now: I use a program called Total Commander if you have used Norton commander in the past you know what I mean. It's great for finding all the filenames in a directory (sub-directories) or drive. From the total list show I can select via (numpad +) and subset based on a select pattern ie: *.jpg I can clip and drop that list into another program for processing. In short I have a list dropped into a program.
Is it possible: Using a console window in qb64pe to find all those JPG's list them with paths in the window, select them with ctrl-a and drop them into the program. Using it this way, I save lot's of clicks and steps.
I have done some amazing things I never did with qb45 using qb64pe (and extensions). If it's possible I have another sharp tool for the my toy box. If I figured wrong. Got an idea ?
Thanks
PS.
I never thought of this forum or users to be like Reddit. Everyone here is both helpful and smart as fuck.
RE: Got an idea will it work ? - bplus - 05-25-2025
I would say yes.
When you say select them with ctrl-a, do you mean select whole list or select a group of one or more files?
Select a subgroup gets harder. Don't think I've ever done a select of a group of items from a list. Oh, I see how now, doable too. So yeah sure doable.
Wait you can probably do all that with the _FileDialog tool we have now? no that is only one directory?
RE: Got an idea will it work ? - aadityap0901 - 05-25-2025
Here is what I made for some of my projects:
It recursively scans the folders and files, and you can modify it to include folders and files only you want:
Code: (Select All)
$Console:Only
L$ = GetNestedFileList$(_StartDir$)
Print ListStringPrint(L$) ' prints the list in the console
' ListStringToClipboard L$ ' if you want to copy the list...
Function GetNestedFileList$ (DIR$)
Static As _Unsigned Integer TEMP
Dim As _Unsigned Integer CurrentFileHandle
L$ = ListStringNew$
GetNestedFileList$ = L$
ListStringAdd L$, DIR$ ' here the directory name is added to the list
' you can comment this out if you only want file names
GetNestedFileList$ = L$
If _FileExists(DIR$) Then Exit Function
TEMP = TEMP + 1
CurrentFileHandle = TEMP
__FILE$ = "tmp" + _Trim$(Str$(CurrentFileHandle)) + ".txt"
Shell "dir " + Chr$(34) + DIR$ + Chr$(34) + " /b /o:n > " + __FILE$
Open __FILE$ For Input As #CurrentFileHandle
Do Until EOF(CurrentFileHandle)
Line Input #CurrentFileHandle, F$
F$ = DIR$ + "\" + F$
If _DirExists(F$) Then 'directory
L$ = ListStringAppend(L$, GetNestedFileList$(F$))
Else 'file
' here you can add with filters, like for *.jpg:
If Right$(F$, 4) = ".jpg" Then ListStringAdd L$, F$
End If
Loop
Close #CurrentFileHandle
Kill __FILE$
GetNestedFileList$ = L$
L$ = ""
End Function
' my List String Library
Function ListStringNew$
ListStringNew$ = Chr$(1) + MKL$(0)
End Function
Function ListStringPrint$ (LIST$)
If Len(LIST$) < 5 Then Exit Function
If Asc(LIST$) <> 1 Then Exit Function
Dim As _Unsigned Long O, I, L
O = 6
T$ = String$(Len(LIST$) - 4, 0)
Asc(T$) = 91 '[
For I = 1 To CVL(Mid$(LIST$, 2, 4)) - 1
L = CVI(Mid$(LIST$, O, 2))
Mid$(T$, O - 4, L + 2) = Mid$(LIST$, O + 2, L) + "," + Chr$(10)
O = O + L + 2
Next I
L = CVI(Mid$(LIST$, O, 2))
Mid$(T$, O - 4, L + 1) = Mid$(LIST$, O + 2, L) + "]"
ListStringPrint$ = Left$(T$, O + L - 4)
End Function
Sub ListStringToClipboard (LIST$)
If Len(LIST$) < 5 Then Exit Sub
If Asc(LIST$) <> 1 Then Exit Sub
Dim As _Unsigned Long O, I, L
O = 6
T$ = String$(Len(LIST$) - 4, 0)
For I = 1 To CVL(Mid$(LIST$, 2, 4)) - 1
L = CVI(Mid$(LIST$, O, 2))
Mid$(T$, O - 5, L + 2) = Mid$(LIST$, O + 2, L) + "," + Chr$(10)
O = O + L + 2
Next I
L = CVI(Mid$(LIST$, O, 2))
Mid$(T$, O - 5, L) = Mid$(LIST$, O + 2, L)
_Clipboard$ = Left$(T$, O + L - 5)
End Sub
Sub ListStringAdd (LIST$, ITEM$)
If Len(LIST$) < 5 Then Exit Sub
If Asc(LIST$) <> 1 Then Exit Sub
LIST$ = Chr$(1) + MKL$(CVL(Mid$(LIST$, 2, 4)) + 1) + Mid$(LIST$, 6) + MKI$(Len(ITEM$)) + ITEM$
End Sub
Function ListStringAppend$ (LIST1$, LIST2$)
If Len(LIST1$) < 5 Then Exit Function
If Len(LIST2$) < 5 Then Exit Function
If Asc(LIST1$) <> 1 Then Exit Function
If Asc(LIST2$) <> 1 Then Exit Function
ListStringAppend$ = Chr$(1) + MKL$(CVL(Mid$(LIST1$, 2, 4)) + CVL(Mid$(LIST2$, 2, 4))) + Mid$(LIST1$, 6) + Mid$(LIST2$, 6)
End FunctionIf that program is not a 3rd party program and instead some of your code, you can change it that it converts this text list to files paths...
RE: Got an idea will it work ? - SMcNeill - 05-25-2025
https://qb64phoenix.com/forum/showthread.php?tid=3627 -- Use the updated routine here to get your files into an array. The do whatever you need with it.
It's not recursive by nature, but it can read directories and you can simplify write it into a recursive routine to deal with those if desired.
RE: Got an idea will it work ? - bplus - 05-25-2025
Here is my submission using Direntry.h file in QB64pe.exe folder, a copy is at the end of code if you don't have it already. Now this might work in Linux as well as Windows.
3 ways to select:
1. click an item and select color toggles yellow (selected) or blue Not selected
2. press the spacebar when scrolled to item you want to select or deselect
3. enter item number (selects only)
Press enter (not after typing number) to finish your selection list and see it print to B&W screen.
Of course you can use the list created right inside your QB64pe application or print it to a file.
Code: (Select All)
_Title "GetSelections& test" ' b+ 2025-05-25
' direntry.h needs to be in QB64.exe folder, see below for a commented copy
Declare CustomType Library ".\direntry"
Function load_dir& (s As String)
Function has_next_entry& ()
Sub close_dir ()
Sub get_next_entry (s As String, flags As Long, file_size As Long)
End Declare
ReDim Shared ExtList$(1 To 50000) 'store our Bas pathed Files here
Dim Shared GrandTotal As _Unsigned Long ' ha, ha not that many!
Dim FullpathedDir$ ' starting directory for looking for Ext Files
Dim Ext$ ' extension looking for make sure it starts with "." and ucase like .BAS
Dim ChoiceCnt As Long ' function will count the choices you select and return that with list in choices()
' ====================== According to your OS check the following for your needs ==========================
' handle slashes according to OS, FullPathedDir$ can go either way
' but list file should be fully pathed for your OS
' VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV change this line to top directory of your search
FullpathedDir$ = "C:\Users\Mark\Pictures"
Ext$ = ".JPG"
't = Timer(.001)
FindAndCountExtFileFrom FullpathedDir$, Ext$
'Print " Grand Total "; Ext$; " ="; GrandTotal ' check
'Sleep
ReDim _Preserve ExtList$(1 To GrandTotal)
'Print UBound(ExtList$)
Screen _NewImage(1200, 720, 32) ' need wide screen
_ScreenMove 20, 0
ReDim choices(1 To 1) As String
ChoiceCnt = GetSelections&(3, 5, 140, 42, ExtList$(), choices())
Cls
Print "Your chices were:"
For i = 1 To ChoiceCnt
Print i, choices(i)
Next
'Open listFile$ For Output As #1
'For i = 1 To GrandTotal
' Print #1, ExtList$(i)
'Next
'Close #1
'Print listFile$ + ", file is ready, time:"; Timer(.001) - t
' Help: all this I hope is intuitive so Help not needed
' "Mouse, mouse wheel, and arrow keys should work as expected for item selection."
' "Press spacebar to toggle selection of highlighted item or just click it."
' "Use number(s) + enter to toggle selection of an array item by it's index number,"
' "backspace will remove last number pressed, c will clear a number started. << Change to Delete
' "Numbers started are shown in bottom right PgDn bar."
' !!! Enter will signal selections are finished!!!!
' "Home starts you at lowest array index, End highlights then highest index."
' "Use PgUp and PgDn keys to flip through pages of array items."
'
' Escape to Cancel and just exit
Function GetSelections& (locateRow, locateColumn, boxWidth, boxHeight, arr() As String, Selects() As String)
' If you want 10 lines of items in box use boxHeight of 12, 2 lines are used for Pg Up and Pg Dn bars.
' !!! This sub needs ScrState to store and restore screen condition before and after
' this sub does it's thing !!!
'Notes: locateRow, locateColumn for top right corner of selection box on screen in characters for LOCATE.
'boxWidth and boxHeight are in character units, again for locate and print at correct places.
'Displaying is restricted to inside box, which has PgUP and PgDn as top and bottom lines in the display.
Dim As Integer maxWidth, maxHeight, page, hlite, mx, my, lastMX, lastMY, row, mb, done
Dim As Long lba, uba, kh, index, i, selcnt, seli, vb
Dim As String clrStr, b
'save old settings to restore at end of sub
ScnState 0
maxWidth = boxWidth ' number of characters in box
maxHeight = boxHeight - 2 ' number of lines displayed of array at one time = 1 page
lba = LBound(arr)
uba = UBound(arr)
Dim sel(lba To uba) As Integer
page = 0
hlite = 0 ' line in display ready for selection by spacebar or if no number is started, enter
clrStr$ = Space$(maxWidth) 'clearing a display line
GoSub update ' show the beginning of the array items for selection
Do 'until done is set to 1
'handle the key stuff
kh& = _KeyHit
If kh& Then
If kh& > 0 And kh& < 255 Then
If InStr("0123456789", Chr$(kh&)) > 0 Then b$ = b$ + Chr$(kh&): GoSub update
If Chr$(kh&) = "c" Then b$ = "": GoSub update
If kh& = 13 Then 'enter pressed check if number is being entered?
If Len(b$) Then
vb = Val(b$)
If vb >= lba And vb <= uba Then 'we have number started
sel(vb) = 1 - sel(vb)
b$ = ""
GoSub update
Else 'clear b$ to show some response to enter
b$ = "": GoSub update 'clear the value that doesn't work
End If
Else
' we are done!
For i = lba To uba ' count selected
If sel(i) Then selcnt = selcnt + 1
Next
ReDim Selects(1 To selcnt)
For i = lba To uba ' count selected
If sel(i) Then seli = seli + 1: Selects(seli) = arr(i)
Next
' selects array loaded, set function and exit
GetSelections& = selcnt
done = 1
End If
End If
If kh& = 27 Then done = 1 'escape clause offered to Cancel selection process
If kh& = 32 Then 'toggle sel()
sel(hlite + page * maxHeight + lba) = 1 - sel(hlite + page * maxHeight + lba)
GoSub update
End If
If kh& = 8 Then 'backspace to edit number
If Len(b$) Then b$ = Left$(b$, Len(b$) - 1): GoSub update
End If
Else
Select Case kh& 'choosing sections of array to display and highlighted item
Case 20736 'pg dn
If (page + 1) * maxHeight + lba <= uba Then page = page + 1: GoSub update
Case 18688 'pg up
If (page - 1) * maxHeight + lba >= lba Then page = page - 1: GoSub update
Case 18432 'up
If hlite - 1 < 0 Then
If page > 0 Then
page = page - 1: hlite = maxHeight - 1: GoSub update
End If
Else
hlite = hlite - 1: GoSub update
End If
Case 20480 'down
If (hlite + 1) + page * maxHeight + lba <= uba Then 'ok to move up
If hlite + 1 > maxHeight - 1 Then
page = page + 1: hlite = 0: GoSub update
Else
hlite = hlite + 1: GoSub update
End If
End If
Case 18176 'home
page = 0: hlite = 0: GoSub update
Case 20224 ' end
page = Int((uba - lba) / maxHeight): hlite = maxHeight - 1: GoSub update
End Select
End If
End If
'handle the mouse stuff
While _MouseInput
If _MouseWheel = -1 Then 'up?
If hlite - 1 < 0 Then
If page > 0 Then
page = page - 1: hlite = maxHeight - 1: GoSub update
End If
Else
hlite = hlite - 1: GoSub update
End If
ElseIf _MouseWheel = 1 Then 'down?
If (hlite + 1) + page * maxHeight + lba <= uba Then 'ok to move up
If hlite + 1 > maxHeight - 1 Then
page = page + 1: hlite = 0: GoSub update
Else
hlite = hlite + 1: GoSub update
End If
End If
End If
Wend
mx = Int((_MouseX - locateColumn * 8) / 8) + 2: my = Int((_MouseY - locateRow * 16) / 16) + 2
If _MouseButton(1) Then 'click contols or select array item
'clear mouse clicks
mb = _MouseButton(1)
If mb Then 'clear it
While mb 'OK!
If _MouseInput Then mb = _MouseButton(1)
_Limit 100
Wend
End If
If mx >= 1 And mx <= maxWidth And my >= 1 And my <= maxHeight Then
sel(my + page * maxHeight + lba - 1) = 1 - sel(my + page * maxHeight + lba - 1) 'select item
GoSub update
ElseIf mx >= 1 And mx <= maxWidth And my = 0 Then 'page up or exit
If my = 0 And (mx <= maxWidth And mx >= maxWidth - 2) Then 'exit sign
done = 1 'escape plan for mouse click top right corner of display box
Else 'PgUp bar clicked
If (page - 1) * maxHeight + lba >= lba Then page = page - 1: GoSub update
End If
ElseIf mx >= 1 And mx <= maxWidth And my = maxHeight + 1 Then 'page down bar clicked
If (page + 1) * maxHeight + lba <= uba Then page = page + 1: GoSub update
End If
Else ' mouse over highlighting, only if mouse has moved!
If mx >= 1 And mx <= maxWidth And my >= 1 And my <= maxHeight Then
If mx <> lastMX Or my <> lastMY Then
If my - 1 <> hlite And (my - 1 + page * maxHeight + lba <= uba) Then
hlite = my - 1
lastMX = mx: lastMY = my
GoSub update
End If
End If
End If
End If
_Limit 200
Loop Until done
ScnState -1 'restore screen as it was
Exit Function
'display of array sections and controls on screen ====================================================
update:
'fix hlite if it has dropped below last array item
While hlite + page * maxHeight + lba > uba
hlite = hlite - 1
Wend
'main display of array items at page * maxHeight (lines high)
For row = 0 To maxHeight - 1
If hlite = row Then Color , _RGB32(255, 60, 60) Else Color , _RGB(85, 0, 85)
Locate locateRow + row, locateColumn: Print clrStr$
index = row + page * maxHeight + lba
If index >= lba And index <= uba Then
If sel(index) Then Color _RGB32(255, 255, 0) Else Color _RGB32(200, 200, 255)
Locate locateRow + row, locateColumn
Print Left$(LTrim$(Str$(index)) + ") " + arr(index), maxWidth)
End If
Next
'make page up and down bars to click, print PgUp / PgDn if available
Color _RGB32(200, 200, 255), _RGB32(0, 100, 50)
Locate locateRow - 1, locateColumn: Print Space$(maxWidth)
If page <> 0 Then Locate locateRow - 1, locateColumn: Print Left$(" Pg Up" + Space$(maxWidth), maxWidth)
Locate locateRow + maxHeight, locateColumn: Print Space$(maxWidth)
If page <> Int(uba / maxHeight) Then
Locate locateRow + maxHeight, locateColumn: Print Left$(" Pg Dn" + Space$(maxWidth), maxWidth)
End If
'make exit sign for mouse click
Color _RGB32(255, 255, 255), _RGB32(200, 100, 0)
Locate locateRow - 1, locateColumn + maxWidth - 3
Print " X "
'if a number selection has been started show it's build = b$
If Len(b$) Then
Color _RGB(255, 255, 0), _RGB32(0, 0, 0)
Locate locateRow + maxHeight, locateColumn + maxWidth - Len(b$) - 1
Print b$;
End If
_Display
_Limit 100
Return
End Function
' for saving and restoring screen settins
Sub ScnState (restoreTF As Long) 'Thanks Steve McNeill
Static defaultColor~&, backGroundColor~&
Static font&, dest&, source&, row&, col&, autodisplay&, mb&
If restoreTF Then
_Font font&
Color defaultColor~&, backGroundColor~&
_Dest dest&
_Source source&
Locate row&, col&
If autodisplay& Then _AutoDisplay Else _Display
_KeyClear
While _MouseInput: Wend 'clear mouse clicks
mb& = _MouseButton(1)
If mb& Then
Do
While _MouseInput: Wend
mb& = _MouseButton(1)
_Limit 100
Loop Until mb& = 0
End If
Else
font& = _Font: defaultColor~& = _DefaultColor: backGroundColor~& = _BackgroundColor
dest& = _Dest: source& = _Source
row& = CsrLin: col& = Pos(0): autodisplay& = _AutoDisplay
_KeyClear
End If
End Sub
Sub FindAndCountExtFileFrom (startDir$, UCaseExt$)
If startDir$ <> "." And startDir$ <> ".." And _Trim$(startDir$) <> "" Then
'If Right$(startDir$, 1) <> "\" Then startDir$ = startDir$ + "\"
$If WIN Then
slash$ = "\"
$Else
slash$ = "/"
$End If
If Right$(startDir$, 1) <> slash$ Then startDir$ = startDir$ + slash$
' major obstacle in this code:
'Print "Changing Directory to "; startDir$
'If _DirExists(startDir$) Then ChDir startDir$ Else Exit Sub
' >>> There are allot of places where dir exists but cant CD to go!
ReDim ds(0) As String, fs(0) As String
GetLists startDir$, ds(), fs()
'Print startDir$ + " .bas Files:"
For i = LBound(fs) To UBound(fs)
If UCase$(Right$(fs(i), 4)) = UCaseExt$ Then
GrandTotal = GrandTotal + 1
Print GrandTotal, startDir$ + fs(i)
ExtList$(GrandTotal) = startDir$ + fs(i)
'If i Mod 20 = 19 Then Print "Press any to cont..": Sleep
End If
Next
'Print
'Print startDir$ + " Sub-Directories: zzz...": Sleep
For j = LBound(ds) To UBound(ds)
If ds(j) <> "." And ds(j) <> ".." And _Trim$(ds(j)) <> "" Then
newD$ = startDir$ + ds(j)
'Print "Press any to FindAndCountBasFileFrom " + newD$ + "... zzz": Sleep
FindAndCountExtFileFrom newD$, UCaseExt$
End If
Next
'Print "Press any to cont...": Sleep
End If
End Sub
' ref 2021-11-09 Steve update GetLists: https://www.qb64.org/forum/index.php?topic=4360.msg138031#msg138031
Sub GetLists (SearchDirectory As String, DirList() As String, FileList() As String)
' Thanks SNcNeill ! for a cross platform method to get file and directory lists
'put this block in main code section of your program close to top
'' direntry.h needs to be in QB64 folder '<<<<<<<<<<<<<<<<<<<<<<<<<<<<< see copy below this Sub
'Declare CustomType Library ".\direntry"
' Function load_dir& (s As String)
' Function has_next_entry& ()
' Sub close_dir ()
' Sub get_next_entry (s As String, flags As Long, file_size As Long)
'End Declare
' fix 2021-11-16 I have a folder in Downloads that is over 40,000 files mostly HTML which caused subscript errors
' change DirCount and FileCount to Long from Integer
Dim flags As Long, file_size As Long, DirCount As Long, FileCount As Long, length As Long
Dim nam$, slash$
ReDim _Preserve DirList(100), FileList(100)
DirCount = 0: FileCount = 0
$If WIN Then
slash$ = "\"
$Else
slash$ = "/"
$End If
If Right$(SearchDirectory$, 1) <> "/" And Right$(SearchDirectory$, 1) <> "\" Then SearchDirectory$ = SearchDirectory$ + slash$
If load_dir(SearchDirectory + Chr$(0)) Then
Do
length = has_next_entry
If length > -1 Then
nam$ = Space$(length)
get_next_entry nam$, flags, file_size
If _DirExists(SearchDirectory + nam$) Then
DirCount = DirCount + 1
If DirCount > UBound(DirList) Then ReDim _Preserve DirList(UBound(DirList) + 100)
DirList(DirCount) = nam$
ElseIf _FileExists(SearchDirectory + nam$) Then
FileCount = FileCount + 1
If FileCount > UBound(FileList) Then ReDim _Preserve FileList(UBound(FileList) + 100)
FileList(FileCount) = nam$
Else 'This else should never actually trigger
Print "Unknown file found: "; SearchDirectory; slash$; nam$, _DirExists(nam$)
Sleep
End If
End If
Loop Until length = -1
End If
close_dir
ReDim _Preserve DirList(DirCount)
ReDim _Preserve FileList(FileCount)
End Sub
' Remove comments below and save as direntry.h
' in your QB64.exe folder if you don't have it already
'=============================================================
'#include <dirent.h>
'#include <sys/stat.h>
'#include <unistd.h>
'const int IS_DIR_FLAG = 1, IS_FILE_FLAG = 2;
'DIR *pdir;
'struct dirent *next_entry;
'struct stat statbuf1;
'char current_dir[FILENAME_MAX];
'#ifdef QB64_WINDOWS
' #define GetCurrentDir _getcwd
'#else
' #define GetCurrentDir getcwd
'#endif
'int load_dir (char * path) {
' struct dirent *pent;
' struct stat statbuf1;
'//Open current directory
'pdir = opendir(path);
'if (!pdir) {
'return 0; //Didn't open
'}
'return -1;
'}
'int has_next_entry () {
' next_entry = readdir(pdir);
' if (next_entry == NULL) return -1;
' stat(next_entry->d_name, &statbuf1);
' return strlen(next_entry->d_name);
'}
'void get_next_entry (char * nam, int * flags, int * file_size) {
' strcpy(nam, next_entry->d_name);
' if (S_ISDIR(statbuf1.st_mode)) {
' *flags = IS_DIR_FLAG;
' } else {
' *flags = IS_FILE_FLAG;
' }
' *file_size = statbuf1.st_size;
' return ;
'}
'void close_dir () {
' closedir(pdir);
' pdir = NULL;
' return ;
'}
'int current_dir_length () {
' GetCurrentDir(current_dir, sizeof(current_dir));
' return strlen(current_dir);
'}
'void get_current_dir(char *dir) {
' memcpy(dir, current_dir, strlen(current_dir));
' return ;
'}or paste the list into the _ClipBoard!
RE: Got an idea will it work ? - doppler - 05-25-2025
Yes I knew I would an authoritative answer, didn't expect example coding. I guess that's what you get when you let loose the hounds of thoughts. Now I can just use it and save a whole lot steps and clicks.
Thanks
(05-25-2025, 06:28 PM)bplus Wrote: or paste the list into the _ClipBoard!I thought of that too, but the program only excepts drops and single file adds. But who says I can not use the clipboard idea elsewhere.
RE: Got an idea will it work ? - bplus - 05-25-2025
Accept a challenge, get a Multi-Select Tool
RE: Got an idea will it work ? - Pete - 05-27-2025
I don't have a submission, but I posted just in case someone does a forum search for who's smart as **** around here.
Steve counters with... He wrote smart as ****, not smart ass ****. Clean your glasses, and not just the ones you pour bourbon into this time! Moving Pete's post to a separate thread. sigh...
Pete
