请问怎么出现设置目录的对话框,并且把路径保存edit中!!急急急急急急急

Question

请问怎么出现设置目录的对话框,并且把路径保存edit中!!急急急急急急急

Answer 1

uses filectrl;
procedure ForceDirectories(dir:string) 
//一次建立指定的多级文件夹
function DirectoryExists(Name: string): Boolean; 
// 指定文件夹是否存在
function SelectDirectory(var Directory: string; Options: TSelectDirOpts; HelpCtx: Longint):Boolean;
// 打开一个选择文件夹的对话框(英文的)  
Delphi里有个函数SelectDiretory，重载了两种形式： 　
　function SelectDirectory( 　const Caption: string; const Root: WideString; out Directory: string): Boolean; overload; 　
　function SelectDirectory( 　　　　var Directory: string; Options: TSelectDirOpts; HelpCtx: Longint): Boolean; overload;
 本文例子源代码下载：1.66k　　按第一种方式可以调用Win32的标准选择目录对话框，第二种方式弹出的则是Delphi自定义风格的对话框。我们编程常用的是第一种，但我在使用中发现，用该函数不能初始化对话框的起始目录，如右图：希望对话框弹出时就定位到某个目录，是办不到的。 　　我从来是单干，自然很久都没有找到答案，直到有一天终于注册上了“大富翁论坛”（其实我很久以前就知道大富翁论坛了，只是一直注册不了），我提出的问题就是“如何指定SelectDirectory的起始目录”。问题很快得到了解答，答案是由cAkk提供的，
如下： 给那个窗口发消息可以设置路径：　SendMessage( Hwnd,BFFM_SETSELECTION,Ord(TRUE), Longint(PChar(Path))  ); 关键是如何得到该窗口的句柄？ Borland在写SelectDirectory函数时省略了BrowseInfo的lpfn属性，这个属性指向一个CallBack函数,可以实现你的程序和该对话框窗口的通讯.该Callback函数声明为： 　
　int BrowseCallbackProc( HWND hwnd,UINT uMsg,LPARAM lParam,LPARAM lpData); 其中,HWND参数就是传递过来的该对话框的句柄,得到这个句柄,你就可以 用我前面说的SendMessage设置路径了。 还有一点,你应该在BrowseCallbackProc函数里判断当接受到BFFM_INITIALIZED 消息时设置路径,也就是说：uMsg:=BFFM_INITIALIZED的时候。 具体实现如下，需要注意的几点是： 
１、不能再用SelectDirectory函数（要不就修改它的源代码），需要直接调用 API函数ShBrowseForFolder。
２、要把shlobj和AcriveX两个单元包含进去。 unit Unit1; interface uses 　　……shlobj,ActiveX; 　　…… var 　　 Form1: TForm1; 　　 Path: string; 　　//起始路径 implementation {$R *.DFM} 
function BrowseCallbackProc(hwnd: HWND;uMsg: UINT;lParam: Cardinal;lpData: Cardinal): integer; stdcall;
begin 
　if uMsg=BFFM_INITIALIZED then 
　　result :=SendMessage(Hwnd,BFFM_SETSELECTION,Ord(TRUE),Longint (PChar(Path))) 　
　else 　　　　
    result :=1 
end; 
function SelDir(const Caption: string; const Root: WideString; out Directory: string): Boolean; 
var 　
　WindowList: Pointer; 　　
BrowseInfo: TBrowseInfo; 　　
Buffer: PChar; 　　
RootItemIDList, 
ItemIDList: PItemIDList; 　　
ShellMalloc: IMalloc; 　　
IDesktopFolder: IShellFolder; 　
　Eaten, Flags: LongWord; 
begin 　　
  Result := False; 　　
  Directory := ''''; 　　
  FillChar(BrowseInfo, SizeOf(BrowseInfo), 0); 　
　if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then 　
　begin 　　　　
    Buffer := ShellMalloc.Alloc(MAX_PATH); 　　　　
    try 
　　　RootItemIDList := nil;
 　　 if Root <> '''' then 
      begin 　　　　
