DBR Delphi-Ecke

// Getestet mit D4 unter WinME

// 1. Es wird ein Dialog zur Auswahl eines Ordners geöffnet. Oberster Ordner
// im Dialog ist dabei "DESKTOP" (kann aber auch ein anderer Ordner sein).

uses filectrl; 
 
procedure TForm1.Button4Click(Sender: TObject); 
var s: string; 
begin 
  SelectDirectory('Welcher Ordner soll es sein?', 'Desktop', s); 
  if s = '' then showmessage('Es wurde kein Ordner gewählt') 
  else showmessage(s); 
end;

//---------------------------------------------------------------------------------------------

// 2. Falls ein Anwender seinen "DESKTOP" umbenannt hat, muss man den
//    aktuellen Namen zunächst herausfinden (wenn "DESKTOP" nicht der
//    Startordner sein soll, kann anstelle von CSIDL_DESKTOP auch ein
//    anderer SpecialFolder stehen, wie z.B.: CSIDL_PERSONAL oder
//    CSIDL_PROGRAMS).

uses shlobj, activex; 

function Folder(hnd: THandle; txt: string; flr: integer): string; 
var bi: TBROWSEINFO; 
  pidlPrograms, pidlBrowse: PITEMIDLIST; 
  P: PChar; 
  Malloc: IMalloc; 
begin 
  Result := ''; 
  SHGetMalloc(Malloc); 
  if Malloc = nil then exit; 
  if SHGetSpecialFolderLocation(hnd, flr, pidlPrograms) = 0 
    then begin 
    P := StrAlloc(max_path); 
    bi.hwndOwner := hnd; 
    bi.pidlRoot := pidlPrograms; 
    bi.lpszTitle := PChar(txt); 
    bi.ulFlags := 0; 
    bi.lpfn := nil; 
    bi.lParam := 0; 
    pidlBrowse := SHBrowseForFolder(bi); 
    if SHGetPathFromIDList(pidlBrowse, P) 
      then Result := P; 
    StrDispose(P); 
    Malloc.Free(pidl); 
  end; 
end; 

procedure TForm1.Button7Click(Sender: TObject); 
var s: string; 
begin 
  s := Folder(handle, 'Welcher Ordner soll es sein?', CSIDL_DESKTOP); 
  if s = '' then showmessage('Es wurde kein Ordner gewählt') 
  else showmessage(s); 
end;

//---------------------------------------------------------------------------------------------

// 3. Eine weitere Möglichkeit (nur für "DESKTOP") wäre folgender Code:

uses shlobj; 
 
function FLRDialog(Hnd: THandle; txt: string): string; 
var 
  PID: PItemIDList; 
  BIA: _BrowseInfoA; 
  P: PCHar; 
begin 
  Result := ''; 
  getmem(P, max_path); 
  Zeromemory(@BIA, Sizeof(BIA)); 
  BIA.hwndOwner := Hnd; 
  BIA.lpszTitle := PChar(txt); 
  BIA.ulFlags := BIF_RETURNONLYFSDIRS; 
  PID := SHBrowseForFolder(BIA); 
  if PID <> nil then begin 
    SHGetPathFromIDList(PID, P); 
    result := p; 
    GlobalFreePtr(PID); 
  end; 
  freemem(P); 
end; 
 
procedure TForm1.Button3Click(Sender: TObject); 
var s: string; 
begin 
  s := FLRDialog(handle, 'Welcher Ordner soll es sein?'); 
  if s = '' then showmessage('Es wurde kein Ordner gewählt') 
  else showmessage(s); 
end;

//---------------------------------------------------------------------------------------------

// 4. Mit dem folgenden Code kann der Anwender eine Ordner nicht nur auswählen,
// sondern auch in einem Fenster, Dos-Fenster oder Explorer öffnen lassen.

uses shellapi, filectrl; 
 
type 
  art = (nurAuswahl, ohneAuswahlOeffnen, AuswahlundOeffnen); 
  wo = (imEinzelfenster, imExplorer, imDosFenster, ohneFenster); 
 
function Ordner(start: widestring; ueberschrift: string; wie: art; womit: wo): 
string; 
var p: pchar; 
begin 
  if start <> '' then 
    if ansilastchar(start) <> '\' then start := start + '\'; 
  if wie <> ohneAuswahloeffnen then begin 
    if not selectdirectory(ueberschrift, start, result) then exit; 
    if ansilastchar(result) <> '\' then result := result + '\'; 
  end else result := start; 
  if (wie <> nurAuswahl) and (womit <> ohneFenster) then begin 
    if womit = imDosFenster then 
      shellexecute(application.handle, 'open', 'c:\command.com', nil, 
        pchar(result), sw_show) 
    else begin 
      if womit = imExplorer then p := 'explore' 
      else p := 'open'; 
      shellexecute(application.handle, p, pchar(result), nil, nil, sw_show); 
    end; 
  end; 
end; 
 
// Beispielaufrufe 
 
procedure TForm1.Button5Click(Sender: TObject); 
var s: string; 
begin 
  s := ordner('c:\programme', '', nurAuswahl, ohneFenster); 
  if s = '' then showmessage('abgebrochen') 
  else showmessage(s); 
end; 
 
procedure TForm1.Button6Click(Sender: TObject); 
begin 
  ordner('D:', '', ohneAuswahlOeffnen, imEinzelfenster); 
end; 
 
procedure TForm1.Button8Click(Sender: TObject); 
begin 
  ordner('c:\', 'Welcher Ordner soll im Explorer angezeigt werden?', 
    AuswahlundOeffnen, imExplorer); 
end; 
 
procedure TForm1.Button9Click(Sender: TObject); 
begin 
  ordner('c:\Eigene Dateien', 'Im Dos-Fenster öffnen', AuswahlundOeffnen, 
    imDosFenster); 
end;