Entwickler-Ecke
Dateizugriff - ...einen Verzeichnisauswahl-Dialog anzeigen?
Tino - Di 13.05.03 16:42
Titel: ...einen Verzeichnisauswahl-Dialog anzeigen?
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 [
http://msdn.microsoft.com/library/en-us/shellcc/platform/shell/reference/functions/shbrowseforfolder.asp]. 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:
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 FillChar (BrowseInfo, SizeOf (BrowseInfo), 0); With BrowseInfo Do Begin hwndOwner := 0; pszDisplayName := @DisplayName; lpszTitle := PChar (aCaption) ; ulFlags := 0 ; End;
Try pidlResult := SHBrowseForFolder (BrowseInfo); Except BrowseForFolder := False; Exit; End;
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:
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 - Mo 02.02.04 02:32
Titel: ...einen Verzeichnisauswahl-Dialog anzeigen? #3
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 [
http://www.delphiforum.de/viewtopic.php?t=21470] 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.
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;
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:
Delphi-Quelltext
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13:
| uses ShlObj;
|
Beispiel:
Öffnet im Eigene Dateien-Verzeichnisbaum
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.
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;
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:
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.
Christian S. - Sa 08.05.04 22:27
Titel: ...ein FolderBrowser-Dialog mit vorausgewähltem Ordner anz.?
Hallo!
folgender Beitrag ist in diese sehr fortgeschrittene Klasse eingeflossen:
http://www.delphi-forum.de/topic_TFolderBrowser+SHBrowseForFolder_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:
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 if uMsg = BFFM_INITIALIZED then SendMessage(theHandle, BFFM_SETSELECTION, Ord(TRUE), lpData);
result := 0; end;
constructor TFolderBrowser.create; begin self.Fselected := ''; self.caption := 'Bitte Ordner auswählen!'; self.showFiles := False; self.newFolder := False; self.initFolder := ''; end;
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 FillChar (BrowseInfo, SizeOf (BrowseInfo), 0); CoInitialize(nil); With BrowseInfo Do Begin hwndOwner := 0; pszDisplayName := @DisplayName; lpszTitle := PChar (caption) ;
lpfn := @FolderCallBack; lParam := Integer(Pchar(initFolder));
if ShowFiles then ulFlags := ulFlags or BIF_BROWSEINCLUDEFILES;
if NewFolder then ulFlags := ulFlags or BIF_NEWDIALOGSTYLE else ulFlags := ulFlags or BIF_NONEWFOLDERBUTTON; End;
Try pidlResult := SHBrowseForFolder (BrowseInfo); Except result := False; Exit; End;
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:
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 FHandle: THandle; FCaption: string; FShowFiles: Boolean; FNewFolder: Boolean; FInitFolder: string; FSelected: string; public 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 if uMsg = BFFM_INITIALIZED then SendMessage(theHandle, BFFM_SETSELECTION, Ord(TRUE), lpData);
result := 0; 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;
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 FillChar (BrowseInfo, SizeOf (BrowseInfo), 0); CoInitialize(nil); With BrowseInfo Do Begin hwndOwner := 0; pszDisplayName := @DisplayName; lpszTitle := PChar (Fcaption) ;
lpfn := @FolderCallBack; lParam := Integer(Pchar(FinitFolder));
if FShowFiles then ulFlags := ulFlags or BIF_BROWSEINCLUDEFILES;
if FNewFolder then ulFlags := ulFlags or BIF_NEWDIALOGSTYLE else ulFlags := ulFlags or BIF_NONEWFOLDERBUTTON; End;
Try pidlResult := SHBrowseForFolder (BrowseInfo); Except result := False; Exit; End;
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:
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:
| 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;
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:
SHBROWSEFORFOLDER
SHGETPATHFROMIDLIST
Moderiert von jasocul: Beiträge zusammengefasst.
Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2024 by Christian Stelzmann Alle Rechte vorbehalten.
Alle Beiträge stammen von dritten Personen und dürfen geltendes Recht nicht verletzen.
Entwickler-Ecke und die zugehörigen Webseiten distanzieren sich ausdrücklich von Fremdinhalten jeglicher Art!