Colin Wilson’s XN Resource Editor

 Delphi  Comments Off on Colin Wilson’s XN Resource Editor
Aug 072016
 

A really useful tool that I have used for many years, was Colin Wilson’s XN Resource Editor.

XNResourceEditor

Before he apparently disappeared from the face of the earth, Colin was so kind to release the source code under the MPL on his homepage. Unfortunately this page now is also gone, only a few snapshots in the Internet Archive remain. Even more unfortunately the source code archive is not complete. It’s missing quite a few components and utility units.

I have started to try and recompile XN Resource Editor several times, usually because I stumbled upon yet another copy of its source code somewhere on the Internet, in the vain hope that this time it might be complete. The latest was in Stefan Sundin’s github repository. Unfortunately it turned out that – even though he claims that the repository contains all prerequisites – several files were missing, in particular the VirtualTreeView extension written by Colin.

This time I went back to the Internet Archive and tried to find a snapshot that contains the files necessary. It turned out that they were all there, just not in the same snapshot.

To cut a long story short: I managed to dig the complete source code of XN Resource Editor out of the Internet Archive of his homepage. While I am not 100% sure that it is the latest version, it at least compiles and seems to work. I put everything into the svn repository of the new XN Resource Editor project on SourceForge. It contains everything necessary, including the TNTComponents Suite and Virtual Treeview.

There is a !Readme.txt file describing the steps necessary to compile the program (You also need Delphi 2006 for that). Or, if you just need the executable and can’t find it anywhere else, look here.

Specifying a date for MS SQL Server

 SQL  Comments Off on Specifying a date for MS SQL Server
Jul 272016
 

Today I had the “pleasure” to fix a problem in a customer’s SQL server database where some records had wrong values in date fields. The theory is quite simple. Find out which records are affected (there were only 7 of them) and correct the problem with a statement like this:

update tablename
set datefield='2008-02-14'
where someotherfield='somestringvalue'

Unfortunately the SQL server complained that it could not convert the string to a date. Google didn’t really help much because apparently it works like this for everybody else but me. But I found a hint how to test it quite simply:

select isdate('2008-02-14')

After a bit of try and error if found the problem:

The server did not actually assume a date of the form yyyy-mm-dd to be ISO 8601 as every human probably would. It assumed it to be yyyy-dd-mm so

select isdate('2008-14-02')

worked.

Americans! With yy/dd/mm You have given the world the most stupid date format ever, but Microsoft managed to top even that with yyyy-dd-mm.

So, eventually I used

update tablename
set datefield='2008-14-02'
where someotherfield='somestringvalue'

and it worked.

EDIT:

As Stefan Glienke pointet out in this Google+ post the order of y,m,d in a date is configurable with SET DATEFORMAT

So apparently on the machine I was working on it was set to

SET DATEFORMAT ydm

and I could have fixed the problem with

SET DATEFORMAT ymd

GExperts 1.38 experimental twm 2016-07-24 released

 Delphi, GExperts  Comments Off on GExperts 1.38 experimental twm 2016-07-24 released
Jul 262016
 

This is another 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)

Again, I have built installers for each Delphi version. These installers should install everything that is necessary, including the files for the Code Formatter.

Apart from several bugfixes I have heavily added to the improvements for the search path dialog.

Head over to the Experimental GExperts page to download it.

Default color of a hint window

 Delphi  Comments Off on Default color of a hint window
Jul 262016
 

Since it doesn’t seem to be documented anywhere and at least in Delphi 2007 there is no constant for it:

The default background color of a hint window is

const
  clHintColor = $80FFFF;

(Taken from THintWindow.Create)

Updated GExperts Documentation

 Delphi, GExperts  Comments Off on Updated GExperts Documentation
Jul 232016
 

I added some new pages to my blog to document all the changes and improvements I have made to GExperts that so far are not in the official documentation.

GEXperts-SearchPathEnhancements2

I probably still missed a few…

Opening an explorer window from the folder select dialog

 Windows  Comments Off on Opening an explorer window from the folder select dialog
Jul 122016
 

Ever used a program that showed one of the folder select dialogs and you wanted to open a normal explorer window showing that folder? There is no button for that and no entry in the popup menu, but you can add one:

Create a new shortcut in

C:\Users\≶yourname>\AppData\Roaming\Microsoft\Windows\SendTo

Enter “Explorer” as the location and name of the shortcut.

Done.

Now you have an “Explorer” entry the Send To submenu of all popup menus which in the case of a folder opens a new explorer instance for this folder.

SendToExplorer

TMemo vs. Esc key

 Delphi  Comments Off on TMemo vs. Esc key
Jun 192016
 

