求教。。。

Question

有没有象TOpenDialog样的控件，只想得到指定的目录需程序运行后其操作象TOpenDialog一样的方便

Answer 1

楼主，分也太少了吧
unit MDa18_SelectDirectory;interfaceuses
  SysUtils, Classes, ShlObj, ActiveX, Windows, Messages, Forms;type  TCheckBoxOption = class (TPersistent)
  private
    FCaption:String;
    FShow : boolean;
    FChecked : boolean;
  public
      constructor Create;
      destructor Destroy;override;
  published
      property Caption:String read FCaption  write FCaption;
      property Show:boolean read FShow  write FShow;
      property Checked:boolean read FChecked  write FChecked;
  end;  Da18_SelectDirectory = class(TComponent)
  private
    { Private declarations }
    FCaption:String;
    FRoot:String;
    FDirectory:String;
    FCheckBoxOption:TCheckBoxOption;
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
    function Execute: Boolean;
  published
    { Published declarations }
    property Caption: String read FCaption write FCaption;
    property Root: String read FRoot write FRoot;
    property Directory: String read FDirectory write FDirectory;
    property CheckBoxOption:TCheckBoxOption read FCheckBoxOption write FCheckBoxOption;
  end;procedure Register;implementationvar
  CheckBoxOldWndProc : TFNWndProc;
  OldWndProc: Pointer;
  dwStyle: DWORD;
  hFont:integer;
  Chk:hwnd;
  lpRect: TRect;
  MCheckBoxOption:TCheckBoxOption;function CheckBoxNewWndProc(Handle: HWND; Msg: Integer; wParam, lParam: Longint):
  Longint; stdcall;
begin
  Result := CallWindowProc(CheckBoxOldWndProc, Handle, Msg, wParam, lParam);
  If Msg = 512 Then Begin
  if SendMessage(Handle, BM_GetCheck, 0, 0) = 1 then
  MCheckBoxOption.FChecked:=True
  else
  MCheckBoxOption.FChecked:=False;
  End;
end;function SelectDirCBA(Wnd: HWND; uMsg: UINT; lParam, lpData: LPARAM): Integer stdcall;
begin
  if (uMsg = BFFM_INITIALIZED) and (lpData <> 0) then begin
  if MCheckBoxOption.FShow then begin
  dwStyle := WS_CHILD or WS_VISIBLE or BS_AUTOCHECKBOX;
  Chk:=CreateWindow('BUTTON', Pchar(MCheckBoxOption.FCaption), dwStyle, 11, 256, 120, 20, Wnd, 0, 0, nil);
  hFont:=CreateFont(Screen.MenuFont.Height,0,0,0,0,0,0,0,Screen.MenuFont.Charset,OUT_DEFAULT_PRECIS,CLIP_DEFAULT_PRECIS,DEFAULT_QUALITY,DEFAULT_PITCH or FF_DONTCARE,PChar(Screen.MenuFont.Name));
  SendMessage(Chk,WM_SETFONT,hFont,0);
  If MCheckBoxOption.FChecked Then SendMessage(Chk, BM_SetCheck, 1, 0);
  CheckBoxOldWndProc := TFNWndProc(SetWindowLong(Chk, GWL_WNDPROC,Longint(@CheckBoxNewWndProc)));
  end;
  GetWindowRect(Wnd,lpRect);
  SetWindowPos(Wnd,HWND_TOP,(Screen.Width-(lpRect.Right-lpRect.Left)) Div 2,(Screen.Height-(lpRect.Bottom-lpRect.Top)) Div 2,0,0,SWP_NOSIZE);
  SendMessage(Wnd, BFFM_SETSELECTION, Integer(True), lpdata);
  end;
  result := 0;
end;function SelectDirCBB(Wnd: HWND; uMsg: UINT; lParam, lpData: LPARAM): Integer stdcall;
begin
  if (uMsg = BFFM_INITIALIZED) then begin
  if MCheckBoxOption.FShow then begin
  dwStyle := WS_CHILD or WS_VISIBLE or BS_AUTOCHECKBOX;
  Chk:=CreateWindow('BUTTON', Pchar(MCheckBoxOption.FCaption), dwStyle, 11, 256, 120, 20, Wnd, 0, 0, nil);
  hFont:=CreateFont(Screen.MenuFont.Height,0,0,0,0,0,0,0,Screen.MenuFont.Charset,OUT_DEFAULT_PRECIS,CLIP_DEFAULT_PRECIS,DEFAULT_QUALITY,DEFAULT_PITCH or FF_DONTCARE,PChar(Screen.MenuFont.Name));
  SendMessage(Chk,WM_SETFONT,hFont,0);
  If MCheckBoxOption.FChecked Then SendMessage(Chk, BM_SetCheck, 1, 0);
  CheckBoxOldWndProc := TFNWndProc(SetWindowLong(Chk, GWL_WNDPROC,Longint(@CheckBoxNewWndProc)));
  end;
  GetWindowRect(Wnd,lpRect);
  SetWindowPos(Wnd,HWND_TOP,(Screen.Width-(lpRect.Right-lpRect.Left)) Div 2,(Screen.Height-(lpRect.Bottom-lpRect.Top)) Div 2,0,0,SWP_NOSIZE);
  end;
  result := 0;
end;function SelectDirectory(const Caption: string; const Root: WideString;
  var Directory: string): Boolean;
var
  WindowList: Pointer;
  BrowseInfo: TBrowseInfo;
  Buffer: PChar;
  OldErrorMode: Cardinal;
  RootItemIDList, ItemIDList: PItemIDList;
  ShellMalloc: IMalloc;
  IDesktopFolder: IShellFolder;
  Eaten, Flags: LongWord;
begin
  Result := False;
  if not DirectoryExists(Directory) then
    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;
        if Directory <> '' then
        begin
          lpfn := SelectDirCBA;
          lParam := Integer(PChar(Directory));
          end else begin
          lpfn := SelectDirCBB;
        end;
      end;
      WindowList := DisableTaskWindows(0);
      OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
      try
        ItemIDList := ShBrowseForFolder(BrowseInfo);
      finally
        SetErrorMode(OldErrorMode);
        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;constructor TCheckBoxOption.Create;
begin
  inherited Create;
end;destructor TCheckBoxOption.Destroy;
begin
  inherited Destroy;
end;constructor Da18_SelectDirectory.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FCheckBoxOption:=TCheckBoxOption.Create;
MCheckBoxOption:=TCheckBoxOption.Create;
end;destructor Da18_SelectDirectory.Destroy;
begin
FCheckBoxOption.Free;
MCheckBoxOption.Free;
inherited Destroy;
end;procedure Da18_SelectDirectory.Loaded;
begin
  inherited Loaded;
end;function Da18_SelectDirectory.Execute: Boolean;
begin
  Result := false;
  MCheckBoxOption.FCaption:=FCheckBoxOption.FCaption;
  MCheckBoxOption.FShow:=FCheckBoxOption.FShow;
  MCheckBoxOption.FChecked:=FCheckBoxOption.FChecked;
  if SelectDirectory(FCaption,FRoot,FDirectory) then
  begin
  FCheckBoxOption.FCaption:=MCheckBoxOption.FCaption;
  FCheckBoxOption.FShow:=MCheckBoxOption.FShow;
  FCheckBoxOption.FChecked:=MCheckBoxOption.FChecked;
  Result := true;
  end;
end;procedure Register;
begin
  RegisterComponents('Da18', [Da18_SelectDirectory]);
end;end.

Answer 2

你不把OpenDialog给显示出来就行了，也就是不Execute，只需要在后台程序操作，应该是可以的。你试试！