...einen Verzeichnisauswahl-Dialog anzeigen?

Tino · Beiträge: 9839 Erhaltene Danke: 45 Windows 8.1 Delphi XE4

Die einfachste Möglichkeit einen Verzeichnisauswahl-Dialog anzuzeigen ist die Funktion SelectDirectory aus derUnit FileCtrl.pas. Diese Funktion erzeugt allerdings ein Dialog welcher optisch nicht wie der typische Auswahl-Dialog von Windows aussieht. Aus diesem Grund machen wir uns ein wenig mehr Arbeit und benutzen die Funktion SHBrowseForFolder. Diese wird in der Unit ShlObj.pas importiert (also nicht vergessen die Unit einzubinden).

Die Funktion erwartet einen Parameter vom Typ TBrowseInfo. Dieser beinhaltet Information um den Dialog richtig anzuzeigen.

Hier eine Funktion die den Aufruf von SHBrowseForFolder erledigt:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:

Uses
  ShlObj, ActiveX;

Function BrowseForFolder (aCaption: String; Var aSelected: String): Boolean;

    Procedure FreeItemIDList (Var aPIdL: pItemIDList);
    Var
      ppMalloc: iMalloc;
    Begin
      SHGetMalloc (ppMalloc);
      ppMalloc.Free (aPIdL);
      aPIdL := nil;
      ppMalloc := nil;
    End;

Var
  BrowseInfo: TBrowseInfo;
  pidlResult: PItemIDList;
  DisplayName,
  Path: Array [0..MAX_PATH] Of Char;
Begin
  // BrowseInfo mit Werten füllen
  FillChar (BrowseInfo, SizeOf (BrowseInfo), 0);
  With BrowseInfo Do
    Begin
      hwndOwner := 0;
      pszDisplayName := @DisplayName;
      lpszTitle := PChar (aCaption) ;
      ulFlags := 0 ;
    End;

  // Dialog aufrufen
  Try
    pidlResult := SHBrowseForFolder (BrowseInfo);
  Except
    BrowseForFolder := False;
    Exit;
  End;

  // Prüfen ob ein Verzeichnis ausgewählt wurde
  If pidlResult <> nil Then
    Begin
      SHGetPathFromIDList (pidlResult, Path);
      aSelected := Path;
      FreeItemIDList (pidlResult);

      BrowseForFolder := True;
    End
  Else
    BrowseForFolder := False;
End;

Diese Funktion kann wie folgt aufgerufen werden:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:

procedure TForm1.Button1Click(Sender: TObject);
Var
  Selected: String;
begin
  Selected := '';

  If BrowseForFolder ('Verzeichnis auswählen', Selected) then
    Label1.Caption := Selected
  Else
    Label1.Caption := 'Kein Verzeichnis ausgewählt.';
end;

Moderiert von jasocul: Beiträge zusammengefasst.

Popov

Zwar hat Tino bereits hier ein im ersten gezeigt wie man eine modernes Verzeichnis-Auswahl-Dialogfenster bekommt, ich dann noch zusäzlich wie man das Delphi eigene Verzeichnis-Auswahl-Dialogfenster bekommt, aber hier noch eine dritte Variante (bzw. zwei Versionen davon), die eine verkürzete Tino-Variante ist. Die Version zwei (weiter unten) ist übrigens die einfachere Version.

Version 1:

Die Funktion benötigt zwei Parameter:

eine System-Konstante für eine Systemordner
Beschreibung für die Dialogbox, nicht Titel

Als Ergebnis bekommt man den ausgewählten Pfad.

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:

uses
  ShlObj;

//Verzeichnis-Öffnen-Dialog-Funktion
function SelFolderA(Root: Integer; Caption: string): String;
var
  bi: TBrowseInfo;
  lpBuffer: array[0..MAX_PATH+1] of Char;
  pidlPrograms, pidlBrowse: PItemIDList;
begin
  if (not SUCCEEDED(SHGetSpecialFolderLocation(GetActiveWindow, Root,
    pidlPrograms))) then Exit; 

  with bi do begin
    hwndOwner := GetActiveWindow;
    pidlRoot := pidlPrograms;
    pszDisplayName := lpBuffer;
    lpszTitle := PChar(Caption);
    ulFlags := BIF_RETURNONLYFSDIRS;
    lpfn := nil;
    lParam := 0;
  end;

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

