GExperts 1.38 experimental twm 2016-05-07

 Delphi, GExperts  Comments Off on GExperts 1.38 experimental twm 2016-05-07
May 072016
 

This is a test release before Erik is going to do an official 1.39 release. Please report any bugs you may find (preferentially in the GExperts community on Google+ or the bug tracker on SourceForge)

In contrast to my previous releases there are now installers for each Delphi version. These installers should install everything that is necessary, including the files for the Code Formatter.

GExperts-Configuration-Editor-Experts

Here are the links:

 Posted by on 2016-05-07 at 13:02

The ultimate bugfix for SelectDirectory

 Delphi  Comments Off on The ultimate bugfix for SelectDirectory
May 052016
 

OK, here it comes, the ultimate bugfix for the FileCtrl.SelectDirectory function. 😉

I blogged about it before: The SelectDirectory function in Delphi’s FileCtrl unit has several bugs. My first approach on fixing these, while working, was ugly because the user could see that the dialog position changed after it was shown initially at a different position. My initial guess why the code in FileCtrl failed to set the position correctly was wrong. It’s not because the dialog is not yet visible, but because its size is being changed later in the initialization process so the size used to calculate its position centered on the monitor was wrong.

My bugfix works like this:

  • During the initialization subclass the window of the dialog by setting a new WindowProc function.
  • Wait for the first WM_SIZE message.
  • Now, that the dialog has its final size, position it
  • Un-subclass the window, we don’t need the WindowProc any more

But there is more:

Since the caller passed a Parent to SelectDirectory, why not use that parameter? The user expects modal dialogs to pop up on top of the window he is currently using, so why not position the dialog centered on the Parent rather than the monitor? To do that correctly we also must position it so that it is fully visible on a particular monitor. Nobody wants a dialog crossing monitor borders or being partially obscured by the task bar. For that I have added some overloaded TMonitor_MakeVisible procedures to u_dzVclUtils and call one of them after centering the dialog on the parent.

Of course, the bug of the given directory not being visible, which was already fixed in my first try, is still fixed.

Here is the code:

///<summary>
/// Fixes the SelectDirectory function of Delphi 2007 (not sure whether it needs fixing
/// in later versions)</summary>
unit u_dzSelectDirectoryFix;

interface

uses
  Windows,
  SysUtils,
  FileCtrl,
  Controls;

///<summary>
/// Bugixed version of the FilCtrl SelectDirectory function with identical parameters
/// The following bugs have been fixed:
/// 1. Positioning the dialog works for all tested monitor combinations. This means
///    not only that the correct monitor is being selected (which is already fixed
///    Delphi 10.1 (and possibly earlier) but also that it is correctly centered
///    on that monitor.
/// 2. The given directory is not only selected but the tree view is also scrolled
///    to make the entry visible.
/// In addition to that, if passing a Parent parameter <> nil, the dialog will be
/// centered on that parent (or the form the parent belongs to), taking the monitor
/// work area into account. </summary>
function SelectDirectory(const Caption: string; const Root: WideString;
  var Directory: string; Options: TSelectDirExtOpts = [sdNewUI]; Parent: TWinControl = nil): Boolean;

///<summary>
/// Same as SelectDirectory above but with a different name so it can be called explicitly rather
/// than relying on the order of units in the uses clause. </summary>
function dzSelectDirectory(const Caption: string; const Root: WideString;
  var Directory: string; Options: TSelectDirExtOpts = [sdNewUI]; Parent: TWinControl = nil): Boolean;

implementation

uses
  Consts,
  ShlObj,
  ActiveX,
  Dialogs,
  Forms,
  Messages,
  Classes,
  u_dzVclUtils;

type
  TSelectDirCallback = class(TObject)
  private
    FWndProcInstanceStub: Pointer;
    FWndProcPrevious: TFNWndProc;
    FWnd: HWND;
    FParent: TWinControl;
    FDirectory: string;
    FInitialized: Boolean;
    FPositioned: Boolean;
    procedure WndProcSubClassed(var _Msg: TMessage);
    procedure SetDialogPosition;
    procedure SubClass(_Wnd: HWND);
    procedure UnsubClass;
  protected
    function SelectDirCB(_Wnd: HWND; _uMsg: UINT; _lParam, _lpData: lParam): Integer;
  public
    constructor Create(const _Directory: string; _Parent: TWinControl);
  end;

{ TSelectDirCallback }

constructor TSelectDirCallback.Create(const _Directory: string; _Parent: TWinControl);
begin
  inherited Create;
  FParent := _Parent;
  FDirectory := _Directory;
end;

// subclass the given window by replacing its WindowProc

procedure TSelectDirCallback.SubClass(_Wnd: HWND);
begin
  if FWndProcPrevious <> nil then
    Exit;
  FWnd := _Wnd;
  FWndProcPrevious := TFNWndProc(GetWindowLong(_Wnd, GWL_WNDPROC));
  FWndProcInstanceStub := MakeObjectInstance(WndProcSubClassed);
  SetWindowlong(_Wnd, GWL_WNDPROC, NativeInt(FWndProcInstanceStub));
