windows目錄對話方塊是乙個標準的windowsui控制項,其可以列出乙個目錄列表,並且可以顯示新增按鈕。由於delphi中並沒有提供對於該控制項的封裝,所以開啟它是個問題。網上有多種方法,試舉幾例:
1、使用win31目錄下的driverlist、directorylist、filelist和filefilterlist四個控制項進行組合來獲取當前目錄,操作複雜,也不美觀,對程式exe體積影響明顯
2、使用samples下的shelltreeview,效果很好,但對程式exe體積也是增加明顯
3、讓使用者直接定位檔案,通過對話方塊opendialog來實現,但無法限制使用者定位檔案的許可權,而且可能在程式中使用相對目錄時衝突報錯
4、利用filectrl單元中的selectdirectory函式定位到資料夾,且可以用root引數限定根目錄上限,但總是彈出在右下角
5、我個人是使用以下方法直接呼叫windows目錄對話方塊,向原作者表示衷心感謝!
unit browseforfolderu;
inte***ce
function browseforfolder(const browsetitle:string;
const initialfolder:string=''):string;
implementation
uses windows,shlobj;
varlg_startfolder:string;
function browseforfoldercallback(wnd:hwnd;umsg:uint;
lparam,lpdata:lparam):integer stdcall;
begin
if umsg=bffm_initialized then
sendmessage(wnd,bffm_setselection,1,integer(@lg_startfolder[1]));
result:=0;
end;
function browseforfolder(const browsetitle:string;
const initialfolder:string=''):string;
const
bif_newdialogstyle=$40;
varbrowse_info:tbrowseinfo;
folder:array[0..max_path] of char;
find_context:pitemidlist;
begin
fillchar(browse_info,sizeof(browse_info),#0);
lg_startfolder:=initialfolder;
browse_info.pszdisplayname:=@folder[0];
browse_info.lpsztitle:=pchar(browsetitle);
browse_info.ulflags:=bif_returnonlyfsdirs or bif_newdialogstyle;
if initialfolder<>'' then
browse_info.lpfn:=browseforfoldercallback;
find_context:=shbrowseforfolder(browse_info);
if assigned(find_context) then
begin
if shgetpathfromidlist(find_context,folder) then
result:=folder
else
result:='';
globalfreeptr(find_context);
endelse
result:='';
end;
end.
呼叫**:
uses
browseforfolderu;
參考:
JS 實現資料夾目錄選擇
js 實現資料夾目錄選擇 這是我網上找的,我只知道如何用,貼出來大家看看,因為我為這個愁了很久,直到今天才解決。如下 function browsefolder path document.getelementbyid path value folder return folder catch e ...
delphi 選擇資料夾,路徑選擇,瀏覽資料夾
選擇資料夾,路徑選擇,資料夾資源管理器 推薦 selectdirectory vcl.filectrl.hpp if selectdirectory 請選擇目錄 daopath selectdirectory include filectrl.hpp const seldirhelp 1000 vo...
VB選擇資料夾並取資料夾名
如下 引用microsoft shell controls and automation dim shella as new shell private sub command1 click 建立乙個按鈕物件 dim shellb as folder set shellb shella.browse...