folderdialog for Lb5

[metro]

There may already be a way of doing  this (other than by API) that I am not aware of

I would like to be able to select a Folder the same way we use filedialog$

I'm using this code for lb5-Linux and I get the desired outcome but it's not intuitive.

A user would not know that you have to select a file to get the folder

if Platform$="unix" then
sep$="/"
else
sep$="\"
end if

global sep$

filedialog "Open text file", "*.*", fileName$
NameofFile$= afterlast$(fileName$,sep$)
Path2File$= upto$(fileName$,NameofFile$)
mask$= afterlast$(NameofFile$,".")
mask$="*."+mask$

call recurse Path2File$, mask$
wait
sub recurse pathspec$,mask$

if Platform$ <> "unix" then   '
'Put in the backslash separator.
pathspec$=pathspec$+ sep$
end if

   files pathspec$, mask$, info$()
   filecount=val(info$(0, 0))
   subdircount=val(info$(0, 1))
   for i=1 to filecount
       filename$= pathspec$+info$(i, 0)
       filesize$= info$(i, 1)
       datestamp$=info$(i, 2)
     print filename$
  next i
     numfiles=filecount
     list$=""
   for i=1 to subdircount
       list$=list$+pathspec$+info$(f + i, 1)+"*"
   next i
   while list$<>""
       p=instr(list$,"*")
       p$=left$(list$,p-1)
       call recurse p$,mask$
       list$=mid$(list$,p+1)
   wend
end sub

[Brandon Parker]

You could change the FileDialog Title to be more descriptive of what the user should do, or you could roll your own using the Files command.


{:0)

Brandon Parker

[metro]

Aug 22, 2020 21:42:52 GMT -5 Brandon Parker said:

You could change the FileDialog Title to be more descriptive of what the user should do, or you could roll your own using the Files command.


{:0)

Brandon Parker

Thanks Brandon, Its been a while since I've read up on the files command

so that's tonight taken care of..

 thanks for the feedback

[meerkat]

GDay! Laurie

Yep! Know about the problem.
Here is a routine in Run Basic. It shells out the dir command to the OS.
Maybe it con be converted to LB.

Hope this helps.
Dan

' -------------------------------------------
' Shell out directory
' -------------------------------------------

[dirShell]
cls
html bf$
loc$ = strRep$(dirOf$,"*.*","")
x$ = shell$("dir ";dirOf$)

i = 1
while word$(x$,i,cr$) <> ""
a$ = word$(x$,i,cr$)
if trim$(a$) = "" then goto [next]
if left$(a$,1) = " " then goto [next]
if left$(a$,1) = cr$ then goto [next]
type$ = mid$(a$,26,3)
size$ = mid$(a$,30,9)
size$ = strRep$(size$,",","")
size = val(size$)
if type$ <> "DIR" and size = 0 then goto [next]
name$ = mid$(a$,40)
a$ = strRep$(a$,"<","[")
a$ = strRep$(a$,">","]")
html left$(a$,39)
link #ddir,name$, [doDir]
    #ddir setkey(type$;"|";loc$;name$)
html "<BR>"
goto [next1]
    [next]
print a$
    [next1]
i = i + 1
wend
wait
[doDir]
type$ = word$(EventKey$,1,"|")
name$ = word$(EventKey$,2,"|")

if type$ = "DIR" then
dirOf$ = name$;"\*.*"
goto [dirShell]
end if
print "Selected File:";name$
wait

' --------------------------------
' string replace rep str with
' --------------------------------
FUNCTION strRep$(str$,rep$,with$)
ln   = len(rep$)
ln1 = ln - 1
i = 1
while i <= len(str$)
if mid$(str$,i,ln) = rep$ then
strRep$ = strRep$ + with$
i = i + ln1
  else
strRep$ = strRep$ + mid$(str$,i,1)
end if
i = i + 1
WEND
END FUNCTION

end


[metro]

Aug 22, 2020 23:41:43 GMT -5 meerkat said:

GDay! Laurie

Yep! Know about the problem.
Here is a routine in Run Basic. It shells out the dir command to the OS.
Maybe it con be converted to LB.

Hope this helps.
Dan