Hier die benötigten Konstanten. Falls die obere Funktion in einer separaten Unit eingebaut wird, die Funktion dann wiederum aus einer weiteren Unit aufgerufen wird, dann muß dort die Unit ShlObj unter Uses eintragen werden:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:

uses
  ShlObj;

{
//Konstanten für System-Ordner
CSIDL_Desktop  für "Desktop"
CSIDL_Controls  für "Systemsteuerung",
CSIDL_Printers  für "Drucker",
CSIDL_Personal  für "Eigene Dateien",
CSIDL_Drives  für "Arbeitsplatz",
CSIDL_Network  für "Netzwerkumgebung".
Weitere Konstanten stehen in der Unit ShlObj
}

Beispiel:

Öffnet im Eigene Dateien-Verzeichnisbaum

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:

procedure TForm1.Button1Click(Sender: TObject);
var
  S: String;
begin
  S := SelFolderA(CSIDL_Personal, 'Bitte Ordner wählen');
  if DirectoryExists(S) then ShowMessage(S);
end;

Version 2:

Diese Version ist besonders einfach, da hier keine System-Konstanten benötigt werden. Hier wird von CSIDL_Desktop Variante ausgegangen, was den typischen Haupt-Explorer-Verzeichnisbaum anzeigt.

Die Funktion benötigt ein Parameter:

Beschreibung für die Dialogbox, nicht Titel

Als Ergebnis bekommt man den ausgewählten Pfad.

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:

uses
  ShlObj;

//Verzeichnis-Öffnen-Dialog-Funktion
function SelFolderB(Caption: string): String;
var
  bi: TBrowseInfo;
  lpBuffer: array[0..MAX_PATH+1] of Char;
  pidlPrograms, pidlBrowse: PItemIDList;
begin
  SHGetSpecialFolderLocation(GetActiveWindow, CSIDL_Desktop, pidlPrograms);

  with bi do begin
    hwndOwner := GetActiveWindow;
    pidlRoot := pidlPrograms;
    pszDisplayName := lpBuffer;
    lpszTitle := PChar(Caption);
    ulFlags := BIF_RETURNONLYFSDIRS;
    lpfn := nil;
    lParam := 0;
  end;

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

Beispiel:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:

procedure TForm1.Button1Click(Sender: TObject);
var
  S: String;
begin
  S := SelFolderB('Bitte Ordner wählen');
  if DirectoryExists(S) then ShowMessage(S);
end;

Hinweis:

Die oberen Funktionen hab ich nicht entwickelt, aber für meine Bedürfnissen abgeändet und vereinfacht. Ich weiß aber nicht wer die Originalfunktion geschrieben hat.
Moderiert von jasocul: Beiträge zusammengefasst.

_________________
Popov

Christian S. · Beiträge: 20451 Erhaltene Danke: 2264 Win 10 C# (VS 2019)

Hallo!

folgender Beitrag ist in diese sehr fortgeschrittene Klasse eingeflossen:
www.delphi-forum.de/...ForFolder_27628.html

Popov hat ja einige Verzeichnisauwahl-Dialoge veröffentlicht und auch Tino hat eine Variante vorgestellt. Die Varianten, welche den "neuen" Auwahldialog von Windows verwenden, hatten jedoch alle den Nachteil, dass man nicht angeben konnte, welcher Ordner am Anfang ausgewählt ist. Dieses Problem habe ich mit Motzi's Hilfe allerdings gelöst und Tino's Variante erweitert. Anschließend habe ich noch die Änderungen, die Luckie weiter unten gepostet hat, eingebaut. Hier das Ergebnis:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:

uses
  ShlObj, ActiveX, Windows;

type
  TFolderBrowser = class
  private
    Fselected : String;
  public
    caption : String;
    showFiles : Boolean;
    newFolder : Boolean;
    initFolder : String;

    constructor create;

    function execute : Boolean;

    property selected : String read Fselected;

  end;


implementation


function FolderCallBack (theHandle: HWND; uMsg: UINT; lParam: lParam; lpData : lParam): lresult; stdcall;
begin
  //Dialog wurde initialisiert
  if uMsg = BFFM_INITIALIZED then
    //Ordner auswählen
    SendMessage(theHandle, BFFM_SETSELECTION, Ord(TRUE), lpData);

  result := 0; //von Luckie hinzugefügt, hatte ich vergessen (oops)
