How to restrict minimum form's width in FireMonkey?

Question

How do I restrict a minimum form's width in FireMonkey? It used to be so easy in VCL - it just had Max and Min constraints in forms properties.

Answer 1

Note for future readers:

This will only work for versions below XE3 because the Fmx::Platform::TPlatform class was removed in XE3. Thanks to @Alain Thiffault for pointing it out in the comments.

Original Post:

Here's a more complicated (but more elegant) alternative solution, defining an entirely custom Form class from which you can inherit your own...

unit FMX.ConstrainedForm;

interface

uses
  System.Classes, System.Types, System.UITypes, FMX.Forms, FMX.Platform, FMX.Types;

type
  TFormConstraints = class(TPersistent)
  private
    FMaxHeight: Integer;
    FMaxLeft: Integer;
    FMaxWidth: Integer;
    FMaxTop: Integer;
    FMinHeight: Integer;
    FMinLeft: Integer;
    FMinWidth: Integer;
    FMinTop: Integer;
  public
    constructor Create;
  published
    property MaxHeight: Integer read FMaxHeight write FMaxHeight default 0;
    property MaxLeft: Integer read FMaxLeft write FMaxLeft default 0;
    property MaxWidth: Integer read FMaxWidth write FMaxWidth default 0;
    property MaxTop: Integer read FMaxTop write FMaxTop default 0;
    property MinHeight: Integer read FMinHeight write FMinHeight default 0;
    property MinLeft: Integer read FMinLeft write FMinLeft default 0;
    property MinWidth: Integer read FMinWidth write FMinWidth default 0;
    property MinTop: Integer read FMinTop write FMinTop default 0;
  end;

  TConstrainedForm = class(TCustomForm)
  private
    FConstraints: TFormConstraints;
  protected
    procedure StartWindowResize; override;
    procedure StartWindowDrag; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  published
    property Constraints: TFormConstraints read FConstraints write FConstraints;
    property BiDiMode;
    property Caption;
    property Cursor default crDefault;
    property BorderStyle default TFmxFormBorderStyle.bsSizeable;
    property BorderIcons default [TBorderIcon.biSystemMenu, TBorderIcon.biMinimize, TBorderIcon.biMaximize];
    property ClientHeight;
    property ClientWidth;
    property Left;
    property Top;
    property Margins;
    property Position default TFormPosition.poDefaultPosOnly;
    property Width;
    property Height;
    property ShowActivated default True;
    property StaysOpen default True;
    property Transparency;
    property TopMost default False;
    property Visible;
    property WindowState default TWindowState.wsNormal;
    property OnCreate;
    property OnDestroy;
    property OnClose;
    property OnCloseQuery;
    property OnActivate;
    property OnDeactivate;
    property OnResize;
    property Fill;
    property StyleBook;
    property ActiveControl;
    property StyleLookup;
    property OnPaint;
  end;

procedure Register;

implementation

{ TFormConstraints }

constructor TFormConstraints.Create;
begin
  inherited;
  FMaxHeight := 0;
  FMaxLeft := 0;
  FMaxWidth := 0;
  FMaxTop := 0;
  FMinHeight := 0;
  FMinLeft := 0;
  FMinWidth := 0;
  FMinTop := 0;
end;

{ TConstrainedForm }

constructor TConstrainedForm.Create(AOwner: TComponent);
begin
  FConstraints := TFormConstraints.Create;
  inherited;
end;

destructor TConstrainedForm.Destroy;
begin
  FConstraints.Free;
  inherited;
end;

