directorylistbox是不能实现这个功能的,用API吧SHBrowseForFolder
解决方案 »
- inherited继承构造函数问题.
- [外壳][上下文菜单]如何取得快捷方式文件(.lnk)本身的名字
- Delphi复制SQL数据库
- 如何控制MessageBox中MB_OK!或者是中文显示“确定”,或者是英文提示:“OK”
- COM+连接问题
- 请问大家如何用delphi连接上远程计算机上的sql server服务器(在线等待)
- delphi 程序在运行的时候,如何把当前Form的标题栏的颜色自定义,请问该如何做?
- 请帮我看看这个代码的问题。sql 插入记录。
- 关于数据库配置文件的疑问???
- delphi 调用Servlet用于图片上传,图片为二进制输入流
- ShellExecute 让我伤脑筋
- 自定义组件的安装问题!!!!!
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; var 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 //设置ROOT路径,只显示ROOT以下的文件及文件夹
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','C:\windows',Path1); //只显示C:\windows下的文件及文件夹
Edit1.Text :=Path1; //用户选择的目录
end; end.