[轉貼]如何瀏覽網路芳鄰

有關Delphi 的語法, 程式, 等
回覆文章
頭像
tim
文章: 1379
註冊時間: 2008年 11月 26日, 00:49

[轉貼]如何瀏覽網路芳鄰

文章 tim »

http://delphi.ktop.com.tw/topic.asp?topic_id=41923
http://delphi.about.com/library/weekly/aa070400a.htm

使用的重點在於 SHBrowseForFolder, 另外還有 BrowseInfo 這個 struct 的用法!!

代碼: 選擇全部

uses ShellAPI, ShlObj;
...
function BrowseDialog
(const Title: string; const Flag: integer): string;
var
 lpItemID : PItemIDList;
 BrowseInfo : TBrowseInfo;
 DisplayName : array[0..MAX_PATH] of char;
 TempPath : array[0..MAX_PATH] of char;
begin
 Result:='';
 FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
 with BrowseInfo do begin
   hwndOwner := Application.Handle;
   pszDisplayName := @DisplayName;
   lpszTitle := PChar(Title);
   ulFlags := Flag;
 end;
 lpItemID := SHBrowseForFolder(BrowseInfo);
 if lpItemId <> nil then begin
   SHGetPathFromIDList(lpItemID, TempPath);
   Result := TempPath;
   GlobalFreePtr(lpItemID);
 end;
end;

procedure TfrMain.btnBrowseClick(Sender: TObject);
var sTitle, sFolder: string;
   iFlag : integer;
begin
 sTitle:='Choose a ' +
         rgBrowseFor.Items[rgBrowseFor.ItemIndex];
 case rgBrowseFor.ItemIndex of
   0:  iFlag :=  BIF_RETURNONLYFSDIRS;
   1:  iFlag :=  BIF_BROWSEINCLUDEFILES;
   2:  iFlag :=  BIF_BROWSEFORCOMPUTER;
   3:  iFlag :=  BIF_BROWSEFORPRINTER;
 end;
 sFolder := BrowseDialog(sTitle, iFlag);
 if sFolder <> '' then
   edSelected.text := sFolder
 else
   edSelected.text := 'Nothing selected';
end;

若是要控制該 dialog 的位置時, 必須自訂 callback function, 請參考,
http://delphi.about.com/library/weekly/aa122803a.htm

代碼: 選擇全部

function BrowseDialogCallBack
 (Wnd: HWND; uMsg: UINT; lParam, lpData: LPARAM):
 integer stdcall;
var
 wa, rect : TRect;
 dialogPT : TPoint;
begin
 //center in work area
 if uMsg = BFFM_INITIALIZED then
 begin
   wa := Screen.WorkAreaRect;
   GetWindowRect(Wnd, Rect);
   dialogPT.X := ((wa.Right-wa.Left) div 2) -
                 ((rect.Right-rect.Left) div 2);
   dialogPT.Y := ((wa.Bottom-wa.Top) div 2) -
                 ((rect.Bottom-rect.Top) div 2);
   MoveWindow(Wnd,
              dialogPT.X,
              dialogPT.Y,
              Rect.Right - Rect.Left,
              Rect.Bottom - Rect.Top,
              True);
 end;

 Result := 0;
end; (*BrowseDialogCallBack*)

function BrowseDialog
(const Title: string; const Flag: integer): string;
var
 lpItemID : PItemIDList;
 BrowseInfo : TBrowseInfo;
 DisplayName : array[0..MAX_PATH] of char;
 TempPath : array[0..MAX_PATH] of char;
begin
 Result:='';
 FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
 with BrowseInfo do begin
   hwndOwner := Application.Handle;
   pszDisplayName := @DisplayName;
   lpszTitle := PChar(Title);
   ulFlags := Flag;
   lpfn := BrowseDialogCallBack; // this is key
 end;
 lpItemID := SHBrowseForFolder(BrowseInfo);
 if lpItemId <> nil then begin
   SHGetPathFromIDList(lpItemID, TempPath);
   Result := TempPath;
   GlobalFreePtr(lpItemID);
 end;
end;
若是要做出 [新資料夾] 的按鈕功能, 則使用
BIF_NEWDIALOGstyle flag 即可.
多多留言, 整理文章, 把經驗累積下來.....
回覆文章