实现文件路径对话框的几种方式 

  1 //////////调用delphi的SelectDirectory方式实现,并添加新建文件功能///////////////////////
  2 
  3  uses
  4 ShlObj,ActiveX;
  5 
  6 
  7 {$R *.dfm}
  8 function SelectDirCB(Wnd: HWND; uMsg: UINT; lParam,
  9 lpData: LPARAM): Integer stdcall;              //这个是回调函数
 10 begin
 11 if (uMsg = BFFM_INITIALIZED) and (lpData <> 0) then
 12     SendMessage(Wnd, BFFM_SETSELECTION, Integer(True), lpdata);
 13 result := 0;
 14 end;
 15 
 16 ////////这里重写delphi的SelectDirectory方法
 17 
 18 function SelectDirectory(const Caption: string;
 19 const Root: WideString; var Directory: string): Boolean;
 20 var
 21 WindowList: Pointer;
 22 BrowseInfo: TBrowseInfo;
 23 Buffer: PChar;
 24 OldErrorMode: Cardinal;
 25 RootItemIDList, ItemIDList: PItemIDList;
 26 ShellMalloc: IMalloc;
 27 IDesktopFolder: IShellFolder;
 28 Eaten, Flags: LongWord;
 29 begin
 30 Result := False;                   
 31 if not DirectoryExists(Directory) then
 32     Directory := '';
 33 FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
 34 if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
 35 begin
 36     Buffer := ShellMalloc.Alloc(MAX_PATH);
 37     try
 38       RootItemIDList := nil;
 39       if Root <> '' then
 40       begin
 41         SHGetDesktopFolder(IDesktopFolder);
 42         IDesktopFolder.ParseDisplayName(Application.Handle, nil,
 43           POleStr(Root), Eaten, RootItemIDList, Flags);
 44       end;
 45       BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS or BIF_NEWDIALOGSTYLE or BIF_EDITBOX;    //BIF_NEWDIALOGSTYLE , BIF_EDITBOX
 46       // 分别是添加新建文件夹按钮、路径对话框         delphi默认只有 BIF_RETURNONLYFSDIRS
 47       with BrowseInfo do
 48       begin
 49         hwndOwner := Application.Handle;
 50         pidlRoot := RootItemIDList;
 51         pszDisplayName := Buffer;
 52         lpszTitle := PChar(Caption);
 53       end;
 54 
 55       if Directory <> '' then
 56         begin
 57           BrowseInfo.lpfn := SelectDirCB;
 58           BrowseInfo.lParam := Integer(PChar(Directory));
 59         end;
 60       WindowList := DisableTaskWindows(0);
 61       OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
 62       try
 63         ItemIDList := ShBrowseForFolder(BrowseInfo);
 64       finally
 65         SetErrorMode(OldErrorMode);
 66         EnableTaskWindows(WindowList);
 67       end;
 68       Result := ItemIDList <> nil;
 69       if Result then
 70       begin
 71         ShGetPathFromIDList(ItemIDList, Buffer);
 72         ShellMalloc.Free(ItemIDList);
 73         Directory := Buffer;
 74       end;
 75     finally
 76       ShellMalloc.Free(Buffer);
 77     end;
 78 end;
 79 end;
 80 
 81 ///////////////////////////////通过ShBrowseForFolder实现/////////////////
 82 
 83 //SelectDir(句柄,提示的文字,打开时默认的目录,返回文件路径):成功否.      //无用
 84 function   SelectDir(ParentHWnd:   HWnd;   const   Caption:   string;   const   Root:   WideString;  
 85       out   Directory:   string):   Boolean;  
 86 var
 87 BrowseInfo:   TBrowseInfo;
 88 Buffer:   PChar;
 89 RootItemIDList,   ItemIDList:   PItemIDList;
 90 ShellMalloc:   IMalloc;
 91 IDesktopFolder:   IShellFolder;
 92 Eaten,   Flags:   LongWord;
 93 begin
 94 Result   :=   False;
 95 Directory   :=   '';
 96 FillChar(BrowseInfo,   SizeOf(BrowseInfo),   0);
 97 if   (ShGetMalloc(ShellMalloc)   =   S_OK)   and   (ShellMalloc   <>   nil)   then
 98 begin
 99     Buffer   :=   ShellMalloc.Alloc(MAX_PATH);
100     try
101       SHGetDesktopFolder(IDesktopFolder);
102       IDesktopFolder.ParseDisplayName(Application.Handle,   nil,
103       POleStr(Root),   Eaten,   RootItemIDList,   Flags);
104       with   BrowseInfo   do
105       begin
106         hwndOwner   :=   ParentHWnd;
107         pidlRoot   :=   RootItemIDList;
108         pszDisplayName   :=   Buffer;
109         lpszTitle   :=   PChar(Caption);
110         ulFlags   :=   BIF_RETURNONLYFSDIRS;
111       end;
112       ItemIDList   :=   ShBrowseForFolder(BrowseInfo);
113       Result   :=     ItemIDList   <>   nil;
114       if   Result   then
115       begin
116         ShGetPathFromIDList(ItemIDList,   Buffer);
117         ShellMalloc.Free(ItemIDList);
118         Directory   :=   Buffer;
119       end;
120     finally
121       ShellMalloc.Free(Buffer);
122     end;
123 end;
124 end;
125 
126

 

posted @ 2010-04-22 10:17  RoyG0  阅读(440)  评论(0)    收藏  举报