用SelectDirectory函數，怎樣才可以加入預設的目錄 |
|
尚未結案
|
|
SimonLee
一般會員   發表：15 回覆：23 積分：7 註冊：2003-09-20 發送簡訊給我 |
|
|
bigdogchina
版主  發表：238 回覆：523 積分：312 註冊：2003-04-28 發送簡訊給我 |
|
|
Chance36
版主 發表：31 回覆：1033 積分：792 註冊：2002-12-31 發送簡訊給我 |
|
|
SimonLee
一般會員 發表：15 回覆：23 積分：7 註冊：2003-09-20 發送簡訊給我 |
我用Delphi7試過用SelectDirectory，在Delphi7中的SelectDirectory是可以有預設的，所以我將Delphi7的SelectDirectory的原代碼改在Delphi5內測試，改了函數的名稱叫SelectFolder，經過我改動後，新的SelectFolder函數是可以做到我預期的效果了，以下是我的編碼
unit Unit1; interface uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
filectrl, StdCtrls; type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
end; var
Form1: TForm1; implementation uses
ShlObj, ActiveX; {$R *.DFM} function SelectDirCB(Wnd: HWND; uMsg: UINT; lParam, lpData: LPARAM): Integer stdcall;
begin
if (uMsg = BFFM_INITIALIZED) and (lpData <> 0) then
SendMessage(Wnd, BFFM_SETSELECTION, Integer(True), lpdata);
result := 0;
end; function SelectFolder(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 := SelectDirCB;
lParam := Integer(PChar(Directory));
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; procedure TForm1.Button1Click(Sender: TObject);
var
ss: string;
begin
ss := 'D:\BURN';
if SelectFolder('Choose Folder','',ss) then
showmessage('Your Choose is ' ss);
end; end.
Anyway, 多謝各位的幫忙
|
發表時間：2004-08-20 10:39:31
IP:218.17.xxx.xxx 未訂閱
系統時間：2024-11-25 12:14:22
聯絡我們 | Delphi K.Top討論版
| 本站聲明 |
|
1. 本論壇為無營利行為之開放平台，所有文章都是由網友自行張貼，如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權，而損及您的利益，請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨，是藍是綠本站無權干涉，但這裡不是政治性論壇！ |