　　　　SHGetDesktopFolder(IDesktopFolder); 　　　　
　　　　IDesktopFolder.ParseDisplayName(Application.Handle, nil, POleStr(Root), Eaten, RootItemIDList, Flags); 
　　　end;
 　　 with BrowseInfo do begin 　　　　　　　　hwndOwner := Application.Handle; 　　　　　　　　pidlRoot := RootItemIDList; 　　　　　　　　pszDisplayName := Buffer; 　　　　　　　　lpszTitle := PChar(Caption); 　　　　　　　　ulFlags := BIF_RETURNONLYFSDIRS; 　　　　　　　　lpfn :=@BrowseCallbackProc; 　　　　　　　　lParam :=BFFM_INITIALIZED; 　　　　　　end; 　　　　　　WindowList := DisableTaskWindows(0); 　　　　　　try 　　　　　　　　ItemIDList := ShBrowseForFolder(BrowseInfo); 　　　　　　finally 　　　　　　　　EnableTaskWindows(WindowList); 　　　　　　end; 　　　　　　Result := ItemIDList <> nil; 　　　　　　if Result then begin 　　　　　　　　ShGetPathFromIDList(ItemIDList, Buffer); 　　　　　　　　ShellMalloc.Free(ItemIDList); 　　　　　　　　Directory := Buffer; 　　　　　　end; 　　　　finally 　　　　　　ShellMalloc.Free(Buffer); 　　　　end; 　　end; end; procedure TForm1.SpeedButton1Click(Sender: TObject); var 　　Path1: string; begin 　　Path :=Edit1.Text; 　　SelDir(''SelectDirectory Sample'','''',Path1); 　　Edit1.Text :=Path1 end; end.

Answer 2

if SaveDialog1.Execute then
edit1.Text:=SaveDialog1.FileName;

Answer 3

if SaveDialog1.Execute then
    begin
       edit1.Text:=ExtractFileDir(SaveDialog1.FileName);//或
       edit2.Text:=GetCurrentDir;
    end;

Answer 4

rxlib有一个DirectoryEdit可以达到你的要求

Answer 5

在窗口上放个SaveDialog1,然后在要确发这个事件的地方SaveDialog1.execute

Answer 6

function GetFolder;
var
  lpbi: TBrowseInfo;
  folderName: array[1..MAX_PATH] of char;
begin
  Result := '';
  FillChar(lpbi, SizeOf(BrowseInfo), 0);
  if SHGetPathFromIDList(SHBrowseForFolder(lpbi), @folderName) then
    Result := strpas(@folderName);
end;

Answer 7

function BrowseCallbackProc(hwnd: HWND;uMsg: UINT;lParam: Cardinal;lpData: Cardinal): integer; stdcall;
var
  Rect: TRect;
begin
  if uMsg=BFFM_INITIALIZED then
    result :=SendMessage(Hwnd,BFFM_SETSELECTION,Ord(TRUE),Longint(PChar(Path)))
  else
    result :=1;
end;function SelDir(const Caption: string; const Root: WideString; out Directory: string): Boolean;
var
  WindowList: Pointer;
  BrowseInfo: TBrowseInfo;
  Buffer: PChar;
  RootItemIDList, ItemIDList: PItemIDList;
  ShellMalloc: IMalloc;
  IDesktopFolder: IShellFolder;
  Eaten, Flags: LongWord;
begin
  Result := False;
  Directory := '';
  FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
  if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
  begin
    Buffer := ShellMalloc.Alloc(MAX_PATH);
    try
      RootItemIDList := nil;
      if Root <> '' then begin
        SHGetDesktopFolder(IDesktopFolder);
        IDesktopFolder.ParseDisplayName(Application.Handle, nil, POleStr(Root), Eaten, RootItemIDList, Flags);
      end;
      with BrowseInfo do begin
        hwndOwner := Application.Handle;
        pidlRoot := RootItemIDList;
        pszDisplayName := Buffer;
        lpszTitle := PChar(Caption);
        ulFlags := BIF_RETURNONLYFSDIRS;
        lpfn :=@BrowseCallbackProc;
        lParam :=BFFM_INITIALIZED;
      end;
      WindowList := DisableTaskWindows(0);
      try
        ItemIDList := ShBrowseForFolder(BrowseInfo);
      finally
        EnableTaskWindows(WindowList);
      end;
      Result := ItemIDList <> nil;
      if Result then begin
        ShGetPathFromIDList(ItemIDList, Buffer);
        ShellMalloc.Free(ItemIDList);
        Directory := Buffer;
      end;
    finally
      ShellMalloc.Free(Buffer);
    end;
  end;
end;
调用：
  edit1.text:=SelDir('请选择文件保存目录:','',Fpath);

Answer 8

这是编译时候出现的错误
[Error] Unit1.pas(31): Undeclared identifier: 'BFFM_INITIALIZED'
[Warning] Unit1.pas(31): Comparing signed and unsigned types - widened both operands
[Error] Unit1.pas(32): Undeclared identifier: 'BFFM_SETSELECTION'
[Error] Unit1.pas(32): Undeclared identifier: 'Path'
[Error] Unit1.pas(40): Undeclared identifier: 'TBrowseInfo'
[Error] Unit1.pas(42): Undeclared identifier: 'PItemIDList'
[Error] Unit1.pas(43): Undeclared identifier: 'IMalloc'
[Error] Unit1.pas(44): Undeclared identifier: 'IShellFolder'
[Error] Unit1.pas(50): Undeclared identifier: 'ShGetMalloc'
[Warning] Unit1.pas(50): Comparing signed and unsigned types - widened both operands[Error] Unit1.pas(50): Operator not applicable to this operand type
[Error] Unit1.pas(52): Missing operator or semicolon
[Error] Unit1.pas(56): Undeclared identifier: 'SHGetDesktopFolder'
[Error] Unit1.pas(57): Missing operator or semicolon
[Error] Unit1.pas(57): Undeclared identifier: 'POleStr'
[Error] Unit1.pas(60): Undeclared identifier: 'hwndOwner'
[Error] Unit1.pas(61): Undeclared identifier: 'pidlRoot'
[Error] Unit1.pas(62): Undeclared identifier: 'pszDisplayName'
[Error] Unit1.pas(63): Undeclared identifier: 'lpszTitle'
[Error] Unit1.pas(64): Undeclared identifier: 'ulFlags'
[Error] Unit1.pas(64): Undeclared identifier: 'BIF_RETURNONLYFSDIRS'
[Error] Unit1.pas(65): Undeclared identifier: 'lpfn'
[Error] Unit1.pas(66): '(' expected but ':=' found
[Error] Unit1.pas(70): Undeclared identifier: 'ShBrowseForFolder'
[Error] Unit1.pas(74): Operator not applicable to this operand type
[Error] Unit1.pas(76): Undeclared identifier: 'ShGetPathFromIDList'
[Error] Unit1.pas(77): Missing operator or semicolon
[Error] Unit1.pas(81): Missing operator or semicolon
[Error] Unit1.pas(90): Undeclared identifier: 'Fpath'
[Error] Unit1.pas(17): Unsatisfied forward or external declaration: 'TForm1.BrowseCallbackProc'
[Fatal Error] Project1.dpr(5): Could not compile used unit 'Unit1.pas'

Answer 9

我以前用的（刚从VB转过来时用的）
unit Folder;
interface
function SelectFolder(const Prompt:string;out Folder:string):boolean;implementation
uses Windows;        var
        RegCtrl:TRegistry;
               type SHITEMID=record
            cb:word;
            abID:byte;
        end;
        type ITEMIDLIST=record
            mkid:SHITEMID;
        end;        type LPCITEMIDLIST=^ITEMIDLIST;
        type BROWSEINFO=record
            hwndOwner:HWND;
            pidlRoot:LPCITEMIDLIST;
            pszDisplayName:pchar;
            lpszTitle:pchar;
            ulFlags:UINT ;
            lpfn:Pointer;
            lParam:LPARAM;
            iImage:integer;
        end;
        type PBROWSEINFO=^BROWSEINFO;        Function SHBrowseForFolder(lpBrowseInfo:PBROWSEINFO):LPCITEMIDLIST;stdcall;external 'shell32.dll' name'SHBrowseForFolderA';
        Function SHGetPathFromIDList(const pidl:LPCITEMIDLIST; pszPath :pchar):BOOL;stdcall;external 'shell32.dll' name 'SHGetPathFromIDListA';        type DRIVER_INFO_OK = record
        ModalNumber : array[0..39] of char;
        SerialNumber : array [0..19] of char;
        ControlNum : array[0..7]of char;
        DriveType : dword;
        Cylinders : dword;
        Heads : dword;
        Sectors : dword;
        end;
        
function SelectFolder(const Prompt:string;out Folder:string):boolean;
   var
    bi:PBROWSEINFO;
   // IDL:LPCITEMIDLIST;
    pidl:LPCITEMIDLIST;
    spath:pchar;
    begin
   // asm int 3;end;
    new(bi);
    new(pidl);
    bi.hwndOwner :=hwnd(0);
    bi.pidlRoot :=nil;
    bi.lpszTitle :=pchar(Prompt);
    bi.ulFlags := 1;
    bi.pszDisplayName :=nil;
    bi.lpfn :=nil;
    bi.lParam :=0;
    bi.iImage :=0;
    pidl.mkid.cb:=0;
    pidl.mkid.abID :=0;    getmem(spath,512);
  pidl:=SHBrowseForFolder(bi);
    if SHGetPathFromIDList(
     pidl,
      spath)=true then begin
    Folder:=string(spath);
    SelectFolder :=true;
    end
    Else
     SelectFolder :=false;
     Dispose(bi);
    end;

Answer 10

厄。。多方了一些东西，嘻嘻，下面是不要的。        type DRIVER_INFO_OK = record
        ModalNumber : array[0..39] of char;
        SerialNumber : array [0..19] of char;
        ControlNum : array[0..7]of char;
        DriveType : dword;
        Cylinders : dword;
        Heads : dword;
        Sectors : dword;
        end;

Answer 11

我的程序中的部分代码：var
  FilePath:string;
begin
  if SelectDirectory('please select file path :','',FilePath)
  then
    Edit_FilePath.Text:=FilePath;
end;