end;

// un-subclass the window by restoring the previous WindowProc

procedure TSelectDirCallback.UnsubClass;
begin
  if FWndProcPrevious <> nil then begin
    SetWindowlong(FWnd, GWL_WNDPROC, NativeInt(FWndProcPrevious));
    FreeObjectInstance(FWndProcInstanceStub);
    FWndProcPrevious := nil;
    FWndProcInstanceStub := nil;
  end;
end;

// The WindowsProc method set by sublcassing the window.
// Waits for the first WM_SIZE message, sets the dialog position
// and un-subclasses the window.

procedure TSelectDirCallback.WndProcSubClassed(var _Msg: TMessage);
begin
  if (_Msg.Msg = WM_SIZE) then begin
    SetDialogPosition;
    _Msg.Result := CallWindowProc(FWndProcPrevious, FWnd, _Msg.Msg, _Msg.WParam, _Msg.lParam);
    UnsubClass;
  end;
  _Msg.Result := CallWindowProc(FWndProcPrevious, FWnd, _Msg.Msg, _Msg.WParam, _Msg.lParam);
end;

procedure TSelectDirCallback.SetDialogPosition;
var
  Rect: TRect;
  Monitor: TMonitor;
  ltwh: TRectLTWH;
  RefLtwh: TRectLTWH;
  frm: TCustomForm;
begin
  GetWindowRect(FWnd, Rect);
  if Assigned(FParent) then begin
    // this is new: Center on the parent form if a parent was given
    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(FWnd, 0, ltwh.Left, ltwh.Top, 0, 0, SWP_NOZORDER or SWP_NOSIZE);
end;

function TSelectDirCallback.SelectDirCB(_Wnd: HWND; _uMsg: UINT; _lParam, _lpData: lParam): Integer;

  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
    // Subclass the window to catch the WM_SIZE message when it is automatically being resized
    // later in the initialization process. Only then it is possible to get the final size
    // and position it correctly.
    SubClass(_Wnd);
    FInitialized := True;
    // Selecting the directory here only selects the entry but does not necessarily make
    // it visible. So we set it here and again further below.
    SelectDirectory;
  end else if (_uMsg = BFFM_VALIDATEFAILEDW) or (_uMsg = BFFM_VALIDATEFAILEDA) then begin
    // default code copied from FileCtrl
    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;
      // The first call to SelectDirectory only selects it but does not scroll the tree view
      // to make it visible. That's what this second call is for.
      SelectDirectory;
    end;
  end;
end;

// This is the actual callback function passed to the Windows API. lpData is the TSelectDirCallback
// object we created. Here we simply call its SelectDirCB method.

function SelectDirCB(Wnd: HWND; uMsg: UINT; lParam, lpData: lParam): Integer stdcall;
begin
  Result := TSelectDirCallback(lpData).SelectDirCB(Wnd, uMsg, lParam, lpData);
end;

function SelectDirectory(const Caption: string; const Root: WideString;
  var Directory: string; Options: TSelectDirExtOpts = [sdNewUI]; Parent: TWinControl = nil): Boolean;
begin
  Result := dzSelectDirectory(Caption, Root, Directory, Options, Parent);
end;

// This is copied from FileCtrl, mostly unchanged. I removed the WITH statement though.

function dzSelectDirectory(const Caption: string; const Root: WideString;
  var Directory: string; Options: TSelectDirExtOpts = [sdNewUI]; Parent: TWinControl = nil): Boolean;
var
  BrowseInfo: TBrowseInfo;
  OldErrorMode: Cardinal;
  ShellMalloc: IMalloc;
  IDesktopFolder: IShellFolder;
  Eaten, Flags: LongWord;
  CoInitResult: HRESULT;
  SelectDirCallback: TSelectDirCallback;
  WindowList: Pointer;
  Buffer: PChar;
  RootItemIDList, ItemIDList: PItemIDList;