If you have ever had a TMemo on a modal form with an OK and Cancel button, where the latter has its Cancel property set to true, you might have found that Esc does not cancel the dialog while the memo has got the focus.

According to David Heffernan that’s because the VCL tells it to use all keys but it then doesn’t handle Esc. David also provides a fix for this via an interposer class. While this works it means that you have to add this interposer to every form in your application.

If you are already using Andras Hausladen’s excellent VCL Fix Pack there is another option: Add David’s fix to the hook installed by InitContextMenuFix (works only for Delphi 6-2007) or add a special hook for the fix only (for later Delphi versions where the context menu bug has been fixed).

So far I have only done the first. Look for the code between the two “TMemo Esc Fix” comments

procedure TContextMenuFixWinControl.DefaultHandler(var Message);
type
  TDefHandler = procedure(Self: TControl; var Message);
begin
  if HandleAllocated then
  begin
    with TMessage(Message) do
    begin
      { Here was the WM_CONTEXTMENU Code that is not necessary because
        DefWndProc will send this message to the parent control. }

      { Keep the odd bahavior for grids because everybody seems to be used to it. }
      if (Msg = WM_CONTEXTMENU) and (Parent <> nil) and (Parent is TCustomGrid) then
      begin
        Result := Parent.Perform(Msg, WParam, LParam);
        if Result <> 0 then Exit;
      end;

      // Begin - TMemo Esc Fix
      if (Msg = WM_GETDLGCODE) and (Parent <> nil) and Self.InheritsFrom(TCustomMemo) then
      begin
        //inherited DefaultHandler(Message);
        TDefHandler(@TControl.DefaultHandler)(Self, Message);
        Result := Result and not DLGC_WANTALLKEYS;
        Exit;
      end;

      if (Msg = CM_WANTSPECIALKEY) and (Parent <> nil) and Self.InheritsFrom(TCustomMemo) then
      begin
        case TCMWantSpecialKey(Message).CharCode of
        VK_ESCAPE:
          begin
            Result := 0;
            Exit;
          end;
        VK_RETURN, VK_EXECUTE, VK_CANCEL:
          begin
            Result :=1;
            Exit;
          end;
        end;
      end;
      // End - TMemo Esc Fix

      case Msg of
        WM_CTLCOLORMSGBOX..WM_CTLCOLORSTATIC:
          Result := SendMessage(LParam, CN_BASE + Msg, WParam, LParam);
        CN_CTLCOLORMSGBOX..CN_CTLCOLORSTATIC:
          begin
            SetTextColor(WParam, ColorToRGB(Font.Color));
            SetBkColor(WParam, ColorToRGB(Brush.Color));
            Result := Brush.Handle;
          end;
      else
        if Msg = RM_GetObjectInstance then
          Result := LRESULT(Self)
        else
          Result := CallWindowProc(DefWndProc, Handle, Msg, WParam, LParam);
      end;
      if Msg = WM_SETTEXT then
        SendDockNotification(Msg, WParam, LParam);
    end;
  end
  else
    //inherited DefaultHandler(Message);
    TDefHandler(@TControl.DefaultHandler)(Self, Message);
end;

What it does is basically the same as David’s interposer class:

  1. It handles WM_GETDLGCODE by calling the inherited message handler (in this case: The original WindowProc) and removing the DLGC_WANTALLKEYS bit from the result.
  2. It handles CM_WANTSPECIALKEY, checks for VK_ESCAPE for which it sets Result to 0, meaning “I’m not interested in this key.”, and VK_RETURN, VK_EXECUTE, VK_CANCEL setting Result to 1 meaning “I’m interested in these keys.”.

Andy’s code hooks TWinControl.DefaultHandler so the code above gets called for all TWinControls, but we don’t want to meddle with the Esc key handling of other controls. There was a small problem with checking whether the control is actually a Memo. “Self is TMemo” did not work because TContextMenuFixWinControl.DefaultHandler is a class method, so the compiler thinks that Self is a class rather than a class instance and didn’t want to compile this code. Changing the condition to Self.InheritsFrom(TCustomMemo) did the trick.

Sarch path dialog behaviour changed from Delphi 2010 to XE

 Delphi  Comments Off on Sarch path dialog behaviour changed from Delphi 2010 to XE
Jun 192016
 

Yesterday, while working with Delphi 10.1 something happened that made me think I had introduced a bug in the search path dialog enhancement of GExperts:

I had dropped some directories from the explorer onto the memo inserted by the GExperts enhancement, switched to the list view and back to the memo, then pressed the “Make Relative” button and exited the dialog with OK. Nothing special here until I noticed that the search path now contained the last directory twice: Once as a relative path and once as an absolute path.

Today I investigated this a bit more and found that the behaviour of the search path editor dialog had changed from Delphi 2010 to XE: From then on the content of the edit field gets added to the search path even if you don’t press the Add button but just the OK button. Since this only happens if it is not already there, you usually don’t notice, unless you have changed the entries in the list from absolute to relative paths. Then you end up with a duplicate.

I disabled the GExperts enhancements to make sure it’s not cause by it: It’s a change in the dialog itself.

SearchPathOddity

“Hooking” KeyDown in a Firemonkey form

 Delphi, dzLib  Comments Off on “Hooking” KeyDown in a Firemonkey form
Jun 182016
 

As said in my last post: " The hard part is hooking the form in a way so all I need to do is call TForm_ActivatePositioning as in the VCL."

As it turns out, that’s even easier to do than in the VCL. No subclassing of the window, just adding a new control is sufficient. As this StackOverflow answer points out, a Firemonkey form calls the DialogKey method of all its child controls when a key is pressed, starting with the one that has got the focus. So, all we’ve got to do is creating a control that handles the keys we want to intercept and add it to the form.

Here is the code:

type
  TFormPositioningActivator = class(TControl)
  private
    FModifier: TShiftState;
  protected
    procedure DialogKey(var Key: Word; Shift: TShiftState); override;
  public
    constructor Create(_Form: TCustomForm; _Modifier: TShiftState); reintroduce;
  end;

{ TFormHookChild }

constructor TFormPositioningActivator.Create(_Form: TCustomForm; _Modifier: TShiftState);
begin
  inherited Create(_Form);
  FModifier := _Modifier;
  Parent := _Form;
end;

procedure TFormPositioningActivator.DialogKey(var Key: Word; Shift: TShiftState);
begin
  inherited;
  if Shift = FModifier then begin
    case Key of
      vkLeft: TForm_MoveTo(self.Parent as TForm, dwpLeft);
      vkRight: TForm_MoveTo(self.Parent as TForm, dwpRight);
      vkUp: TForm_MoveTo(self.Parent as TForm, dwpTop);
      vkDown: TForm_MoveTo(self.Parent as TForm, dwpBottom);
      vkHome: TForm_MoveTo(self.Parent as TForm, dwpTopLeft);
      vkEnd: TForm_MoveTo(self.Parent as TForm, dwpBottomLeft);
      vkPrior: TForm_MoveTo(self.Parent as TForm, dwpTopRight);
      vkNext: TForm_MoveTo(self.Parent as TForm, dwpBottomRight);
    else
      Exit; // so Key doesn't get set to 0
    end;
    Key := 0;
  end;

end;

function TForm_ActivatePositioning(_Form: TForm; _Modifier: TShiftState = [ssCtrl, ssAlt]): TObject;
begin
  Result := TFormPositioningActivator.Create(_Form, _Modifier);
end;

All you have to do is call TForm_ActivatePositioning(Self) in the form’s constructor and be done.

Snapping a Firemonkey window to monitor halves / quadrants

 Delphi, dzLib  Comments Off on Snapping a Firemonkey window to monitor halves / quadrants
Jun 182016
 

I always wanted to start playing with Firemonkey but so far just didn’t find the right project. This is my first try to port a VCL utility function to Firemonkey. Note that this will probably not work on all platforms. It’s tested on Windows only.

So, how do we get the code from my last post to work with a Firemonkey program? It turned out to be not too difficult. Monitors have been renamed to Displays, TForm.BoundsRect is now only TForm.Bounds. There doesn’t seem to be an equivalent to TForm.Constraints (even though Simon J. Stuart has posted a TConstraintForm solution on StackOverflow) so we will for now ignore that.

Here is the code:

procedure TForm_MoveTo(_frm: TCustomForm; _Position: TdzWindowPositions);

  procedure ToTop(var _Re: TRect; _MinHeight, _MaxHeight: Integer);
  begin
    _Re.Bottom := _Re.Top + _Re.Height div 2;
    if _Re.Height < _MinHeight then
      _Re.Bottom := _Re.Top + _MinHeight;
    if (_MaxHeight > 0) and (_Re.Height > _MaxHeight) then
      _Re.Bottom := _Re.Top + _MaxHeight;
  end;

  procedure ToBottom(var _Re: TRect; _MinHeight, _MaxHeight: Integer);
  begin
    _Re.Top := _Re.Top + _Re.Height div 2;
    if _Re.Height < _MinHeight then
      _Re.Top := _Re.Bottom - _MinHeight;
    if (_MaxHeight > 0) and (_Re.Height > _MaxHeight) then
      _Re.Top := _Re.Bottom - _MaxHeight;
  end;

  procedure ToLeft(var _Re: TRect; _MinWidth, _MaxWidth: Integer);
  begin
    _Re.Right := _Re.Left + _Re.Width div 2;
    if _Re.Width < _MinWidth then
      _Re.Right := _Re.Left + _MinWidth;
    if (_MaxWidth > 0) and (_Re.Width > _MaxWidth) then
      _Re.Right := _Re.Left + _MaxWidth;
  end;

  procedure ToRight(var _Re: TRect; _MinWidth, _MaxWidth: Integer);
  begin
    _Re.Left := _Re.Left + _Re.Width div 2;
    if _Re.Width < _MinWidth then
      _Re.Left := _Re.Right - _MinWidth;
    if (_MaxWidth > 0) and (_Re.Width > _MaxWidth) then
      _Re.Left := _Re.Right - _MaxWidth;
  end;

  function TryMonitorFromPoint(_pnt: TPoint; out _Display: TDisplay): boolean;
  var
    i: Integer;
    Display: TDisplay;
  begin
    Result := False;
    for i := 0 to Screen.DisplayCount - 1 do begin
      Display := Screen.Displays[i];
      Result := Display.WorkArea.Contains(_pnt);
      if Result then begin
        _Display := Display;
        Exit;
      end;
    end;
  end;

