unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

uses
  FileCtrl;

{$R *.dfm}

//=============================================================================
//  SelectDirectory関数で[フォルダの参照]ダイアログを表示
//  [Win3.1] タブのコンポーネントを使用したダイアログと同じスタイル
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  SelectFolder : String;
begin
  if SelectDirectory(SelectFolder, [], 0) then begin
    //
  end;
end;

end.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses FileCtrl, ShlObj, ActiveX;

{$R *.dfm}

//=============================================================================
//  SelectDirectory関数で[フォルダの参照]ダイアログを表示
//  デフォルトの設定で起動
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  RootFolder   : String;
  SelectFolder : String;
begin
  if SelectDirectory('フォルダの指定', RootFolder, SelectFolder) then begin
    MessageBox(Handle, PChar(SelectFolder), '選択フォルダ', MB_ICONINFORMATION);
  end;
end;

//=============================================================================
//  SelectDirectory関数で[フォルダの参照]ダイアログを表示
//  ルートフォルダはGUID値でマイネットワークを指定
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  RootFolder   : WideString;
  SelectFolder : String;
begin
  RootFolder := '::{208D2C60-3AEA-1069-A2D7-08002B30309D}';

  if SelectDirectory('フォルダの指定', RootFolder, SelectFolder) then begin
    MessageBox(Handle, PChar(SelectFolder), '選択フォルダ', MB_ICONINFORMATION);
  end;
end;

//=============================================================================
//  SelectDirectory関数で[フォルダの参照]ダイアログを表示
//  スタイルの指定例
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  RootFolder   : String;
  SelectFolder : String;
begin
 RootFolder   := '';
 SelectFolder := '';

 {$IF CompilerVersion > 18.49}
 if SelectDirectory('フォルダの指定',
                    RootFolder,
                    SelectFolder,
                    [sdNewUI, sdNewFolder, sdShowEdit],
                    Self) then begin
   MessageBox(Handle, PChar(SelectFolder), '選択フォルダ', MB_ICONINFORMATION);
 end;
 {$ELSE}
 MessageBox(Handle, '利用できません', '使用不可', MB_ICONWARNING);
 {$IFEND}
end;

end.

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

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

var
  Form1: TForm1;

implementation

uses
  Vcl.FileCtrl;

{$R *.dfm}

//=============================================================================
//  SelectDirectory関数で[フォルダの参照]ダイアログを表示
//
//  モダンになった［ディレクトリの選択］ダイアログ ボックス
//  Delphi 10 Seattle で実装された形式で表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LStartDir    : string;
  LDirArray    : TArray<string>;
  LTitle       : string;
  LFolderName  : string;
  LBtnCaption  : string;