begin
  Result := False;
  if not DirectoryExists(Directory) then
    Directory := '';
  FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
  if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then begin
    Buffer := ShellMalloc.Alloc(MAX_PATH * SizeOf(Char));
    try
      RootItemIDList := nil;
      if Root <> '' then begin
        SHGetDesktopFolder(IDesktopFolder);
        IDesktopFolder.ParseDisplayName(Application.Handle, nil,
          POleStr(Root), Eaten, RootItemIDList, Flags);
      end;

      // fill BrowseInfo
      if (Parent = nil) or not Parent.HandleAllocated then
        BrowseInfo.hwndOwner := Application.Handle
      else
        BrowseInfo.hwndOwner := Parent.Handle;
      BrowseInfo.pidlRoot := RootItemIDList;
      BrowseInfo.pszDisplayName := Buffer;
      BrowseInfo.lpszTitle := PChar(Caption);
      BrowseInfo.lpfn := SelectDirCB;
      BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS;
      if sdNewUI in Options then
        BrowseInfo.ulFlags := BrowseInfo.ulFlags or BIF_NEWDIALOGSTYLE;
      if not (sdNewFolder in Options) then
        BrowseInfo.ulFlags := BrowseInfo.ulFlags or BIF_NONEWFOLDERBUTTON;
      if sdShowEdit in Options then
        BrowseInfo.ulFlags := BrowseInfo.ulFlags or BIF_EDITBOX;
        if not (sdNewUI in Options) and (sdShowShares in Options) then
        BrowseInfo.ulFlags := BrowseInfo.ulFlags or BIF_SHAREABLE;
      if sdShowFiles in Options then
        BrowseInfo.ulFlags := BrowseInfo.ulFlags or BIF_BROWSEINCLUDEFILES;
      if sdValidateDir in Options then
        BrowseInfo.ulFlags := BrowseInfo.ulFlags or BIF_VALIDATE;

      SelectDirCallback := TSelectDirCallback.Create(Directory, Parent);
      try
        BrowseInfo.lParam := lParam(SelectDirCallback);
        // Not sure if this is necessary. Delphi 2007 does it, Delphi 10.1 doesn't
        if sdNewUI in Options then begin
          CoInitResult := CoInitializeEx(nil, COINIT_APARTMENTTHREADED);
          if CoInitResult = RPC_E_CHANGED_MODE then
            BrowseInfo.ulFlags := BrowseInfo.ulFlags and not BIF_NEWDIALOGSTYLE;
        end;
        try
          WindowList := DisableTaskWindows(0);
          OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
          try
            ItemIDList := ShBrowseForFolder(BrowseInfo);
          finally
            SetErrorMode(OldErrorMode);
            EnableTaskWindows(WindowList);
          end;
        finally
          if sdNewUI in Options then
            CoUninitialize;
        end;
      finally
        SelectDirCallback.Free;
      end;
      Result := ItemIDList <> nil;
      if Result then begin
        ShGetPathFromIDList(ItemIDList, Buffer);
        ShellMalloc.Free(ItemIDList);
        Directory := Buffer;
      end;
    finally
      ShellMalloc.Free(Buffer);
    end;
  end;
end;

end.

The unit u_dzSelectDirectoryFix is part of my dzlib in the svn repository on SourceForge.

 Posted by on 2016-05-05 at 11:09

Fixing the SelectDirectory fix

 Delphi  Comments Off on Fixing the SelectDirectory fix
May 042016
 

In my last blog post I wrote

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.

David Millington commented on my G+ post:

I haven’t looked at the code to see how the dialog itself is created or shown, but is it possible to either create it invisibly (not shown), position it, then show via ShowWindow or something, or hook its window proc to intercept its initial move message, or set its transparency to 0 and move and then make opaque, or some other hack?ï»ż

Which got me thinking. Why not indeed try to hide the dialog while it hasn’t been positioned yet and show it once that has happened?

I tried it but it didn’t work: The dialog still became visible before my code could set its position correctly.

After some more debugging it turned out that the problem isn’t actually that the dialog isn’t visible when the BFFM_INITIALIZED message is sent. The problem is, that the dialog changes its size after the BFFM_INITIALIZED message was handled, so setting its position there got it wrong because it calculated it based on the wrong size. So, setting it again was necessary.

But what if I hook the WindowProc (aka subclass the window), wait for the WM_SIZE message being sent and only then set the dialog position?

That seems to be the solution. I have tried it on my Windows 8.1 machine and it worked every single time. Some preliminary code is already in the dzlib svn, but it needs to be polished some more until I can present it here.

 Posted by on 2016-05-04 at 21:57

Fixing the SelectDirectory function

 Delphi  Comments Off on Fixing the SelectDirectory function
May 032016
 

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:

  1. Position the dialog on the monitor on which the application’s main form is shown.
  2. Center the dialog on that monitor
  3. 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:

  1. Since it fails to take into account that a monitor to the 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)
  2. 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.
  3. 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

 Posted by on 2016-05-03 at 22:36

Why blank lines matter

 Delphi, GExperts  Comments Off on Why blank lines matter
May 012016
 

This had me puzzled for a minute:

program CodeLibrarian;

{$R *.res}

uses
  GX_VerDepConst in '..\..\Framework\GX_VerDepConst.pas';

procedure ShowCodeLib; external GExpertsDll;
begin
  ShowCodeLib;
end.

This is all the code there is to the stand alone Code Librarian tool that comes with GExperts. Then it dawned me. It’s much easier to understand if you add a single line feed:

program CodeLibrarian;

{$R *.res}

uses
  GX_VerDepConst in '..\..\Framework\GX_VerDepConst.pas';

procedure ShowCodeLib; external GExpertsDll;

begin
  ShowCodeLib;
end.

The procedure ShowCodeLib is an external declaration that does not have a body. The begin / end are actually the main program that calls ShowCodeLib.

 Posted by on 2016-05-01 at 18:27