SelectDirectory

[KodeZwerg]

SelDir() Update

Delphi-Quellcode:

function SelDir ( StartPath : String; var SelectedDir : String ) : Boolean;
var
 tmp : TArray<string>;
begin
  Result := False;
  if Win32MajorVersion >= 6 then
  with TFileOpenDialog.Create(nil) do
    try
      Title := 'Select Directory';
      Options := [fdoPickFolders, fdoPathMustExist, fdoForceFileSystem];
      OkButtonLabel := 'Select';
      DefaultFolder := StartPath;
      FileName := StartPath;
      if Execute then
      begin
        SelectedDir := FileName;
        Result := True;
      end;
    finally
      Free;
    end
    else
//  Mögliche Options: sdHidePinnedPlaces, sdNoDereferenceLinks, sdForceShowHidden, sdAllowMultiselect
     if SelectDirectory(StartPath, tmp, [sdForceShowHidden], 'Select Directory', 'Foldername:', 'Select')
// BACKUP - hier noch der Aufruf für den kleinen Dialog
//  Mögliche Options: sdNewFolder, sdShowEdit, sdShowShares, sdNewUI, sdShowFiles, sdValidateDir
//  mit Option sdShowFiles wird aus dem auch ein Datei-Selektor
//    if SelectDirectory('Select Directory', ExtractFileDrive(StartPath), StartPath,
//                       [sdNewFolder, sdShowEdit, sdShowShares, sdNewUI, sdValidateDir])
     then begin
       SelectedDir := tmp[0]; // Achtung, hier wird nur der erste Eintrag genommen! Also so nicht "sdAllowMultiselect" fähig
//       SelectedDir := StartPath; //  BACKUP - für den alten Dialog
       Result := True;
     end;
end;


// Beispiel Aufruf:
procedure TForm2.Button1Click(Sender: TObject);
var
  s : String;
begin
 if SelDir('C:\Tools\',S) then ShowMessage(s);
end;

Dank gilt himitsu für's Zeit nehmen und Erklären und das bei mir endlich der Groschen gefallen ist warum ich's Anfang nicht hinbekam, es gibt zwei Unterschiedliche Option-Sets, muss man auch erstmal draufkommen

Nun sehen Dialoge unter XP und Vista sogut wie gleich aus, beide Verhalten sich relativ identisch.

[Walter Landwehr]

Das sieht zwar sehr schön aus, aber mir fehlen immer noch die verbundenen Laufwerke. (siehe Anhang) Für den Anwender ist es einfacher, wenn diese sichtbar sind, als über das Netzwerk diese zu suchen was die meisten nicht mal verstehen.
Gibt's da noch einen Trick?

Ansonsten wirklich super, vielen Dank schon mal.

[KodeZwerg]

Zitat von Walter Landwehr:

mir fehlen immer noch die verbundenen Laufwerke

Das verstehe ich gerade nicht, im Bild sind doch Netzlaufwerke abgebildet?

[Walter Landwehr]

Sorry das Bild kommt von dem Windows Explorer. Hier das Bild von TFileOpenDialog.

[Walter Landwehr]

Es geht wenn man mit net use die Laufwerke zuweist.

[KodeZwerg]

Delphi-Quellcode:

function SelDir ( StartPath : String; var SelectedDir : String ) : Boolean;
begin
  Result := False;
  with TFileOpenDialog.Create(nil) do
    try
      Title := 'Select Directory';
      Options := [fdoPickFolders, fdoPathMustExist, fdoAllNonStorageItems, fdoShareAware, fdoForceShowHidden, fdoDefaultNoMiniMode];
      OkButtonLabel := 'Select';
      DefaultFolder := StartPath;
      FileName := StartPath;
      if Execute then
      begin
        SelectedDir := FileName;
        Result := True;
      end;
    finally
      Free;
    end
end;

Nur ein Versuch, hier habe ich andere Optionen gewählt die Eigentlich auch Netzlaufwerke Anzeigen sollte.
Bitte einmal Testen, Danke.
Ps: Hier ist der XP Dialog komplett weg.

Nachteil: Es werden dummerweise auch Archive angezeigt

edit
hab diese Überbleibsel entfernt

Code:

var tmp : TArray<string>;

[Walter Landwehr]

Ja das funktioniert auch. Danke für Deine Hilfe.

[KodeZwerg]

Das freut mich wenn alles nun klappt!
Da leider auch, zumindest bei mir, auch Archive angezeigt werden wäre da eventuell noch ein "ExtractFilePath()" sinnvoll.
Nicht das Dein Programm Versucht eine Datei als Ordner zu benutzen.

[KodeZwerg]

Delphi-Quellcode:

function SelDir ( StartPath : String; var SelectedDir : String ) : Boolean;
begin
  Result := False;
  with TFileOpenDialog.Create(nil) do
    try
      Title := 'Select Directory';
      Options := [fdoPickFolders, fdoPathMustExist, fdoAllNonStorageItems, fdoShareAware, fdoForceShowHidden, fdoDefaultNoMiniMode];
      OkButtonLabel := 'Select';
      DefaultFolder := StartPath;
      FileName := StartPath;
      if Execute then
      begin
        if FileExists(FileName) then SelectedDir := ExtractFilePath(FileName) else SelectedDir := FileName;
        Result := True;
      end;
    finally
      Free;
    end
end;

So wärst Du auf der sicheren Seite, falls User eine .CAB Datei wählt, wird dessen Verzeichniss genommen anstelle des Archivnamens.

[Walter Landwehr]

Danke habe ich umgesetzt.