Thanks Dan,

I owe ya another Coopers Ale & by the look of your weather outlook ya all gunna need it tomorrow.

102 in the old money, enough to work up a thirst

EDIT: I see the fires are close to your city, stay safe

[metro]

This is my wish for lb5 (All Platforms)



'Function for Browsing folders
'For LB3.x
'by ~laz on 7-17-02

Folder$ = BrowseFolders$()
if Folder$ <> "" then
print Folder$
else
print "Cancel Pressed"
end if

wait



Function BrowseFolders$()
struct BrowseInfo, _
hWnd as long, _
Root as long, _
DName$ as ptr, _
Title$ as ptr, _
Flags as long, _
lpfn as long, _
lParam as long, _
iImage as long
calldll #shell32, "SHBrowseForFolder", _
BrowseInfo as struct, ID as long
Path$ = space$(256)+chr$(0)
calldll #shell32, "SHGetPathFromIDList", _
ID as long, _
Path$ as ptr, _
ret as boolean
BrowseFolders$ = trim$(Path$)
open "ole32.dll" for dll as #ole32
calldll #ole32, "CoTaskMemFree", _
ID as long, _
ret as void
close #ole32
end function


[Brandon Parker]

This might be of help if you want to roll your own version using the Files command.

'This does not work on a network
Dim Info$(10, 10)
Global True : True = 1
Global False : False = 0

directory$ = "Your directory ... no trailing \"
folder$ = "Your folder name"
Print searchForFolder(directory$, folder$)
Print searchForFolder$(directory$, folder$)
End

Function searchForFolder$(directory$, folder$)
   Files directory$, "*", Info$()
   If Val(Info$(0,1)) > 0 Then
       For i = 1 To Val(Info$(0,1))
           If Info$(Val(Info$(0,0)) + i, 1) = folder$ Then
               searchForFolder$ = "SubDir# " + str$(i) + " " + folder$
               Exit Function
           End If
           If i = Val(Info$(0,1)) Then
               searchForFolder$ = chr$(34) + folder$ + chr$(34) + " is not a subdirectory of " + chr$(34) + directory$ + chr$(34)
           End If
       Next i
   Else
       searchForFolder$ = "This directory contains no subdirectories."
   End If
End Function

Function searchForFolder(directory$, folder$)
   Files directory$, "*", Info$()
   If Val(Info$(0,1)) > 0 Then
       For i = 1 To Val(Info$(0,1))
           If Info$(Val(Info$(0,0)) + i, 1) = folder$ Then
               searchForFolder = True
               Exit Function
           End If
       Next i
   End If
End Function


{:0)

Brandon Parker

[metro]

Thanks Brandon,
Whilst what I have to date works I wonder if someone talented can outline a way that I can detect that a folder is the last
one in that path. So a double click on the last possible folder results in its selection.

This code is Lb4.5.1 have not tested with Lb5 Linux atm

EDIT: using lb5 lb5x32-351 (Linux) print Drives$ only prints "/"

I'm guessing the root folder but.. no drives

while word$(Drives$, index + 1) <> ""
drvs$(index) = upper$(word$(Drives$, index + 1))
index = index + 1
wend
dim info$(0, 0)
dim folds$(300)
'nomainwin
   WindowWidth = 400
   WindowHeight = 300
   UpperLeftX=int((DisplayWidth-WindowWidth)/2)
   UpperLeftY=int((DisplayHeight-WindowHeight)/2)
 '-----Begin GUI objects code
   listbox #1.drvs, drvs$(, [drvsClick],    5,  40,  50, 100
   listbox #1.folds, folds$(), [foldsClick],   60,  40, 180, 100
   textbox #1.tbCurPath, 35,  157, 355,  25
   statictext #1.st16, "FOLDERS", 125,  22,  72,  20
   statictext #1.st17, "DRIVES",   5,  22,  40,  20
   statictext #1.st18, "Path", 5,  160,  25,  20
   button #1.btn1, "SELECT",[dirselect],UL, 265,40,100,100
   open "Folder Choice" for window as #1
   print #1, "trapclose [quit.1]"
   print #1, "font ms_sans_serif 6"

