フォルダ選択ダイアログってありますか？ (ID：5442)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

こんなでしょうか？
違ったらすみません。

type
  TForm1 = class(TObject)
  private
    function OpenFolderDialog(var sPath:string):boolean;
  public
end;
  function BrowseCallbackProc(hWnd: HWND; uMsg: UINT; lParam: LPARAM; lpData: LPARAM): integer; stdcall; export;

function BrowseCallbackProc(hWnd:HWND; uMsg:UINT; lParam,lpData: lParam):integer;
var
  sPathNameAry: array[0..MAX_PATH] of char;
begin
  if (uMsg = BFFM_INITIALIZED) then begin
    SendMessage(hwnd, BFFM_SETSELECTION, 1, LongInt(lpData));
  end
  else if (uMsg = BFFM_SELCHANGED) then begin
    SHGetPathFromIDList(PItemIDList(lParam), sPathNameAry);
    SendMessage(hWnd, BFFM_SETSTATUSTEXT, 0, LongInt(@sPathNameAry));
  end;
  Result:=0;
end;

function TForm1.OpenFolderDialog(var sPath:string):boolean;
var
  mMalloc   : IMalloc;
  tBrowsInfo: TBrowseInfo;
  sDispPath : array[0..MAX_PATH] of char;
  pIdList   : PItemIdList;
  pBuffer   : Pchar;
  sDirPath  : Pchar;
  bRet      : boolean;
begin
  bRet := False;
  if Succeeded(SHGetMalloc(mMalloc)) then begin
    //選択したフォルダ
    sDirPath := Pchar(sPath);
    //BrowseInfo構造体を初期化
    with tBrowsInfo do begin
      hwndOwner      := GetActiveWindow;
      pidlRoot       := nil;
      pszDisplayName := sDispPath;
      lpszTitle      := 'フォルダを選択してください。';
      ulFlags        := BIF_RETURNONLYFSDIRS or BIF_STATUSTEXT;
      lpfn           := @BrowseCallbackProc;
      lParam         := LongInt(sDirPath);
      iImage         := 0;
    end;

pIdList := SHBrowseForFolder(tBrowsInfo);
    if (pIdList <> nil) then begin
      pBuffer := mMalloc.Alloc(MAX_PATH);
      try
        SHGetPathFromIDList(pIdList, pBuffer);
        if DirectoryExists(string(pBuffer)) then begin
          sPath := string(pBuffer);
          bRet := True;
        end;
      finally
        mMalloc.Free(pBuffer);
      end;
      mMalloc.Free(pIdList);
    end;
  end;
  Result := bRet;
end;

←解決時は質問者本人がここをチェックしてください。

戻る