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.