begin
  LStartDir   := ExpandFileName('..\');
  LTitle      := '';
  LBtnCaption := 'OK';

  if SelectDirectory(LStartDir,
                     LDirArray,
                     [],
                     LTitle,
                     LFolderName,
                     LBtnCaption) then begin
  end;
end;

end.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses FileCtrl, ShlObj, ActiveX;

{$R *.dfm}

//=============================================================================
//  SHBrowseForFolder関数で[フォルダの参照]ダイアログを表示
//  旧スタイル
//  ルートフォルダはデスクトップ
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  FolderPidl : PItemIDList;
  BrowseInfo : TBrowseInfo;
  BPathName  : array[0..MAX_PATH-1] of Char;
  AMalloc    : IMalloc;
begin
  //項目識別子解放のためのメモリアロケーションのポインタ取得
  ShGetMalloc(AMalloc);
  FolderPidl := nil;

  FillChar(BrowseInfo, SizeOf(BrowseInfo), #0);
  BrowseInfo.hwndOwner := Handle;
  BrowseInfo.lpfn      := nil;
  BrowseInfo.lpszTitle := PChar('フォルダの指定');
  BrowseInfo.pidlRoot  := nil;
  BrowseInfo.ulFlags   := BIF_RETURNONLYFSDIRS;

  //上の設定に基づきフォルダ参照ダイアログを表示
  try
    FolderPidl := SHBrowseForFolder(BrowseInfo);
    If FolderPidl <> nil then begin
      //項目識別子をパスの文字列BPathNameに変換
      SHGetPathFromIDList(FolderPidl, BPathName);

      MessageBox(Handle, BPathName, '選択フォルダ', MB_ICONINFORMATION);
    end;
  finally
    AMalloc.Free(FolderPidl);
  end;
end;

//=============================================================================
//  SHBrowseForFolder関数で[フォルダの参照]ダイアログを表示
//  新スタイル
//  ルートフォルダはデスクトップ
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  FolderPidl : PItemIDList;
  BrowseInfo : TBrowseInfo;
  BPathName  : array[0..MAX_PATH-1] of Char;
  AMalloc    : IMalloc;
begin
  //項目識別子解放のためのメモリアロケーションのポインタ取得
  ShGetMalloc(AMalloc);
  FolderPidl := nil;

  FillChar(BrowseInfo, SizeOf(BrowseInfo),　#0);
  BrowseInfo.hwndOwner := Handle;
  BrowseInfo.lpfn      := nil;
  BrowseInfo.lpszTitle := PChar('フォルダの指定');
  BrowseInfo.pidlRoot  := nil;
  BrowseInfo.ulFlags   := BIF_RETURNONLYFSDIRS or
                          BIF_NEWDIALOGSTYLE   or
                          BIF_VALIDATE;

  //上の設定に基づきフォルダ参照ダイアログを表示
  try
    FolderPidl := SHBrowseForFolder(BrowseInfo);
    If FolderPidl <> nil then begin
      //項目識別子をパスの文字列BPathNameに変換
      SHGetPathFromIDList(FolderPidl, BPathName);

      MessageBox(Handle, BPathName, '選択フォルダ', MB_ICONINFORMATION);
    end;
  finally
    AMalloc.Free(FolderPidl);
  end;
end;

//=============================================================================
//  SHBrowseForFolder関数で[フォルダの参照]ダイアログを表示
//  ルートフォルダはネットワーク
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  FolderPidl : PItemIDList;
  RootPidl   : PItemIDList;
  BrowseInfo : TBrowseInfo;
  BPathName  : array[0..MAX_PATH-1] of Char;
  AMalloc    : IMalloc;
begin
  //項目識別子解放のためのメモリアロケーションのポインタ取得
  ShGetMalloc(AMalloc);
  FolderPidl := nil;

  //CSIDL_XXXの値を項目識別子に変換
  SHGetSpecialFolderLocation(Handle, CSIDL_NETWORK, RootPidl);

  FillChar(BrowseInfo, SizeOf(BrowseInfo), #0);
  BrowseInfo.hwndOwner := Handle;
  BrowseInfo.lpfn      := nil;
  BrowseInfo.lpszTitle := PChar('フォルダの指定');
  BrowseInfo.pidlRoot  := RootPidl;
  BrowseInfo.ulFlags   := BIF_RETURNONLYFSDIRS or BIF_RETURNFSANCESTORS;

  //上の設定に基づきフォルダ参照ダイアログを表示
  try
    FolderPidl := SHBrowseForFolder(BrowseInfo);
    If FolderPidl <> nil then begin
      //項目識別子をパスの文字列BPathNameに変換
      SHGetPathFromIDList(FolderPidl, BPathName);

      MessageBox(Handle, BPathName, '選択フォルダ', MB_ICONINFORMATION);
    end;
  finally
    AMalloc.Free(FolderPidl);
  end;
end;

//=============================================================================
//  SHBrowseForFolder関数で[フォルダの参照]ダイアログを表示
//  ルートフォルダはプリンタフォルダ
//  新スタイルでプリンタのみを選択可能にする
//=============================================================================
procedure TForm1.Button4Click(Sender: TObject);
var
  FolderPidl : PItemIDList;
  RootPidl   : PItemIDList;
  BrowseInfo : TBrowseInfo;
  BPathName  : array[0..MAX_PATH-1] of Char;
  AMalloc    : IMalloc;
begin
  //項目識別子解放のためのメモリアロケーションのポインタ取得
  ShGetMalloc(AMalloc);
  FolderPidl := nil;

  //CSIDL_XXXの値を項目識別子に変換
  SHGetSpecialFolderLocation(Handle, CSIDL_PRINTERS, RootPidl);

  FillChar(BrowseInfo, SizeOf(BrowseInfo), #0);
  BrowseInfo.hwndOwner := Handle;
  BrowseInfo.lpfn      := nil;
  BrowseInfo.lpszTitle := PChar('フォルダの指定');
  BrowseInfo.pidlRoot  := RootPidl;
  BrowseInfo.ulFlags   := BIF_NEWDIALOGSTYLE or BIF_BROWSEFORPRINTER;

  //上の設定に基づきフォルダ参照ダイアログを表示
  try
    FolderPidl := SHBrowseForFolder(BrowseInfo);
    If FolderPidl <> nil then begin
      //項目識別子をパスの文字列BPathNameに変換
      SHGetPathFromIDList(FolderPidl, BPathName);

      MessageBox(Handle, BPathName, '選択フォルダ', MB_ICONINFORMATION);
    end;
  finally
    AMalloc.Free(FolderPidl);
  end;
end;

end.

unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

uses FileCtrl, ShlObj, ActiveX, KnownFolders;

{$R *.dfm}

//=============================================================================
//  SHBrowseForFolder関数で[フォルダの参照]ダイアログを表示
//  ルートフォルダはライブラリ
//  
//  FOLDERID_Libraries定数の使用にはusesにKnownFoldersが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  FolderPidl : PItemIDList;
  RootPidl   : PItemIDList;
  BrowseInfo : TBrowseInfo;
  BPathName  : array[0..MAX_PATH-1] of Char;
  AMalloc    : IMalloc;
begin
  //項目識別子解放のためのメモリアロケーションのポインタ取得
  ShGetMalloc(AMalloc);
  FolderPidl := nil;

  //TGUIDのFOLDERID_Librariesに相当する項目識別子を取得
  if SHGetKnownFolderIDList(FOLDERID_Libraries, 0, 0, RootPidl) = S_OK then begin

    FillChar(BrowseInfo, SizeOf(BrowseInfo), #0);
    BrowseInfo.hwndOwner := Handle;
    BrowseInfo.lpfn      := nil;
    BrowseInfo.lpszTitle := PChar('フォルダの指定');
    BrowseInfo.pidlRoot  := RootPidl;
    BrowseInfo.ulFlags   := BIF_NEWDIALOGSTYLE or BIF_VALIDATE;

    //上の設定に基づきフォルダ参照ダイアログを表示
    try
      FolderPidl := SHBrowseForFolder(BrowseInfo);
      If FolderPidl <> nil then begin
        //項目識別子をパスの文字列BPathNameに変換
        SHGetPathFromIDList(FolderPidl, BPathName);

        MessageBox(Handle, BPathName, '選択フォルダ', MB_ICONINFORMATION);
      end;
    finally
      AMalloc.Free(FolderPidl);
    end;
  end;
end;

end.

//-----------------------------------------------------------------------------
//  相対項目識別子からフォルダまたはファイル名を求める
//  仮想フォルダはGUID文字列として求まる
//
//  第1引数  対象の項目識別子を取得する際に使用したシェルフォルダオブジェクト
//  第2引数  対象の項目識別子．ShFolder階層下の相対値
//  第3引数  フルパスを取得する場合は，SHGDN_FORPARSING
//           ファイル名だけ取得する場合は，SHGDN_NORMALまたはSHGDN_INFOLDER
//-----------------------------------------------------------------------------
function GetDispNameFromPItemID(ShFolder: IShellFolder; ItemID:
  PItemIDList; Flag: DWORD=SHGDN_NORMAL): String;
var
  StrRet : TStrRet;
begin
  Result := '';
  if ShFolder = nil then exit;
  if ItemID   = nil then exit;

  FillChar(StrRet, SizeOf(StrRet), #0);
  if NOERROR = ShFolder.GetDisplayNameOf(ItemID, Flag, StrRet) then begin
    Result := StrRet.pOleStr;
  end;
end;

//=============================================================================
//  SHBrowseForFolder関数で[フォルダの参照]ダイアログを表示
//  ルートフォルダはライブラリ
//  仮想フォルダの表示名とGUIDのパス名を取得
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  FolderPidl  : PItemIDList;
  RootPidl    : PItemIDList;
  BrowseInfo  : TBrowseInfo;
  pDesktop    : IShellFolder;
  DisplayName : String;
  FolderPath  : String;
  StrText     : String;
  AMalloc     : IMalloc;
begin
  //項目識別子解放のためのメモリアロケーションのポインタ取得
  ShGetMalloc(AMalloc);
  FolderPidl := nil;

  //FOLDERID_Librariesに相当する項目識別子を取得
  if SHGetKnownFolderIDList(FOLDERID_Libraries, 0, 0, RootPidl) = S_OK then begin

    FillChar(BrowseInfo, SizeOf(BrowseInfo), #0);
    BrowseInfo.hwndOwner := Handle;
    BrowseInfo.lpfn      := nil;
    BrowseInfo.lpszTitle := PChar('フォルダの指定');
    BrowseInfo.pidlRoot  := RootPidl;
    BrowseInfo.ulFlags   := BIF_NEWDIALOGSTYLE or BIF_VALIDATE;

    //上の設定に基づきフォルダ参照ダイアログを表示
    try
      FolderPidl := SHBrowseForFolder(BrowseInfo);
      If FolderPidl <> nil then begin

        //[デスクトップ]のシェルフォルダオブジェクトを取得
        SHGetDesktopFolder(pDesktop);

        //取得した項目識別子から表示名とバス名を取得
        DisplayName := GetDispNameFromPItemID(pDesktop, FolderPidl, SHGDN_INFOLDER);
        FolderPath  := GetDispNameFromPItemID(pDesktop, FolderPidl, SHGDN_FORPARSING);
        StrText     := DisplayName + sLineBreak + FolderPath;

        MessageBox(Handle,  PChar(StrText), '選択フォルダ', MB_ICONINFORMATION);
      end;
    finally
      AMalloc.Free(FolderPidl);
    end;
  end;
end;

//=============================================================================
//  仮想フォルダをルートフォルダに指定して[フォルダの参照]ダイアログを表示
//  仮想フォルダをGUIDの文字列で指定する例
//
//  [ライブラリ]をルートフォルダにする
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  RootFolder   : String;
  SelectFolder : String;
begin
  RootFolder := '::{031E4825-7B94-4DC3-B131-E946B44C8DD5}';

  if SelectDirectory('フォルダの指定', RootFolder, SelectFolder) then begin
    MessageBox(Handle, PChar(SelectFolder), '選択フォルダ', MB_ICONINFORMATION);
  end;
end;

//=============================================================================
//  仮想フォルダをルートフォルダに指定して[フォルダの参照]ダイアログを表示
//  仮想フォルダをGUIDの文字列で指定する例
//
//  [ライブラリ]フォルダ下の[ドキュメント]をルートフォルダにする
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  RootFolder   : String;
  SelectFolder : String;
begin
  RootFolder := '::{031E4825-7B94-4DC3-B131-E946B44C8DD5}\Documents.library-ms';

  if SelectDirectory('フォルダの指定', RootFolder, SelectFolder) then begin
    MessageBox(Handle, PChar(SelectFolder), '選択フォルダ', MB_ICONINFORMATION);
  end;
end;

//=============================================================================
//  仮想フォルダの実フルパス名を取得する方法
//  SHGetKnownFolderPath関数を使用
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  pFolderPath : PChar;
  StrText     : String;
begin
  //FOLDERID_Librariesに相当するフルパス名を取得
  if SHGetKnownFolderPath(FOLDERID_Libraries, 0, 0, pFolderPath) = S_OK then begin
    StrText := pFolderPath;
    MessageBox(Handle, PChar(StrText), '実パス名', MB_ICONINFORMATION);
  end;
end;

uses
  {$WARN UNIT_PLATFORM OFF}
  FileCtrl,
  {$WARN UNIT_PLATFORM ON}
  ShlObj,
  ActiveX;