end;


constructor TFolderBrowser.create;
begin
  self.Fselected := '';
  self.caption := 'Bitte Ordner auswählen!';
  self.showFiles := False;
  self.newFolder := False;
  self.initFolder := '';
end;

//Original:        Tino in den Delphi-Forum FAQs
//Modifiziert von: Christian "Peter Lustig" Stelzmann
// Luckie: Bug ("neuer Ordner" wird immer angezeigt) gefixed
function TFolderBrowser.execute: Boolean;
    Procedure FreeItemIDList (Var aPIdL: pItemIDList);
    Var
      ppMalloc: iMalloc;
    Begin
      SHGetMalloc (ppMalloc);
      ppMalloc.Free (aPIdL);
      aPIdL := nil;
      ppMalloc := nil;
    End;

const
  BIF_NEWDIALOGSTYLE = $40;
  BIF_NONEWFOLDERBUTTON = $200;

Var
  BrowseInfo: TBrowseInfo;
  pidlResult: PItemIDList;
  DisplayName,
  Path: Array [0..MAX_PATH+1] Of Char;
begin
  // BrowseInfo mit Werten füllen
  FillChar (BrowseInfo, SizeOf (BrowseInfo), 0);
  CoInitialize(nil);
  With BrowseInfo Do
  Begin
    hwndOwner := 0;
    pszDisplayName := @DisplayName;
    lpszTitle := PChar (caption) ;

    //Callback-Funktion zur Auswahl des Startverzeichnisses verwenden und ...
    lpfn := @FolderCallBack;
    //... das entsprechende Verzeichnis als lParam verwenden.
    lParam := Integer(Pchar(initFolder));

   // Luckie - BIF_USENEWUI sorgt dafür dass besagter Button immer angezeigt wird,
   //          egal, ob BIF_BROWSEINCLUDEFILES gesetzt wird oder nicht, daher rausgenommen
   if ShowFiles then
      ulFlags := ulFlags or BIF_BROWSEINCLUDEFILES;

    //Button zum Erstellen neuer Ordner anzeigen?
    // Luckie - ergänzt / geändert
    // PL - nochmals geändert
    if NewFolder then
      ulFlags := ulFlags or BIF_NEWDIALOGSTYLE
    else
      ulFlags := ulFlags or BIF_NONEWFOLDERBUTTON;
  End;

  // Dialog aufrufen
  Try
    pidlResult := SHBrowseForFolder (BrowseInfo);
  Except
    result := False;
    Exit;
  End;

  // Prüfen ob ein Verzeichnis ausgewählt wurde
  If pidlResult <> nil Then
  Begin
    SHGetPathFromIDList (pidlResult, Path);
    FSelected := Path;
    FreeItemIDList (pidlResult);

    Result := True;
  End Else Result := False;
end;

Im OOP-Sinne wohl etwas korrekter ist diese - von Luckie vorgeschlagene - Art der Implementierung:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:

uses
  ShlObj, ActiveX, Windows;

type
  TFolderBrowser = class
  private
    // Luckie
    // alles private gemacht, geht niemanden was an da nachträglicher Zugriff
    // sinnlos
    FHandle: THandle;
    FCaption: string;
    FShowFiles: Boolean;
    FNewFolder: Boolean;
    FInitFolder: string;
    FSelected: string;
  public
    // im Konstruktor gleich alles initialisieren (ist geschmackssache)
    constructor create(Handle: THandle; const Caption: string; const InitFolder: string = '';
      ShowFiles: Boolean = False; NewFolder: Boolean = False);
    function execute: Boolean;
    property SelFolder: string read FSelected;
  end;


implementation


function FolderCallBack (theHandle: HWND; uMsg: UINT; lParam: lParam; lpData : lParam): lresult; stdcall;
begin
  //Dialog wurde initialisiert
  if uMsg = BFFM_INITIALIZED then
    //Ordner auswählen
    SendMessage(theHandle, BFFM_SETSELECTION, Ord(TRUE), lpData);

  result := 0; //von Luckie hinzugefügt, hatte ich vergessen (oops)
end;


