Snapping a Firemonkey window to monitor halves / quadrants

Delphi, dzLib 3 Minutes

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.

Published