こんにちは。
標準のSelectDirectoryは、なんか変ですよね。
変な場所にでてくるし、Rootを指定したら、その上は見えなくなってしまうし。
過去ログで見つけた、MoveWindow(Application.Handle...を使っていたのですが、
Rootより上が見えなくなるのは解決できず、何とかならないものかと考えていました。
Delphi-ML54488にぴったりのサンプルがありましたので、
VCLのソースと混ぜ合わせて作ってみました。

function SelectDirectoryEx(const Caption: string; const Root: string;
  out Directory: string; AX, AY: Integer): Boolean;

implementation

uses Math, ShlObj, ActiveX;

function SelectDirectoryEx(const Caption: string; const Root: string;
  out Directory: string; AX, AY: Integer): Boolean;

  type
    PBFFRecord = ^TBFFRecord;

    TBFFRecord = record
      InitDir: PChar;
      X: Integer;
      Y: Integer;
  end;

var
  BFFR:TBFFRecord;
  IDList: PItemIDList;
  BrowseInfo: TBrowseInfo;
  Malloc:IMalloc;
  WindowList: Pointer;
  Buffer: PChar;


  function BrowseFolderProc(hWindow: HWND; uMsg: UINT; lParam: LPARAM;
                          lpData: LPARAM): Integer; stdcall;
  var
    PathName: array[0..MAX_PATH] of Char;
    PBFFR:PBFFRecord;
    r: TRect;
    x, y, cx, cy, w, h: Integer;

  begin
    case uMsg of
      BFFM_INITIALIZED:
      begin
        PBFFR := Pointer(lpData);
        if lstrlen(PBFFR^.InitDir) > 1 then
          SendMessage(hWindow,BFFM_SETSELECTION, 1, Integer(PBFFR^.InitDir));

        cx := GetSystemMetrics(SM_CXSCREEN);
        cy := GetSystemMetrics(SM_CYSCREEN);
        GetWindowRect(hWindow, r);
        w := r.Right - r.Left;
        h := r.Bottom - r.Top;
        x := PBFFR^.X;
        y := PBFFR^.Y;

        if (x = 0) or (y = 0) then
        begin
          x := (cx - w) div 2;
          y := (cy - h) div 2;
        end;

        x := Max(Min(x, cx - w), 0);
        y := Max(Min(y, cy - h), 0);

        SetWindowPos(hWindow, 0, x, y, 0, 0, SWP_NOSIZE or SWP_NOZORDER);
      end;
      BFFM_SELCHANGED:
      begin
        SHGetPathFromIDList(PItemIDList(lParam), @PathName);
        SendMessage(hWindow, BFFM_SETSTATUSTEXT, 0, LongInt(PChar(@PathName)));
      end;
    end;
    Result := 0;
  end;
begin
  Result := False;
  Directory := '';
  BFFR.InitDir := PChar(Root);
  BFFR.X := AX;
  BFFR.Y := AY;
  FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
  if (ShGetMalloc(Malloc) = S_OK) and (Malloc <> nil) then
  begin
    Buffer := Malloc.Alloc(MAX_PATH);
    try
      with BrowseInfo do
      begin
        hwndOwner := Application.Handle;
        pidlRoot := nil;
        pszDisplayName := Buffer;
        lpszTitle := PChar(Caption);
        ulFlags := BIF_STATUSTEXT or BIF_RETURNONLYFSDIRS;
        lpfn := @BrowseFolderProc;
        lParam := Integer(@BFFR);
      end;
      WindowList := DisableTaskWindows(0);
      try
        IDList := ShBrowseForFolder(BrowseInfo);
      finally
        EnableTaskWindows(WindowList);
      end;
      Result :=  IDList <> nil;
      if Result then
      begin
        ShGetPathFromIDList(IDList, Buffer);
        Malloc.Free(IDList);
        Directory := Buffer;
      end;
    finally
      Malloc.Free(Buffer);
    end;
  end;
end;

/////////////////////////////////

使い方。
var
  s: string;
begin
  if SelectDirectoryEx('フォルダを選択してください',
             'C:\Windows', s, 300, 300) then
    Label1.Caption := s;

  if SelectDirectoryEx('画面の真ん中',
             'C:\Windows', s, 0, 0) then
    Label1.Caption := s;




                                     01/02/03(土)  かつぼー(CQU00157)
 


- FDELPHI  MES(16):玉石混淆みんなで作るSample蔵【見本蓄積】 01/02/11 -

Original document by かつぼー        氏 ID:(CQU00157)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。