constructor TFolderBrowser.create(Handle: THandle; const Caption: string; const InitFolder: string
  = ''; ShowFiles: Boolean = False; NewFolder: Boolean = False);
begin
  FHandle := Handle;
  FCaption := Caption;
  FInitFolder := InitFolder;
  FShowFiles := ShowFiles;
  FNewFolder := NewFolder;
end;

//Original:        Tino in den Delphi-Forum FAQs
//Modifiziert von: Christian "Peter Lustig" Stelzmann
// Luckie: Bug ("neuer Ordner" wird immer angezeigt) gefixed
function TFolderBrowser.execute: Boolean;
    Procedure FreeItemIDList (Var aPIdL: pItemIDList);
    Var
      ppMalloc: iMalloc;
    Begin
      SHGetMalloc (ppMalloc);
      ppMalloc.Free (aPIdL);
      aPIdL := nil;
      ppMalloc := nil;
    End;

const
  BIF_NEWDIALOGSTYLE = $40;
  BIF_NONEWFOLDERBUTTON = $200;

Var
  BrowseInfo: TBrowseInfo;
  pidlResult: PItemIDList;
  DisplayName,
  Path: Array [0..MAX_PATH+1] Of Char;
begin
  // BrowseInfo mit Werten füllen
  FillChar (BrowseInfo, SizeOf (BrowseInfo), 0);
  CoInitialize(nil);
  With BrowseInfo Do
  Begin
    hwndOwner := 0;
    pszDisplayName := @DisplayName;
    lpszTitle := PChar (Fcaption) ;

    //Callback-Funktion zur Auswahl des Startverzeichnisses verwenden und ...
    lpfn := @FolderCallBack;
    //... das entsprechende Verzeichnis als lParam verwenden.
    lParam := Integer(Pchar(FinitFolder));

   // Luckie - BIF_USENEWUI sorgt dafür dass besagter Button immer angezeigt wird,
   //          egal, ob BIF_BROWSEINCLUDEFILES gesetzt wird oder nicht, daher rausgenommen
   if FShowFiles then
      ulFlags := ulFlags or BIF_BROWSEINCLUDEFILES;

    //Button zum Erstellen neuer Ordner anzeigen?
    // Luckie - ergänzt / geändert
    // PL - nochmals geändert
    if FNewFolder then
      ulFlags := ulFlags or BIF_NEWDIALOGSTYLE
    else
      ulFlags := ulFlags or BIF_NONEWFOLDERBUTTON;
  End;

  // Dialog aufrufen
  Try
    pidlResult := SHBrowseForFolder (BrowseInfo);
  Except
    result := False;
    Exit;
  End;

  // Prüfen ob ein Verzeichnis ausgewählt wurde
  If pidlResult <> nil Then
  Begin
    SHGetPathFromIDList (pidlResult, Path);
    FSelected := Path;
    FreeItemIDList (pidlResult);

    Result := True;
  End Else Result := False;
end;

Die beiden Varianten werden so aufgerufen:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:

//Variante 1:
procedure TForm1.Button1Click(Sender: TObject);
var fb : TFolderBrowser;
begin
  fb := TFolderBrowser.Create;
  try
    fb.showFiles := True;
    fb.newFolder := True;
    fb.initFolder := 'c:\vorauswahl\';
    fb.caption := 'Bitte wählen Sie einen Ordner aus!';
    if fb.execute then ShowMessage(fb.selected);
  finally
    fb.Free;
  end;
end;

//Variante 2:
procedure TForm1.Button2Click(Sender: TObject);
var
  bff: TFolderBrowser;
begin
  bff := TFolderBrowser.create(Handle, 'Kuckuck, alle ihr Ornder. Ja wo seit ihr denn?', 'd:\Eigene Bilder', False, True);
  try
    if bff.execute then
      ShowMessage(bff.SelFolder);
  finally
    FreeAndNil(bff);
  end;
end;

Hoffe, jemand kann es gebrauchen!

Vielen Dank an Luckie für die Ergänzungen!

Links:
Suche im MSDN

SHBROWSEFORFOLDER
Suche im MSDN

SHGETPATHFROMIDLIST
Moderiert von jasocul: Beiträge zusammengefasst.

_________________
Zwei Worte werden Dir im Leben viele Türen öffnen - "ziehen" und "drücken".

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme