unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    ComboBox1: TComboBox;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ShlObj, ActiveX;

type
  PBFFRecord = ^TBFFRecord;
  TBFFRecord = record
  InitDir : PChar;
  X  : Integer;
  Y  : Integer;
end;

{$R *.dfm}

//-----------------------------------------------------------------------------
//  SHBrowseForFolder関数ののコールバック関数のコード例
//
//  [引数]
//  hWindow  ダイアログのハンドル
//  uMsg     ダイアログが発行するメッセージ
//  lParam   uMsgに応じた値
//  lpData   呼出し側のTBFFRecord構造体のポインタ
//-----------------------------------------------------------------------------
function plBrowseExCallBack(hWindow: HWND; uMsg: UINT; lParam: LPARAM;
  lpData: LPARAM): Integer; stdcall;
var
   PathName  : array[0..MAX_PATH-1] of Char;
   APath     : String;
   PBFFR     : PBFFRecord;
   ARect     : TRect;
   APosX     : Integer;
   APosY     : Integer;
   DlgWidth  : Integer;
   DlgHeight : Integer;
begin
  case uMsg of

  //ダイアログの表示開始初期状態
  BFFM_INITIALIZED:
    begin
      PBFFR := pointer(lpData);
      //初期選択フォルダ名が空でなければ，それを選択状態にする
      //それにはダイアログウィンドウにBFFM_SETSELECTIONメッセージを送る
      if lstrlen(PBFFR^.InitDir) > 1 then begin
        SendMessage(hWindow,BFFM_SETSELECTION,1,Integer(PBFFR^.InitDir));
      end;
      //表示位置の設定
      APosX := PBFFR^.X;
      APosY := PBFFR^.Y;

      //表示指定の座標値が共に-1であれば画面の中央に表示
      //そうでないと時はAPosXとAPosYで指定する値
      if (APosX < 0) and (APosY < 0) then begin
        GetWindowRect(hWindow,ARect);
        DlgWidth  := ARect.Right-ARect.Left;
        DlgHeight := ARect.Bottom-ARect.Top;
        APosX := (GetSystemMetrics(SM_CXSCREEN) - DlgWidth)  div 2;
        APosY := (GetSystemMetrics(SM_CYSCREEN) - DlgHeight) div 2;
      end;
      SetWindowPos(hWindow, 0, APosX, APosY, 0, 0, SWP_NOSIZE or SWP_NOZORDER);
    end;

  //フォルダまたはファイルが選択された
  BFFM_SELCHANGED:
    begin
      //選択しているフォルダの項目識別子をパス文字列に変換
      //それをステータス表示部に表示
      //TBrowseInfo構造体のulFlagsにBIF_STATUSTEXTを指定した時の処理方法例
      SHGetPathFromIDList(PItemIDList(lParam), Addr(PathName));
      APath := PathName;
      SendMessage(hWindow,
                  BFFM_SETSTATUSTEXT,
                  0,
                  LongInt(PChar(ExtractFileName(APath))));
    end;
  end;
  //このコールバック関数は常に0を返さなければいけない
  Result := 0;
end;

//-----------------------------------------------------------------------------
//  SHBrowseForFolder関数でフォルダの参照ダイアログを表示する
//  戻り値は選択したフォルダのフルパス文字列
//
//  [引数]
//  RootDir  ルートフォルダ．CSIDL値で指定する
//  InitDir  表示開始時に選択するフォルダ．フルパスの文字列で指定する
//  Flags    表示スタイルの指定．BIF_XXXXの組合わせで指定する
//  X        ダイアログの表示位置．左上のX座標値
//  Y        同上．左上のY座標値
//-----------------------------------------------------------------------------
function plBrowseForderEx(RootDir:Integer; InitDir: String; Flags: UINT;
   X,Y:Integer): String;
var
   AFileDir     : String;
   BFFR         : TBFFRecord;
   IDList       : PItemIDList;
   BrowseInfo   : TBrowseInfo;
   BPathName    : array[0..MAX_PATH-1] of Char;
   BDisplayName : array[0..MAX_PATH-1] of Char;
   Malloc       : IMalloc;
