On Vista and up you can show a more modern looking dialog using var OpenDialog: TFileOpenDialog; SelectedFolder: string; ..... OpenDialog := TFileOpenDialog.Create(MainForm); try OpenDialog.Options := OpenDialog.Options + [fdoPickFolders]; if not OpenDialog.Execute then Abort; SelectedFolder := OpenDialog.FileName; finally OpenDialog.Free; end; if SelectedFolder[ Length( SelectedFolder ) ] <> '\' then SelectedFolder := SelectedFolder + '\';
uses FileCtrl; const SELDIRHELP = 1000; procedure TForm1.Button1Click(Sender: TObject); var Dir: string; begin Dir := 'C:\Windows'; if FileCtrl.SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt],SELDIRHELP) then Label1.Caption := Dir; end; Selecting a directory with TOpenDialog
ust found the code below that seems to work fine in XP and Vista, Win7. It provides a UI for a user to select a directory. It uses TOpenDialog, but sends it a few messages to clean up the appearance for the purposes of selecting a directory. After suffering from the limited capabilities provided by Windows itself, it's a pleasure to be able to give my users a familiar UI where they can browse and select a folder comfortably. I'd been looking for something like this for a long time so thought I'd post it here so others can benefit from it. Here's what it looks like in Win 7: function GimmeDir(var Dir: string): boolean; var OpenDialog: TOpenDialog; OpenDir: TOpenDir; begin //The standard dialog... OpenDialog:= TOpenDialog.Create(nil); //Objetc that holds the OnShow code to hide controls OpenDir:= TOpenDir.create; try //Conect both components... OpenDir.Dialog:= OpenDialog; OpenDialog.OnShow:= OpenDir.HideControls; //Configure it so only folders are shown (and file without extension!)... OpenDialog.FileName:= '*.'; OpenDialog.Filter:= '*.'; OpenDialog.Title:= 'Chose a folder'; //No need to check file existis! OpenDialog.Options:= OpenDialog.Options + [ofNoValidate]; //Initial folder... OpenDialog.InitialDir:= Dir; //Ask user... if OpenDialog.Execute then begin Dir:= ExtractFilePath(OpenDialog.FileName); result:= true; end else begin result:= false; end; finally //Clean up... OpenDir.Free; OpenDialog.Free; end; end;
|
2023-10-27
2022-08-15
2022-08-17
2022-09-23
2022-08-13
请发表评论