The Delphi VCL comes with several overloaded SelectDirectory functions declared in FileCtrl, one of which uses the ShBrowseForFolder Windows API function. It passes a callback function which tries to do the following:
- Position the dialog on the monitor on which the application’s main form is shown.
- Center the dialog on that monitor
- Select the given directory in the tree view.
Unfortunately in Delphi 2007 it fails for 2.5 of these points and even in Delphi 10.1 Berlin only one bug has been fixed:
- Since it fails to take into account that a monitor left or on top of the primary monitor has negative coordinates, the dialog will appear on the primary monitor if the application’s main form is located on such a monitor. This has been fixed in Delphi 10.1 (possibly earlier, I didn’t check)
- Centering the dialog on the monitor fails, at least on both of my computers running Windows 8.1, but I seem to remember that the same problem occurs on several other computers running Windows 7 and XP. This is still the case with Delphi 10.1.
- Selecting the given directory works, kind of, but if the tree view contains many entries, the selected entry will not be visible. You’ll have to scroll down to see it. This is still the case with Delphi 10.1
So, why is that? The main problem is that Delphi tries to change the dialog before it is fully visible. Setting the position fails because of this as well as making the selected directory visible.
My bugfix isn’t pretty, I must admit. It just defers these changes until the dialog is fully visible. This has the disadvantage the the user will see it popping up at the wrong place first before its position is corrected and the selected directory becomes visible.
But here it comes anyway:
First, you need to copy the code of SelectDirectory from FileCtrl, the one with the following signature:
function SelectDirectory(const Caption: string; const Root: WideString; var Directory: string; Options: TSelectDirExtOpts; Parent: TWinControl): Boolean;
In addition you need the function SelectDirCB which is declared immediately above SelectDirectory.
Copy it to a separate unit (or, if you are brave, directly modify FileCtrl).
Above these functions, add the following code (which is based on the existing TSelectDirCallback class declared an implemented in FileCtrl but heavily modified):
uses
Windows,
SysUtils,
FileCtrl,
Controls,
Consts,
ShlObj,
ActiveX,
Dialogs,
Forms,
Classes,
u_dzVclUtils;
// ....
type
TSelectDirCallback = class(TObject)
private
FParent: TWinControl;
FDirectory: string;
FInitialized: Boolean;
FPositioned: Boolean;
protected
function SelectDirCB(Wnd: HWND; uMsg: UINT; lParam, lpData: lParam): Integer;
public
constructor Create(const ADirectory: string; _Parent: TWinControl);
end;
{ TSelectDirCallback }
constructor TSelectDirCallback.Create(const ADirectory: string; _Parent: TWinControl);
begin
inherited Create;
FParent := _Parent;
FDirectory := ADirectory;
FInitialized := False;
FPositioned := False;
end;
function TSelectDirCallback.SelectDirCB(Wnd: HWND; uMsg: UINT; lParam, lpData: lParam): Integer;
procedure SetDialogPosition;
var
Rect: TRect;
Monitor: TMonitor;
ltwh: TRectLTWH;
RefLtwh: TRectLTWH;
frm: TCustomForm;
begin
GetWindowRect(Wnd, Rect);
if Assigned(FParent) then begin
frm := GetParentForm(FParent);
Monitor := Screen.MonitorFromWindow(frm.Handle);
RefLtwh.Assign(frm.BoundsRect);
end else begin
if Assigned(Application.MainForm) then
Monitor := Screen.MonitorFromWindow(Application.MainForm.Handle)
else
Monitor := Screen.MonitorFromWindow(0);
RefLtwh.Assign(Monitor.BoundsRect);
end;
ltwh.Assign(Rect);
ltwh.Left := RefLtwh.Left + RefLtwh.Width div 2 - ltwh.Width div 2;
ltwh.Top := RefLtwh.Top + RefLtwh.Height div 2 - ltwh.Height div 2;
TMonitor_MakeFullyVisible(Monitor, ltwh);
SetWindowPos(Wnd, 0, ltwh.Left, ltwh.Top, ltwh.Width, ltwh.Height, SWP_NOZORDER);
end;
procedure SelectDirectory;
begin
if FDirectory <> '' then begin
// we use PostMessage to asynchronously select the directory
PostMessage(Wnd, BFFM_SETSELECTION, Windows.wParam(True), Windows.lParam(PChar(FDirectory)));
end;
end;
begin
Result := 0;
if uMsg = BFFM_INITIALIZED then begin
FInitialized := True;
// It's too early to set the dialog position.
// That only works once the dialog is visible.
// But we must select the current directory, once here and once again
SelectDirectory;
end else if uMsg = BFFM_VALIDATEFAILED then begin
MessageDlg(Format(SInvalidPath, [PChar(lParam)]), mtError, [mbOK], 0);
Result := 1;
end else if uMsg = BFFM_SELCHANGED then begin
if FInitialized and not FPositioned then begin
FPositioned := True;
SetDialogPosition;
// The first call to SelectDirectory only selects it but does not scrol the dialog
// to make it visible. That's what this second call is for.
SelectDirectory;
end;
end;
end;
Then modify SelectDirectory to pass the additional parameter Parent to the constructor:
// Initialization of the BrowseInfo record is done above
SelectDirCallback := TSelectDirCallback.Create(Directory, Parent);
try
BrowseInfo.lParam := Integer(SelectDirCallback);
The TRectLTWH record as well as the TMonitor_MakeFullyVisible procedure is declared in u_dzVclUtils.
Ok, so, what does this do?
First of all, it does not try to position the dialog when receiving the BFFM_INITIALIZED message. In that state, the dialog isn’t yet visible and apparently cannot be positioned correctly. But it’s still necessary to set the selected directory at this time. My code also sets the FInitialized flag so it knows which of the multiple BFFM_SELCHANGED message to use to do the rest. And that’s actually all there is to it: When handling the first BFFM_SELCHANGED message after FInitialized was set, it sets the dialog position and selects the directory again.
Some details:
Fixing the first bug (not taking the Monitor.Left / .Top coordinates into account is done here:
ltwh.Left := RefLtwh.Left + RefLtwh.Width div 2 - ltwh.Width div 2;
ltwh.Top := RefLtwh.Top + RefLtwh.Height div 2 - ltwh.Height div 2;
Note that RefLtwh is initialized with the Monitor’s Left, Top, Width and Height properties.
Fixing the second bug is also part of that code and it works because the dialog is already visible.
Fixing the third bug involves using
PostMessage(Wnd, BFFM_SETSELECTION, Windows.wParam(True), Windows.lParam(PChar(FDirectory)));
rather than SendMessage and posting this messages twice. Once for selecting the directory and once again to let the dialog scroll so it becomes visible.
In addition to fixing these bugs, this code adds a feature: It tries to centre the dialog on the form passed as parent. No idea why Borland/Codegear/Embarcadero didn’t do that.
You can find this bugfix in my dzlib svn repository on SourceForge
