unit BrowseFolder;

interface

uses  Windows, Forms, Classes, ShlObj;

type
   TBrowseForFolderDialog = class(TComponent)
   private
      bi: TBROWSEINFO;
      str: Array[0..MAX_PATH] of Char;
      pIDListItem: PItemIDList;
      pStr: PChar;
      procedure SetTitle(Title: String);
      function  GetTitle: String;
      function  GetPath: String;
   public
      property Title: string read GetTitle write SetTitle;
      function Execute: Boolean;
      property Path: string read GetPath;
   end;
   Function GetSelectedDir(Title:string; var Path:String):Boolean;
procedure register;
implementation
procedure register;
begin
  RegisterComponents('Samples',[TBrowseForFolderDialog]);
end;



procedure TBrowseForFolderDialog.SetTitle(Title: String);
begin
    bi.lpszTitle := PChar(Title);
end;

function  TBrowseForFolderDialog.GetTitle: String;
begin
   Result := bi.lpszTitle;
end;

function  TBrowseForFolderDialog.GetPath: String;
begin
   Result := pStr;
end;

function TBrowseForFolderDialog.Execute: Boolean;
begin
    bi.hwndOwner := GetActiveWindow;
    bi.pidlRoot := nil;
    bi.pszDisplayName := @str;
    bi.ulFlags := BIF_RETURNONLYFSDIRS;
    bi.lpfn := nil;
    pIDListItem := SHBrowseForFolder(bi);
    if pIDListItem <> nil then
    begin
      pStr := @Str;
      SHGetPathFromIDList(pIDListItem, pStr);
//      CoTaskMemFree(pIDListItem);
      Result := True;
    end
    else
      Result := False;
end;

Function GetSelectedDir(Title:string; var Path:String):Boolean;
var
      bi: TBROWSEINFO;
      str: Array[0..MAX_PATH] of Char;
      pIDListItem: PItemIDList;
      pStr: PChar;
begin
    bi.hwndOwner := GetActiveWindow;
    bi.pidlRoot := nil;
    bi.pszDisplayName := @str;
    bi.ulFlags := BIF_RETURNONLYFSDIRS;
    bi.lpfn := nil;
    if Title='' then bi.lpszTitle:='請選擇一個目錄：' else  bi.lpszTitle:=PChar(Title);
    pIDListItem := SHBrowseForFolder(bi);
    if pIDListItem <> nil then
    begin
      pStr := @Str;
      SHGetPathFromIDList(pIDListItem, pStr);
      Result := True;
    end
    else
      Result := False;
    Path:=pStr;
end;    
end.