[UpDateCurPath]
 #1.tbCurPath, curDir$
'  gosub [updateAll]
wait

[drvsClick]   'change drive
#1.drvs, "selection? drvSel$"
if drvSel$="" then notice "select a drive": goto [enddrvsClick]
mask$=msk$(0)
curDir$=drvSel$ + "\"
gosub [updateAll]
[enddrvsClick]
wait

[updateAll]


#1.tbCurPath, curDir$
#1.tbCurPath, "!contents? curDir$";
dim folds$(1000)
#1.folds, "reload"
files curDir$ , chr$(0), info$()
for i = 1 to val(info$(0, 0))+val(info$(0, 1))
folds$(i)=  info$(i,1)
next
#1.folds, "reload"

return
[quit.1]
close #1
end

[foldsClick]   'update directories
#1.folds, "selection? foldSel$"
#1.tbCurPath, "!contents? curDir$";
if foldSel$="" then goto [dirselect]

if foldSel$ = ".." then
goto [bUpClick]
else
'#1.tbCurPath, "!contents? curDir$";
curDir$=curDir$+foldSel$+"\"
#1.tbCurPath,  curDir$
gosub [updateAll]

end if
[endfoldsClick]
wait

[dirselect]
notice "You Selected   "; curDir$
wait



[Brandon Parker]

This should get you started. I tested it exactly three times ...

while word$(Drives$, index + 1) <> ""
drvs$(index) = upper$(word$(Drives$, index + 1))
index = index + 1
wend
dim info$(0, 0)
dim folds$(300)
'nomainwin
   WindowWidth = 400
   WindowHeight = 300
   UpperLeftX=int((DisplayWidth-WindowWidth)/2)
   UpperLeftY=int((DisplayHeight-WindowHeight)/2)
 '-----Begin GUI objects code
   listbox #1.drvs, drvs$(, [drvsClick],    5,  40,  50, 100
   listbox #1.folds, folds$(), [foldsClick],   60,  40, 180, 100
   textbox #1.tbCurPath, 35,  157, 355,  25
   statictext #1.st16, "FOLDERS", 125,  22,  72,  20
   statictext #1.st17, "DRIVES",   5,  22,  40,  20
   statictext #1.st18, "Path", 5,  160,  25,  20
   button #1.btn1, "SELECT",[dirselect],UL, 265,40,100,100
   open "Folder Choice" for window as #1
   print #1, "trapclose [quit.1]"
   print #1, "font ms_sans_serif 6"

[UpDateCurPath]
 #1.tbCurPath, curDir$
'  gosub [updateAll]
wait

[drvsClick]   'change drive
#1.drvs, "selection? drvSel$"
if drvSel$="" then notice "select a drive": goto [enddrvsClick]
mask$=msk$(0)
curDir$=drvSel$ + "\"
gosub [updateAll]
[enddrvsClick]
wait

[updateAll]


#1.tbCurPath, curDir$
#1.tbCurPath, "!contents? curDir$";
dim folds$(1000)
#1.folds, "reload"
files curDir$ , chr$(0), info$()
for i = 1 to val(info$(0, 0))+val(info$(0, 1))
folds$(i)=  info$(i,1)
next
#1.folds, "reload"

return
[quit.1]
close #1
end

[foldsClick]   'update directories
#1.folds, "selection? foldSel$"
#1.tbCurPath, "!contents? curDir$";
if foldSel$="" then goto [dirselect]

if foldSel$ = ".." then
goto [bUpClick]
else
'#1.tbCurPath, "!contents? curDir$";
curDir$=curDir$+foldSel$+"\"
#1.tbCurPath,  curDir$
gosub [updateAll]

end if
[endfoldsClick]
files curDir$ , chr$(0), info$()
'If info$(0,1) is Zero then there are no subfolders in the directory called in the Files command.
If Not(Val(info$(0,1))) Then GoTo [dirselect]
wait

[dirselect]
notice "You Selected   "; curDir$
wait

{:0)

Brandon Parker

[metro]

numberoftests=3
for a = 1 to numberoftests
print "Thank you Brandon"
next

[Brandon Parker]

No problem ...

{:0)

Brandon Parker