begin
   SHGetMalloc(Malloc);
   FillChar(BrowseInfo, SizeOf(BrowseInfo), #0);

   //CSIDL値を項目識別子に変換
   SHGetSpecialFolderLocation(Application.Handle, RootDir, IDList);

   AFileDir     := InitDir;
   BFFR.InitDir := PChar(AFileDir);
   BFFR.X       := X;
   BFFR.Y       := Y;

   BrowseInfo.hwndOwner      := Application.Handle;
   BrowseInfo.pidlRoot       := IDList;
   BrowseInfo.pszDisplayName := BDisplayName;
   BrowseInfo.lpszTitle      := PChar('フォルダの指定');
   BrowseInfo.ulFlags        := Flags;
   BrowseInfo.lpfn           := Addr(plBrowseExCallBack);
   BrowseInfo.lParam         := integer(Addr(BFFR));

   IDList := SHBrowseForFolder(BrowseInfo);
   if IDList <> nil then begin
     //BrowseInfo.pszDisplayNameだとパス部分がない名前
     SHGetPathFromIDList(IDList,Addr(BPathName));
     Result := BPathName;
     Malloc.Free(IDList);
   end;
end;

//=============================================================================
//  上の関数をテストするコード
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  RootDir : Integer;
  InitDir : String;
  Flags   : UINT;
  PosX    : Integer;
  PosY    : Integer;
begin
  //ルートと初期選択フォルダ
  //RootDir := 0; の時はデスクトップ
  RootDir := 0;
  if ComboBox1.Text <> '' then begin
    if ComboBox1.ItemIndex >= 1 then begin
      RootDir := Integer(ComboBox1.Items.Objects[ComboBox1.ItemIndex]);
    end else begin
      InitDir := ComboBox1.Text;
    end;
  end;

  //表示開始位置
  //共に-1だと画面中央
  PosX := -1;
  PosY := -1;

  //表示スタイル
  Flags := BIF_RETURNONLYFSDIRS or BIF_STATUSTEXT;

  //次回はInitDirを選択フォルダにするためにInitDirに結果を取得
  InitDir := plBrowseForderEx(RootDir, InitDir, Flags, PosX, PosY);
  if InitDir <> '' then begin
    ComboBox1.Text := InitDir;
    Panel1.Caption := '　' + InitDir;
  end;
end;

//=============================================================================
//  特殊フォルダのCSIDL値をセット
//  これをルートフォルダにする
//  Vista以降にしか対応していないCSIDL_値があるので定数ではなく実値を格納
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  ComboBox1.Text := '';
  ComboBox1.AutoComplete := False;

  //ルートフォルダ用の値をセット
  with ComboBox1.Items do begin
    Clear;
    //このプロジェクトのフォルダ
    Add( ExtractFileDir(ParamStr(0)));
    AddObject('CSIDL_DESKTOP',                 TObject($0000));
    AddObject('CSIDL_INTERNET',                TObject($0001));
    AddObject('CSIDL_PROGRAMS',                TObject($0002));
    AddObject('CSIDL_CONTROLS',                TObject($0003));
    AddObject('CSIDL_PRINTERS',                TObject($0004));
    AddObject('CSIDL_PERSONAL',                TObject($0005));
    AddObject('CSIDL_FAVORITES',               TObject($0006));
    AddObject('CSIDL_STARTUP',                 TObject($0007));
    AddObject('CSIDL_RECENT',                  TObject($0008));
    AddObject('CSIDL_SENDTO',                  TObject($0009));
    AddObject('CSIDL_BITBUCKET',               TObject($000A));
    AddObject('CSIDL_STARTMENU',               TObject($000B));
    AddObject('CSIDL_MYDOCUMENTS',             TObject($000C));
    AddObject('CSIDL_MYMUSIC',                 TObject($000D));
    AddObject('CSIDL_MYVIDEO',                 TObject($000E));
    AddObject('CSIDL_DESKTOPDIRECTORY',        TObject($0010));
    AddObject('CSIDL_DRIVES',                  TObject($0011));
    AddObject('CSIDL_NETWORK',                 TObject($0012));
    AddObject('CSIDL_NETHOOD',                 TObject($0013));
    AddObject('CSIDL_FONTS',                   TObject($0014));
    AddObject('CSIDL_TEMPLATES',               TObject($0015));
    AddObject('CSIDL_COMMON_STARTMENU',        TObject($0016));
    AddObject('CSIDL_COMMON_PROGRAMS',         TObject($0017));
    AddObject('CSIDL_COMMON_STARTUP',          TObject($0018));
    AddObject('CSIDL_COMMON_DESKTOPDIRECTORY', TObject($0019));
    AddObject('CSIDL_APPDATA',                 TObject($001A));
    AddObject('CSIDL_PRINTHOOD',               TObject($001B));
    AddObject('CSIDL_LOCAL_APPDATA',           TObject($001C));
    AddObject('CSIDL_ALTSTARTUP',              TObject($001D));
    AddObject('CSIDL_COMMON_ALTSTARTUP',       TObject($001E));
    AddObject('CSIDL_COMMON_FAVORITES',        TObject($001F));
    AddObject('CSIDL_INTERNET_CACHE',          TObject($0020));
    AddObject('CSIDL_COOKIES',                 TObject($0021));
    AddObject('CSIDL_HISTORY',                 TObject($0022));
    AddObject('CSIDL_COMMON_APPDATA',          TObject($0023));
    AddObject('CSIDL_WINDOWS',                 TObject($0024));
    AddObject('CSIDL_SYSTEM',                  TObject($0025));
    AddObject('CSIDL_PROGRAM_FILES',           TObject($0026));
    AddObject('CSIDL_MYPICTURES',              TObject($0027));
    AddObject('CSIDL_PROFILE',                 TObject($0028));
    AddObject('CSIDL_SYSTEMX86',               TObject($0029));
    AddObject('CSIDL_PROGRAM_FILESX86',        TObject($002A));
    AddObject('CSIDL_PROGRAM_FILES_COMMON',    TObject($002B));
    AddObject('CSIDL_PROGRAM_FILES_COMMONX86', TObject($002C));
    AddObject('CSIDL_COMMON_TEMPLATES',        TObject($002D));
    AddObject('CSIDL_COMMON_DOCUMENTS',        TObject($002E));
    AddObject('CSIDL_COMMON_ADMINTOOLS',       TObject($002F));
    AddObject('CSIDL_ADMINTOOLS',              TObject($0030));
    AddObject('CSIDL_CONNECTIONS',             TObject($0031));
    AddObject('CSIDL_COMMON_MUSIC',            TObject($0035));
    AddObject('CSIDL_COMMON_PICTURES',         TObject($0036));
    AddObject('CSIDL_COMMON_VIDEO',            TObject($0037));
    AddObject('CSIDL_RESOURCES',               TObject($0038));
    AddObject('CSIDL_RESOURCES_LOCALIZED',     TObject($0039));
    AddObject('CSIDL_COMMON_OEM_LINKS',        TObject($003A));
    AddObject('CSIDL_CDBURN_AREA',             TObject($003B));
    AddObject('CSIDL_COMPUTERSNEARME',         TObject($003D));
    AddObject('CSIDL_PROFILES',                TObject($003E));
  end;
end;

end.

//=============================================================================
//  作成したフォルダ参照ダイアログコンポーネントのテストプログラム
//  ルートフォルダをコンボボックスから選択
//
//  表示位置の取得はフォルダ選択時に行っている
//  したがって，フォルダ選択後に移動しても位置は記録されない
//  ダイアログを[キャンセル]で閉じた場合も位置の記録はしない
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  AIndex  : Integer;
  Browser : TplBrowseFolderEx;
begin
  //コンポーネント生成
  Browser := TplBrowseFolderEx.Create(Self);

  try
    //ルートと初期選択フォルダ
    if ComboBox1.Text <> '' then begin
      AIndex := ComboBox1.ItemIndex;
      if AIndex >= 1 then begin
        Browser.RootSpecialDir := Integer(ComboBox1.Items.Objects[AIndex]);
      end else begin
        Browser.RootDir := ComboBox1.Text;
        Browser.InitDir := ComboBox1.Text + '\AAA\BBB';
      end;
    end;

    //表示位置
    if APosX > 0 then Browser.Left := APosX;
    if APosy > 0 then Browser.Top  := APosy;
    //表示スタイル
    Browser.Options := [bifReturnOnlyFSDirs];

    //ダイアログを表示して[OK]で閉じたら
    if Browser.Execute then begin
      //表示位置を記憶しておき，次回この位置に表示する
      APosX := Browser.Left;
      APosY := Browser.Top;
      Panel1.Caption := '　' + Browser.Directory;
    end;
  finally
    FreeAndNil(Browser);
  end;
end;

//=============================================================================
//  特殊フォルダのCSIDL値をセット
//  これをルートフォルダにする
//  Vista以降にしか対応していないCSIDL_値があるので定数ではなく実値を格納
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  //最初のサンプルと同じ
end;

//=============================================================================
//  作成したフォルダ参照ダイアログコンポーネントのテストプログラム
//  ルートフォルダをコンボボックスから選択する
//  BIF関係オプションの組み合わせ動作の確認用
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  AIndex  : Integer;
begin
  //ルートと初期選択フォルダ
  if ComboBox1.Text <> '' then begin
    AIndex := ComboBox1.ItemIndex;
    if AIndex >= 1 then begin
      plBrowser.RootSpecialDir := Integer(ComboBox1.Items.Objects[AIndex]);
    end else begin
      plBrowser.RootDir := ComboBox1.Text;
      plBrowser.InitDir := ComboBox1.Text + '\AAA\BBB';
    end;
  end;

  //表示位置
  plBrowser.Left := -1;
  plBrowser.Top  := -1;

  //表示スタイルのオプション
  plBrowser.Options := [];
  with plBrowser do begin
    if CheckBox1.Checked  then Options := Options + [bifReturnOnlyFSDirs];
    if CheckBox2.Checked  then Options := Options + [bifDontGoBelowDomain];
    if CheckBox3.Checked  then Options := Options + [bifStatusText];
    if CheckBox4.Checked  then Options := Options + [bifReturnFSAncestors];
    if CheckBox5.Checked  then Options := Options + [bifEditBox];
    if CheckBox6.Checked  then Options := Options + [bifValidate];
    if CheckBox7.Checked  then Options := Options + [bifNewDialogStyle];
    if CheckBox8.Checked  then Options := Options + [bifUseNewUI];
    if CheckBox9.Checked  then Options := Options + [bifBrowseIncludeURLs];
    if CheckBox10.Checked then Options := Options + [bifUAHint];
    if CheckBox11.Checked then Options := Options + [bifNonNewFolderButton];
    if CheckBox12.Checked then Options := Options + [bifNoTranslatetarGets];
    if CheckBox13.Checked then Options := Options + [bifBrowseForComputer];
    if CheckBox14.Checked then Options := Options + [bifBrowseForPrinter];
    if CheckBox15.Checked then Options := Options + [bifBrowseIncludeFiles];
    if CheckBox16.Checked then Options := Options + [bifShareable];
  end;

  //ダイアログを表示して[OK]で閉じたら
  if plBrowser.Execute then begin
    Panel1.Caption := '　' + plBrowser.Directory;
  end;
end;

//=============================================================================
//  特殊フォルダのCSIDL値をセット
//  これをルートフォルダにする
//  Vista以降にしか対応していないCSIDL_値があるので定数ではなく実値を格納
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  //コンポーネント生成
  plBrowser := TplBrowseFolderEx.Create(Self);

  //以下，最初のサンプルと同じ

end;

unit plBrowseFolderEx;

interface

uses
  SysUtils, Classes, Windows, Forms;

type
  //指定可能なオブションの要素
  //オブシェクトインスペクタで設計時に設定可能とするため定義
  TplBrowseOp =(bifReturnOnlyFSDirs,
                bifDontGoBelowDomain,
                bifReturnFSAncestors,
                bifStatusText,
                bifEditBox,
                bifValidate,
                bifNewDialogStyle,
                bifUseNewUI,
                bifBrowseIncludeURLs,
                bifUAHint,
                bifNonNewFolderButton,
                bifNoTranslatetarGets,
                bifBrowseForComputer,
                bifBrowseForPrinter,
                bifBrowseIncludeFiles,
                bifShareable);

  //指定可能なオプションを示す集合体
  //上のTplBrowsOptionExは複数選択可能な集合体とする
  TplBrowseOps = set of TplBrowseOp;

  TplBrowseFolderEx = class(TComponent)
  private
    { Private 宣言 }
    FDirectory: String;
    FTitle          : String;
    FRootDir        : String;
    FRootSpecialDir : Integer;
    FInitDir        : String;
    FTop            : Integer;
    FLeft           : Integer;
    FOptions        : TplBrowseOps;
  protected
    { Protected 宣言 }
  public
    { Public 宣言 }
    constructor Create(AOwner: TComponent); override;
    function Execute:Boolean;
    property Directory      : String read FDirectory;
    property RootDir        : String read FRootDir        write FRootDir;
    property RootSpecialDir : Integer read FRootSpecialDir write FRootSpecialDir;
    property InitDir        : String read FInitDir        write FInitDir;
    property Top            : Integer read FTop            write FTop;
    property Left           : Integer read FLeft           write FLeft;
  published
    { Published 宣言 }
    property Title   : String      read FTitle   write FTitle;
    property Options : TplBrowseOps read FOptions write FOptions;
  end;

procedure Register;

implementation

uses ShlObj, ActiveX, Dialogs;

//-----------------------------------------------------------------------------
//  コンポーネント登録情報
//-----------------------------------------------------------------------------
procedure Register;
begin
  RegisterComponents('Samples', [TplBrowseFolderEx]);
end;

{ TplBrowseFolderEx }

type
  PBFFRecord = ^TBFFRecord;
  TBFFRecord = record
  InitDir : PChar;
  X  : Integer;
  Y  : Integer;
end;

var
  APosX : Integer;
  APosY : Integer;
  //ダイアログの各オプションに対応する集合型
  //Vista以外で使用することを考えて実値で定義
  BrowseOptions: array [TplBrowseOp] of Integer=($0001, //BIF_RETURNONLYFSDIRS
                                                 $0002, //以下略
                                                 $0004,
                                                 $0008,
                                                 $0010,
                                                 $0020,
                                                 $0040,
                                                 $0050,
                                                 $0080,
                                                 $0100,
                                                 $0200,
                                                 $0400,
                                                 $1000,
                                                 $2000,
                                                 $4000,
                                                 $8000);

//-----------------------------------------------------------------------------
//  フルパス名を項目識別子に変換する関数
//  特殊フォルダ(CSIDL以外)もルートフォルダで指定可能なようにするため装備
//-----------------------------------------------------------------------------
function GetPItemIDFromFullPath(ShFolder:IShellFolder ;Path:String): PItemIDList;
var
  Len   : Cardinal;
  Flags : Cardinal;
begin
  Flags := 0;
  Len   := Length(Path);
  ShFolder.ParseDisplayName(Application.Handle,
                            nil,
                            PWideChar(StringToOleStr(Path)),
                            Len,
                            Result,
                            Flags);
end;

//=============================================================================
//  コンポーネントの初期化
//=============================================================================
constructor TplBrowseFolderEx.Create(AOwner: TComponent);
begin
  inherited;

  //初期状態の表示位置はデスクトップの真中
  FTop  := -1;
  FLeft := -1;
  FRootSpecialDir := CSIDL_DESKTOP;
  FOptions        := [bifReturnOnlyFSDirs];
end;

//-----------------------------------------------------------------------------
//  フォルダー選択ダイアログのコールバック関数
//  表示位置の戻り値は，フォルダ選択後に移動した値は無効
//-----------------------------------------------------------------------------
function plBrowseExCallBack(hWindow: HWND; uMsg: UINT; lParam: LPARAM;
  lpData: LPARAM): Integer; stdcall;
var
  PBFFR     : PBFFRecord;
  ARect     : TRect;
  DlgWidth  : Integer;
  DlgHeight : Integer;
begin
  case uMsg of

  //ダイアログの表示開始初期状態
  BFFM_INITIALIZED:
    begin
      PBFFR := pointer(lpData);

      //初期選択フォルダ名が空でなければ，それを選択状態にする
      //それにはダイアログウィンドウにBFFM_SETSELECTIONメッセージを送る
      if lstrlen(PBFFR^.InitDir) > 1 then begin
        SendMessage(hWindow, BFFM_SETSELECTION, 1, Integer(PBFFR^.InitDir));
      end;

      //表示位置の設定
      //実際にはAPosX,APosYはグローバル変数なのでPBFFRを経由しなくてもよい
      APosX := PBFFR^.X;
      APosY := PBFFR^.Y;
      //表示指定の座標値が共に-1であれば画面の中央に表示
      //そうでないと時はAPosXとAPosYで指定する値
      if (APosX < 0) and (APosY < 0) then begin
        GetWindowRect(hWindow, ARect);
        DlgWidth  := ARect.Right  - ARect.Left;
        DlgHeight := ARect.Bottom - ARect.Top;
        APosX := (GetSystemMetrics(SM_CXSCREEN) - DlgWidth) div 2;
        APosY := (GetSystemMetrics(SM_CYSCREEN) - DlgHeight) div 2;
      end else begin
      end;
      SetWindowPos(hWindow, 0, APosX, APosY, 0, 0, SWP_NOSIZE or SWP_NOZORDER);
    end;

  //フォルダまたはファイルが選択された
  BFFM_SELCHANGED:
    begin
      //終了後にダイアログの位置(左上)を取得するためにフォルダを選択する度に
      //その位置を監視
      GetWindowRect(hWindow, ARect);
      APosX := ARect.Left;
      APosY := ARect.Top;
    end;
  end;
  //このコールバック関数は常に0を返さなければいけない
  Result := 0;
end;

//=============================================================================
//  本コンポの実行メソッド
//  TOpenDialogのようにExecuteとしてみた
//
//  本コンポーネントの全プロパティ
//
//  Directory      Excuteメソッドを実行して[OK]でダイアログを閉じた時に返される
//                 ディレクトリのフルパス．読出し専用
//   Title         ダイアログ上部に表示するタイトル文字列
//  RootDir        ルートフォルダの指定．特殊フォルダ以外を指定する場合に設定
//  RootSpecialDir ルートフォルダの指定．特殊フォルダをCSIDL値で指定する
//                 RootDirの設定が優先
//  InitDir        表示開始時に選択するフォルダのフルパス文字列
//                 特殊フォルダでの指定は，このコンポーネントでは不可
//  Top            ダイアログの表示位置(左上のY座標値)．指定なしの時は画面中央
//  Left           ダイアログの表示位置(左上のX座標値)．指定なしの時は画面中央
//  Options        表示スタイルの値をBIF_XXXXXで指定する
//                 BIF_XXXXXにはusesにShlObjが必要
//=============================================================================
function TplBrowseFolderEx.Execute: Boolean;
var
  DesktopShFolder : IShellFolder;
  AFileDir        : String;
  BFFR            : TBFFRecord;
  IDList          : PItemIDList;
  BrowseInfo      : TBrowseInfo;
  Option          : TplBrowseOp;
  BPathName       : array[0..MAX_PATH-1] of Char;
  BDisplayName    : array[0..MAX_PATH-1] of Char;
  Malloc          : IMalloc;
begin
  Result := False;
  SHGetMalloc(Malloc);
  FillChar(BrowseInfo, SizeOf(BrowseInfo), #0);

  //RootDirプロパティが空でない時はそれをルートとする
  //そうでない時はRootSepecialDirを使用する
  if FRootDir <> '' then begin
    //デスクトップのシェルフォルダオブジェクト取得
    //シェルではデスクトップが大元のルートとなる
    SHGetDesktopFolder(DesktopSHFolder);
    //それを用いて通常のフルパス文字列を項目識別子に変換
    IDList := GetPItemIDFromFullPath(DesktopShFolder, FRootDir);
  end else begin
    //CSIDL値を項目識別子に変換
    SHGetSpecialFolderLocation(Application.Handle, FRootSpecialDir, IDList);
  end;

  AFileDir     := FInitDir;
  BFFR.InitDir := PChar(AFileDir);
  BFFR.X       := FLeft;
  BFFR.Y       := FTop;

  BrowseInfo.hwndOwner      := Application.Handle;
  BrowseInfo.pidlRoot       := IDList;
  BrowseInfo.pszDisplayName := BDisplayName;
  BrowseInfo.lpszTitle      := PChar(FTitle);
  BrowseInfo.lpfn           := Addr(plBrowseExCallBack);
  BrowseInfo.lParam         := Integer(Addr(BFFR));

  //オプションの設定
  BrowseInfo.ulFlags := 0;
  for Option := Low(Option) to High(Option) do begin
    if Option in FOptions then begin
      BrowseInfo.ulFlags := BrowseInfo.ulFlags or Cardinal(BrowseOptions[Option]);
    end;
  end;

  IDList := SHBrowseForFolder(BrowseInfo);
  if IDList <> nil then begin
    //BrowseInfo.pszDisplayNameだとパス部分がない名前
    SHGetPathFromIDList(IDList,
    Addr(BPathName));
    FLeft      := APosX;
    FTop       := APosY;
    Result     := True;
    FDirectory := BPathName;
    Malloc.Free(IDList);
  end;
end;

end.