Snapping a Firemonkey window to monitor halves / quadrants

  

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.

Comments are closed.