type
  TDummyConstraints = record
    MinWidth, MaxWidth: Integer;
    MinHeight, MaxHeight: Integer;
  end;
var
  re: TRect;
  Bounds: TRect;
  NewMonitor: TDisplay;
  Constraints: TDummyConstraints;
begin
  re := Screen.DisplayFromForm(_frm).WorkareaRect;
  Bounds := _frm.Bounds;
  Constraints.MinWidth := 0;
  Constraints.MaxWidth := 0;
  Constraints.MinHeight := 0;
  Constraints.MaxHeight := 0;
  case _Position of
    dwpTop: begin
        ToTop(re, Constraints.MinHeight, Constraints.MaxHeight);
        if re = Bounds then begin
          if TryMonitorFromPoint(Point((re.Left + re.Right) div 2, re.Top - re.Height div 2), NewMonitor) then begin
            re := NewMonitor.WorkareaRect;
            ToBottom(re, Constraints.MinHeight, Constraints.MaxHeight);
          end;
        end;
      end;
    dwpBottom: begin
        ToBottom(re, Constraints.MinHeight, Constraints.MaxHeight);
        if re = Bounds then begin
          if TryMonitorFromPoint(Point((re.Left + re.Right) div 2, re.Bottom + re.Height div 2), NewMonitor) then begin
            re := NewMonitor.WorkareaRect;
            ToTop(re, Constraints.MinHeight, Constraints.MaxHeight);
          end;
        end;
      end;
    dwpLeft: begin
        ToLeft(re, Constraints.MinWidth, Constraints.MaxWidth);
        if re = Bounds then begin
          if TryMonitorFromPoint(Point(re.Left - re.Width div 2, (re.Top + re.Bottom) div 2), NewMonitor) then begin
            re := NewMonitor.WorkareaRect;
            ToRight(re, Constraints.MinWidth, Constraints.MaxWidth);
          end;
        end;
      end;
    dwpRight: begin
        ToRight(re, Constraints.MinWidth, Constraints.MaxWidth);
        if re = Bounds then begin
          if TryMonitorFromPoint(Point(re.Right + re.Width div 2, (re.Top + re.Bottom) div 2), NewMonitor) then begin
            re := NewMonitor.WorkareaRect;
            ToLeft(re, Constraints.MinWidth, Constraints.MaxWidth);
          end;
        end;
      end;
    dwpTopLeft: begin
        ToTop(re, Constraints.MinHeight, Constraints.MaxHeight);
        ToLeft(re, Constraints.MinWidth, Constraints.MaxWidth);
      end;
    dwpTopRight: begin
        ToTop(re, Constraints.MinHeight, Constraints.MaxHeight);
        ToRight(re, Constraints.MinWidth, Constraints.MaxWidth);
      end;
    dwpBottomLeft: begin
        ToBottom(re, Constraints.MinHeight, Constraints.MaxHeight);
        ToLeft(re, Constraints.MinWidth, Constraints.MaxWidth);
      end;
    dwpBottomRight: begin
        ToBottom(re, Constraints.MinHeight, Constraints.MaxHeight);
        ToRight(re, Constraints.MinWidth, Constraints.MaxWidth);
      end;
  end;
  _frm.Bounds := re;
end;

As you can see, the implementation is very similar to the VCL implementation. With a bit of effort I could probably make them nearly indistinguishable.

It’s in dzlib, in unit u_dzFmxUtils

Now, that was the easy part: Moving the form. The hard part is hooking the form in a way so all I need to do is call TForm_ActivatePositioning as in the VCL. No idea yet on how to accomplish that, but I’m just getting started with Firemonkey.