因為我想要做到DevExpress中cxShellBrowserDialog的功能,如圖:
主程式:
unit BrowseForFolderU; interface function BrowseForFolder(const browseTitle: String; const initialFolder: String = ''; mayCreateNewFolder: Boolean = False): String; implementation uses Windows, Forms, shlobj; var lg_StartFolder: String; // With later versions of Delphi you may not need these constants. const BIF_NEWDIALOGSTYLE=$40; BIF_NONEWFOLDERBUTTON=$200; //////////////////////////////////////////////////////////////////////// // Call back function used to set the initial browse directory. //////////////////////////////////////////////////////////////////////// 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; //////////////////////////////////////////////////////////////////////// // This function allows the user to browse for a folder // // Arguments:- // browseTitle : The title to display on the browse dialog. // initialFolder : Optional argument. Use to specify the folder // initially selected when the dialog opens. // mayCreateNewFolder : Flag indicating whether the user can create a // new folder. // // Returns: The empty string if no folder was selected (i.e. if the user // clicked cancel), otherwise the full folder path. //////////////////////////////////////////////////////////////////////// function BrowseForFolder(const browseTitle: String; const initialFolder: String =''; mayCreateNewFolder: Boolean = False): String; var browse_info: TBrowseInfo; folder: array[0..MAX_PATH] of char; find_context: PItemIDList; begin //-------------------------- // Initialise the structure. //-------------------------- 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 not mayCreateNewFolder then browse_info.ulFlags := browse_info.ulFlags or BIF_NONEWFOLDERBUTTON; browse_info.hwndOwner := Application.Handle; 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); end else result := ''; end; end.
真的是很優,做出來的結果,如圖:
其實也不差哦! |
還是有些地方可以小修改呢
在「browse_info.ulFlags := BIF_RETURNONLYFSDIRS or BIF_NEWDIALOGSTYLE;」這行可以再補上「or BIF_EDITBOX」,就會在最底下加上Edit顯示當前目錄囉!
如果還要再進一步顯示完整的路徑,則還需要在「BrowseForFolderCallBack」函式中做更進一步的實作。
至於怎麼做…有時間再補充囉!
有沒有被敷衍到的感覺呀 |
沒有留言:
張貼留言