Older Version
Newer Version
lbjoseph
Oct 16, 2011
=Multiple File Selection Dialog [[user:lbjoseph]]= If you ever needed a multiple file selection dialog that //actually works//, you can use this in your program. [[image:FileSelect.png width="399" height="284"]] [[code format="lb"]] ' Multiple file selection dialog by Joseph Essin. ' I got tired of the performance of the API one, ' as it was always crashing. ' So I just made my own. ' For the MultiOpen$() function: Global Drives Dim Drives$(0) Dim Places$(0) Dim PlacesList$(0) Dim Folders$(0) Dim Files$(0) Dim FileInfo$(0,0) Dim Ext$(0) '-----------------------------------' 'NoMainWin files$ = MultiOpen$("Open File(s)", DefaultDir$, "*.*;*.bas") nfiles = Words(files$, "|") For i = 1 To nfiles Print Word$(files$, i, "|") Next i ' Returns a | delimited list of filenames selected. ' Or nothing (""), if no files were selected. ' ' ext$ is the list of extensions you want people ' to be able to select, seperated by a semicolon. ' initpath$ is the initial path it opens to. ' title$ is what it says in the window title. Function MultiOpen$(title$, initPath$, ext$) Drives = Words(Drives$, " ") ReDim PlacesList$(Drives+5) ReDim Places$(Drives+5) Places$(1) = GetSpecialFolder$(40) ' User's folder Places$(2) = GetSpecialFolder$(0) ' User's desktop Places$(3) = GetSpecialFolder$(5) ' User's documents Places$(4) = GetSpecialFolder$(39) ' User's pictures Places$(5) = GetSpecialFolder$(13) ' User's music For i = 1 To 5 : PlacesList$(i) = File.ShortName$(Places$(i)) : Next i For i = 6 To 5+Drives Places$(i) = Upper$(Word$(Drives$, i-5));"\" PlacesList$(i) = Places$(i) Next extensions = Words(ext$,";") ReDim Ext$(extensions) For i = 1 To extensions Ext$(i) = Word$(ext$,i,";") Next i WindowWidth = 640 WindowHeight = 450 UpperLeftX = Int((DisplayWidth-WindowWidth)/2) UpperLeftY = Int((DisplayHeight-WindowHeight)/2) Stylebits #sel.whitespace, 0, _WS_BORDER, 0, 0 Stylebits #sel.files, _LBS_EXTENDEDSEL, 0, 0, 0 Stylebits #sel.address, _ES_READONLY, 0, 0, 0 Stylebits #sel.filename,_ES_READONLY, 0, 0, 0 ' I would love to use this, but it makes the combobox stop sending change notifications: 'Stylebits #sel.ext, _CBS_DROPDOWNLIST, 0, 0, 0 Graphicbox #sel.whitespace, -4, -4, 660, 44 Button #sel.up, "Back", [FolderUp], UL, 2, 2, 46, 34 Textbox #sel.address, 54, 08, 570, 20 Listbox #sel.places, PlacesList$(), [SelectPlace], 2, 42, 150, 300 Listbox #sel.folders, Folders$(), [SelectFolder], 154, 42, 476, 120 Listbox #sel.files, Files$(), [SelectFile], 154, 164, 476, 178 Textbox #sel.filename, 6, 348, 516, 20 Combobox #sel.ext, Ext$(), [SelectExt], 530, 346, 94, 20 Button #sel.default, "Open", [Go], UL, 460, 380, 80, 30 Button #sel.cancel, "Cancel", [Cancel], UL, 545, 380, 80, 30 Stylebits #sel, _DS_CENTER, 0, 0, 0 Open title$ For Dialog_Modal As #sel lbx = Hwnd(#sel.files) #sel "TrapClose [Quit]" #sel "Font Arial 9" #sel.places "SingleClickSelect" #sel.files, "SingleClickSelect" #sel.places "SetFocus" #sel.ext, "SelectIndex 1" ext$ = Ext$(1) folder$ = initPath$ GoSub [StartAt] Wait [SelectPlace] #sel.places, "SelectionIndex? n" If n = 0 Then Wait folder$ = Places$(n) GoSub [StartAt] Wait [SelectFolder] #sel.folders, "Selection? n$" If n$ = "" Then Wait folder$ = folder$;"\";n$ GoSub [StartAt] Wait [SelectFile] items$ = "" paths$ = "" For i = 1 To nfiles isSel = SendMessageA(lbx, _LB_GETSEL, i - 1, 0) If isSel Then items$ = items$; Files$(i); "|" paths$ = paths$; folder$; "\"; Files$(i); "|" End If Next i #sel.filename, items$ Wait [FolderUp] For i = Len(folder$) To 1 Step -1 If Mid$(folder$, i, 1) = "\" Then folder$ = Mid$(folder$, 1, i-1) GoSub [StartAt] Exit For End If Next i #sel.folders, "SetFocus" Wait [SelectExt] #sel.ext, "SelectionIndex? n" If n = 0 Then Wait ext$ = Ext$(n) GoSub [StartAt] Wait [StartAt] ' Remove any trailing slash. If right$(folder$,1) = "\" Then folder$ = Mid$(folder$,1,Len(folder$)-1) ' Find the files and folders within: Files folder$;"\", ext$, FileInfo$() nfolders = Val(FileInfo$(0,1)) nfiles = Val(FileInfo$(0,0)) items$ = "" paths$ = "" ReDim Folders$(nfolders) ReDim Files$(nfiles) For i = 1 To nfolders Folders$(i) = FileInfo$(nfiles+i,1);"\" Next i #sel.folders "Reload" For i = 1 To nfiles Files$(i) = FileInfo$(i,0) Next i #sel.files "Reload" #sel.address folder$;"\" ' Select one of the places if this folder is identical to it. #sel.places, "SelectIndex 0" For i = 1 To Drives+5 compare$ = Lower$(folder$) If Right$(compare$,1) = ":" Then compare$ = compare$; "\" If compare$ = Lower$(Places$(i)) Then #sel.places "SelectIndex ";i Exit For End If Next i #sel.filename, items$ Wait [Go] MultiOpen$ = paths$ [Cancel] [Quit] Close #sel End Function Function GetSpecialFolder$(CSIDL) struct IDL, _ cb As uLong,abID As short calldll #shell32, "SHGetSpecialFolderLocation",_ 0 as ulong,CSIDL as ulong,IDL as struct,ret as ulong if ret=0 then Path$ = Space$(_MAX_PATH) id = IDL.cb.struct calldll #shell32, "SHGetPathFromIDListA",_ id as ulong,Path$ as ptr,ret as ulong GetSpecialFolder$ = trim$(Path$) end if if GetSpecialFolder$ = "" then GetSpecialFolder$ = "Not Applicable" End Function Function SendMessageA(hW, msg, par1, par2) CallDLL #user32, "SendMessageA",_ hW as Ulong, _ 'Handle of the control (listbox) msg as Long, _ 'Stylebits (Windows Constant) par1 as Long, _ 'Parameter 1 (sometimes irrelevant) par2 as Long, _ 'Parameter 2 (sometimes irrelevant) SendMessageA as long 'Return Value, 1 = success End Function Function Words(str$, del$) index = 1 While Word$(str$, index, del$) <> "" index = index + 1 WEnd Words = index - 1 End Function ' Returns the short filename of a path. Function File.ShortName$(filepath$) File.ShortName$ = filepath$ For i = (Len(filepath$) - 1) To 0 Step -1 If Mid$(filepath$,i,1) = "\" Then File.ShortName$ = Mid$(filepath$,i+1) Exit Function End If Next i End Function [[code]]