RequestDir looks out of date on Windows...

BlitzMax Forums/MaxGUI Module/RequestDir looks out of date on Windows...

col	(Posted 2012) [#1]

Indeed it looks like something out of the 90s, so I wrote a little function to make one with a more modern look on Vista and Win7.

You can use this function on earlier OSes as it will fall back to the original RequestDir ( EDIT :- Can anyone confirm for XP? Maybe with SP3 it will use the modern look? )

RequestFolder$(Text$,InitialPath$)

This can be used as a direct replacement for the RequestDir function.

Mark, feel free to include this in any next updates.

Strict

?Win32

Import "-lole32"
Import Pub.Win32

Global Shell32Dll = LoadLibraryA("Shell32.dll")
Global SHCreateItemFromParsingName(pszPath$w,pbc:Byte Ptr,riid:Byte Ptr,ppv:IUnknown Var)"Win32" = GetProcAddress(Shell32Dll,"SHCreateItemFromParsingName")

Global CLSID_FileOpenDialog[] = [$dc1c5a9c,$4ddee88a,$f860a1a5,$f7ae202a]
Global IID_IFileOpenDialog[] = [$d57c7288,$4768d4ad,$969d02be,$60d93295]
Global IID_IShellItem[] = [$43826d1e,$42eee718,$e2a155bc,$fe7bc361]


Extern"Win32"
	'These types are INCOMPLETE - DO NOT USE FOR ANYTHING ELSE !!!!!!
	Type IModalWindow Extends IUnknown
		Method Show(hWnd)
	EndType

	Type IFileDialog Extends IModalWindow
		Method SetFileTypes()
		Method SetFileTypeIndex()
		Method GetFileTypeIndex()
		Method Advise()
		Method Unadvise()
		Method SetOptions(dwOptions)
		Method GetOptions(dwOptions Ptr)
		Method SetDefaultFolder(pShellItem:Byte Ptr)
		Method SetFolder(pSI:Byte Ptr)
		Method GetFolder()
		Method GetCurrentSelection()
		Method SetFilename(pszName$w)
		Method GetFileName()
		Method SetTitle(pszName$w)
		Method SetOKButtonLabel()
		Method SetFilenameLabel()
		Method GetResult(pItem:IShellItem Var)
		Method AddPlace()
		Method SetDefaultExtension()
		Method Close()
		Method SetClientGuid()
		Method ClearClientData()
		Method SetFilter()
	EndType
	
	Type IShellItem Extends IUnknown
		Method BindToHandler()
		Method GetParent()
		Method GetDisplayName(sigdnName,ppszName:Short Ptr Var)
		Method GetAttributes()
		Method Compare()
	EndType
	
	Function CoCreateInstance(rclsid:Byte Ptr,pUnkOuter:Byte Ptr,dwClsContext,riid:Byte Ptr,ppv:IUnknown Var) 'My version
	Function CoInitialize(pvReserved)
	Function CoUninitialize()
EndExtern

Function RequestFolder$(Title$,InitialPath$)
	Global pDialog:IFileDialog
	Global pInitialPath:IShellItem
	Global pFolder:IShellItem
	Global hr,ResultFolder$

	CoInitialize(0)

	'Create Instance of the Dialog	
	If CoCreateInstance(CLSID_FileOpenDialog,Null,CLSCTX_INPROC_SERVER,IID_IFileOpenDialog,pDialog) < 0
		CleanUp
		Return RequestDir(Title,InitialPath)
	EndIf
	
	'Set it to Browse Folders
	Local dwOptions
	If pDialog.GetOptions(Varptr dwOptions) < 0
		CleanUp
		Return RequestDir(Title,InitialPath)
	EndIf
	
	If pDialog.SetOptions(dwOptions|$20) < 0
		CleanUp
		Return RequestDir(Title,InitialPath)
	EndIf

	'Set Title
	If pDialog.SetTitle(Title) < 0
		CleanUp
		Return RequestDir(Title,InitialPath)
	EndIf

	'Create an IShellItem for a default folder path
	InitialPath = Replace(InitialPath,"/","\")
	If SHCreateItemFromParsingName(InitialPath,Null,IID_IShellItem,pInitialPath) < 0
		CleanUp
		Return RequestDir(Title,InitialPath)
	EndIf

	If pDialog.SetFolder(pInitialPath) < 0
		CleanUp()
		Return RequestDir(Title,InitialPath)
	EndIf
		
	'Show the Dialog
	hr = pDialog.Show(0)
	If hr < 0 And hr <> $800704c7 ' if error but not user cancelled
		CleanUp
		Return RequestDir(Title,InitialPath)
	EndIf

	'Test the result
	If pDialog.GetResult(pFolder) < 0
		CleanUp
		If hr = $800704c7 Return ""
		Return RequestDir(Title,InitialPath)
	EndIf

	'Get the result
	Local pName:Short Ptr
	pFolder.GetDisplayName($80058000,pName)
	ResultFolder = String.FromWString(pName)
	
	CleanUp()	
	Return ResultFolder
	
	Function CleanUp()
		If pDialog pDialog.Release_()
		If pInitialPath pInitialPath.Release_()
		If pFolder pFolder.Release_()
		CoUninitialize()
	EndFunction
EndFunction
?

'Example Usage
Print RequestFolder("Select a Folder...",CurrentDir())

jsp	(Posted 2012) [#2]

Have tested it on XP SP3, but looks just normal.

Strange thing is, that it comes up with a dialog telling me that there is no disk in drive D: which is correct, but hey it is my DVD and I know there is no disk...

col	(Posted 2012) [#3]

That happens on XP?
If so, that is strange as it ~~seems to~~ should have dropped back to using RequestDir.

Edit:- Maybe not so strange as the code above is requesting d: in the filepath. Its a second partition in my laptop. lol. I think I've had waaaay too many late nights lately :D

Last edited 2012

jsp	(Posted 2012) [#4]

Yes on XP (VM if that makes a difference).
I'm traveling at the moment, so can't test on Win7, will check that out later.

Hummelpups

(Posted 2012) [#5]

Looks nice on 7

Last edited 2012

col	(Posted 2015) [#6]

Updated to work on >= win7