procedure TConstrainedForm.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  if (FConstraints.FMinWidth > 0) and (AWidth < FConstraints.FMinWidth) then
    AWidth := FConstraints.FMinWidth;

  if (FConstraints.FMaxWidth > 0) and (AWidth > FConstraints.FMaxWidth) then
    AWidth := FConstraints.FMaxWidth;

  if (FConstraints.FMinHeight > 0) and (AHeight < FConstraints.FMinHeight) then
    AHeight := FConstraints.FMinHeight;

  if (FConstraints.FMaxHeight > 0) and (AHeight > FConstraints.FMaxHeight) then
    AHeight := FConstraints.FMaxHeight;

  if (FConstraints.FMinLeft > 0) and (ALeft < FConstraints.FMinLeft) then
    ALeft := FConstraints.FMinLeft;

  if (FConstraints.FMaxLeft > 0) and (ALeft > FConstraints.FMaxLeft) then
    ALeft := FConstraints.FMaxLeft;

  if (FConstraints.FMinTop > 0) and (ATop < FConstraints.FMinTop) then
    ATop := FConstraints.FMinTop;

  if (FConstraints.FMaxTop > 0) and (ATop > FConstraints.FMaxTop) then
    ATop := FConstraints.FMaxTop;

  Platform.SetWindowRect(Self, RectF(ALeft, ATop, ALeft + AWidth, ATop + AHeight));
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
end;

procedure TConstrainedForm.StartWindowDrag;
begin
  inherited;

end;

procedure TConstrainedForm.StartWindowResize;
begin
  inherited;
end;

procedure Register;
begin
  RegisterClass(TConstrainedForm);
end;

end.

Store this file as FMX.ConstrainedForm.pas, add it to your Form's "uses" section, and modify the declaration of your form so that instead of:

TForm1 = class(TForm)

it says:

TForm1 = class(TConstrainedForm)

Due to the lack of a custom designed (at this point anyway, this is a "quick solution"), you then need to hook your form's OnCreate event as follows:

procedure TForm1.FormCreate(Sender: TObject);
begin
  Constraints.MinWidth := 400;
  Constraints.MinHeight := 400;
end;

Now this form will not allow the user to set its width or height below 400!

Again, without making some substancial changes to the FireMonkey Platform itself, this is the best you're going to get for now!

Answer 2

Place this on the form's "OnResize" event, replace the values as appropriate. Granted, not the best solution in the world, but it'll get you by until the properties are reintroduced!

procedure TForm1.FormResize(Sender: TObject);
begin
  if Width < 400 then
    Width := 400;
  if Height < 400 then
    Height := 400;
end;

The above code is easy enough to change for any combination of maximums or minimums, so have fun!

Answer 3

LaKraven, simulate a mouseUp event to get rid of that flickering.

if (Width > maxWidth) then
begin
  Width := maxWidth;
  Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
end;

Answer 4

Just found out TForm has a Constraints property in Delphi 11.

Works perfectly for me without flickering.

Answer 5

Additionally for LaKraven's answer about FormResize based solution, use ClientWidth and ClientHeight instead of Width and Height to prevent stretching of the form.

procedure TForm1.FormResize(Sender: TObject);
begin
    if ClientWidth < 400 then
        ClientWidth := 400;
    if ClientHeight < 400 then
        ClientHeight := 400;
end;

Answer 6

Below is an updated version to Sunec's answer, to get rid of flickering.

According to MSDN Mouse_Event has been superseded and SendInput should be used instead: https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-mouse_event

uses WinApi.Windows;

procedure TForm1.FormResize(Sender: TObject);
var
  LInput: TInput;
begin
  if ClientHeight < MIN_HEIGHT then
  begin
    ClientHeight := MIN_HEIGHT;
    FillMemory(@LInput, SizeOf(LInput), 0);
    LInput.Itype := INPUT_MOUSE;
    LInput.mi.dwFlags := MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTUP;
    SendInput(1, LInput, SizeOf(LInput));
  end;
  if ClientWidth < MIN_WIDTH then
  begin
    ClientWidth := MIN_WIDTH;
    FillMemory(@LInput, SizeOf(LInput), 0);
    LInput.Itype := INPUT_MOUSE;
    LInput.mi.dwFlags := MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTUP;
    SendInput(1, LInput, SizeOf(LInput));
  end;
end;

Answer 7

To summery the above for a useful answer just use code below:

Uses Winapi.Windows;

Procedure TForm1.FormResize(Sender: TObject);
Begin
 If ClientWidth < 400 Then
    Begin
      ClientWidth := 400;
      Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
    End;

  If ClientHeight < 400 Then
    Begin
      ClientHeight := 400;
      Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
    End;
End;