// Ein Dialog zum Auswählen von Ordnern und bei Bedarf auch von Dateien,
// bei dem ein Startverzeichnis festgelegt werden kann und der in einer
// Statuszeile den Pfad anzeigen kann.

// Getestet mit D4 unter XP / Rs 10.4 unter W11


uses ShlObj;   {Winapi.ShlObj;}
 
function OpenFolderOrFile(Ownerhandle: HWND; Txt, InitDir: PChar; 
  Files, Status: boolean): string; 
var 
  Info: TBrowseInfo; 
  pidl: PItemIDList; 
  Buffer: PChar; 
 
  function BrowseCallbackProc(hwnd: HWND; uMsg: UINT; lParam: Cardinal; 
    lpData: Cardinal): Integer; stdcall; 
   var Pfad: array[0..MAX_PATH] of Char; 
  begin 
    case uMsg of 
      BFFM_INITIALIZED: SendMessage(Hwnd, BFFM_SETSELECTION, 1, 
          Integer(lpData)); 
      BFFM_SELCHANGED: begin 
          SHGetPathFromIDList(PItemIDList(lParam), @Pfad); 
          SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, Longint(@Pfad)); 
        end; 
    end; 
    Result := 0; 
  end; 
 
begin 
  GetMem(Buffer, MAX_PATH); 
  Zeromemory(@Info, SizeOf(TBrowseInfo)); 
  with Info do begin 
    hwndOwner := Ownerhandle; 
    pszDisplayName := Buffer; 
    lpszTitle := Txt; 
    ulFlags := BIF_RETURNONLYFSDIRS; 
    if Files then 
      ulFlags := ulFlags or BIF_BROWSEINCLUDEFILES; 
    if Status then 
      ulFlags := ulFlags or BIF_STATUSTEXT; 
    lpfn := @BrowseCallbackProc; 
    lParam := Integer(InitDir); 
  end; 
  pidl := SHBrowseForFolder(Info); 
  if (pidl <> nil) and SHGetPathFromIDList(pidl, Buffer) 
    then Result := Buffer else Result := ''; 
  FreeMem(Buffer); 
end; 
 

// Beispiel 
procedure TForm1.Button1Click(Sender: TObject); 
var 
  s: string; 
begin 
  s := OpenFolderOrFile(Handle, 'Bitte wählen:', 'C:\Program Files (x86)', 
    True, True); 
  if s <> '' then 
    showmessage(s); 
end;