Dialog, um einen Pfad auszuwählen

[Matze]

Hi!

Ich bin hier des Öfteren auf die Frage gestoßen, wie man mittels eines Dialogs nur einen Ordner, und keine Datei auswählen kann.

Es gibt da 2 Möglichkeiten:

1. Möglichkeit [VCL]

Delphi-Quellcode:

uses FileCtrl; 

... 
procedure TForm1.Button1Click(Sender: TObject); 
var Pfad: string; 
begin 
  SelectDirectory('Ordner auswählen', '' ,Pfad); 
end;

Hier wird der Pfad der String-Variable Pfad zugewisen, somit kann man leicht mit dieser Pfadangabe arbeiten.


2. Möglichkeit [NonVCL]

Diese hat Luckie hier veröffentlicht.

Delphi-Quellcode:

uses shlobj; 

...

function TFrmMain.OpenFolder(root: Integer; Caption: string): string; //Verzeichnis-Öffnen-Dialog-Funktion 
var 
  bi: TBrowseInfo; 
  lpBuffer: PChar; 
  pidlPrograms, pidlBrowse: PItemIDList; 
begin 
  if (not SUCCEEDED(SHGetSpecialFolderLocation(GetActiveWindow, root, 
    pidlPrograms))) then 
    exit; 
  lpBuffer := StrAlloc(MAX_PATH); 
  bi.hwndOwner := GetActiveWindow; 
  bi.pidlRoot := pidlPrograms; 
  bi.pszDisplayName := lpBuffer; 
  bi.lpszTitle := PChar(Caption); 
  bi.ulFlags := BIF_RETURNONLYFSDIRS; 
  bi.lpfn := nil; 
  bi.lParam := 0; 

  pidlBrowse := SHBrowseForFolder(bi); 
  if (pidlBrowse <> nil) then 
    if SHGetPathFromIDList(pidlBrowse, lpBuffer) then 
      Result := lpBuffer; 
  StrDispose(lpBuffer); 
end; 

// Beispielaufruf
procedure TfrmMain.cmdOpenClick(Sender: TObject); 
begin 
  txtPath.Caption := OpenFolder(CSIDL_DRIVES, 'Verzeichnis wählen'); //Übergabe des gewählten Verzeichnisses 
end;

3. Möglichkeit (Erweiterung der 2. Möglichkeit) [NonVCL]

Luckies Code wurde von turboPASCAL erweitert:

Delphi-Quellcode:

uses ShlObj;

//  Erweiterte Verzeichnis-Öffnen-Dialog-Funktion
//  Caption: Optionaler Subtitel
//  DefPath: Vorauswahl des Verzeichnises
//  Result: Verzeichnis als String
function OpenFolder(Caption, DefPath: string): string;
var
  bi: TBrowseInfo;
  lpBuffer: PChar;
  pidlPrograms, pidlBrowse: PItemIDList;

  function BrowseCallbackProc(hwnd: HWND; uMsg: UINT; lParam: Cardinal;
    lpData: Cardinal): Integer; stdcall;
  var
    PathName: array[0..MAX_PATH] of Char;
  begin
    case uMsg of
      BFFM_INITIALIZED:
        SendMessage(Hwnd, BFFM_SETSELECTION, Ord(True), Integer(lpData));
      BFFM_SELCHANGED:
        begin
          SHGetPathFromIDList(PItemIDList(lParam), @PathName);
          SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, Longint(PChar(@PathName)));
        end;
    end;
    Result := 0;
  end;

begin
  Result := '';
  if (not SUCCEEDED(SHGetSpecialFolderLocation(GetActiveWindow, CSIDL_DRIVES,
    pidlPrograms))) then exit;

  GetMem(lpBuffer, MAX_PATH);

  FillChar(BI, SizeOf(BrowseInfo), 0);
  bi.hwndOwner := GetActiveWindow;
  bi.pidlRoot := pidlPrograms;
  bi.pszDisplayName := lpBuffer;
  bi.lpszTitle := PChar(Caption);
  bi.ulFlags := BIF_RETURNONLYFSDIRS or BIF_STATUSTEXT;
  bi.lpfn := @BrowseCallbackProc;
  bi.lParam := Integer(PChar(DefPath));

  pidlBrowse := SHBrowseForFolder(bi);
  if (pidlBrowse <> nil) then
    if SHGetPathFromIDList(pidlBrowse, lpBuffer) then
      Result := String(lpBuffer);

  if (lpBuffer <> nil) then FreeMem(lpBuffer);
end;

Hierbei wird ein Dialog geöffnet, bei dem das ausgewählte Verzeichnis im oberen Teil des Dialoges angezeigt wird. Eine Vorauswahl des Verzeichnisnamens ist möglich.

Delphi-Quellcode:

// Beispielaufruf
procedure Test;
var 
  Dir: string;
begin
  Dir := OpenFolder('Bitte Verzeichnis wählen:', 'c:\');

  if Dir <> '' then  MessageBox(0, PChar(Dir), 'Info', MB_OK)
    else MessageBox(0, 'Keine Auswahl (Abbruch durch Benutzer).', 'Info', MB_OK);
end;

Sichbegriffe: Dialog