9

如何在 FireMonkey 中限制最小表单的宽度？它曾经在 VCL 中非常简单——它只是在表单属性中有 Max 和 Min 约束。

4

6 回答 6

14

给未来读者的注意事项：

这仅适用于 XE3 以下的版本，因为Fmx::Platform::TPlatform该类已在 XE3 中删除。感谢@Alain Thifault 在评论中指出这一点。

原帖：

这是一个更复杂（但更优雅）的替代解决方案，定义一个完全自定义的 Form 类，您可以从中继承自己的...

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.

将此文件存储为 FMX.ConstrainedForm.pas，将其添加到表单的“使用”部分，并修改表单的声明，以便代替：

TForm1 = class(TForm)

它说：

TForm1 = class(TConstrainedForm)

由于缺乏自定义设计（无论如何，这是一个“快速解决方案”），您需要按如下方式挂钩表单的 OnCreate 事件：

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

现在这个表单将不允许用户将其宽度或高度设置为低于 400！

同样，无需对 FireMonkey 平台本身进行一些实质性更改，这是您目前所能获得的最好的！

于 2011-11-08T00:21:03.527 回答
5

将它放在表单的“OnResize”事件上，根据需要替换值。诚然，这不是世界上最好的解决方案，但它会让您度过难关，直到重新引入这些属性！

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

上面的代码很容易更改为最大值或最小值的任何组合，所以玩得开心！

于 2011-11-07T20:19:32.050 回答
4

LaKraven，模拟 mouseUp 事件以消除闪烁。

if (Width > maxWidth) then
begin
  Width := maxWidth;
  Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
end;
于 2013-04-14T18:02:19.147 回答
3

此外，对于 LaKraven 关于基于 FormResize 的解决方案的回答，请使用 ClientWidth 和 ClientHeight 而不是 Width 和 Height 来防止表单拉伸。

procedure TForm1.FormResize(Sender: TObject);
begin
    if ClientWidth < 400 then
        ClientWidth := 400;
    if ClientHeight < 400 then
        ClientHeight := 400;
end;
于 2015-03-03T10:37:41.397 回答
2

以下是 Sunec 答案的更新版本，以消除闪烁。

根据 MSDN Mouse_Event 已被取代，应使用 SendInput： https ://docs.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;
于 2020-08-25T06:39:42.797 回答
0

要总结以上内容以获得有用的答案，只需使用以下代码：

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;
于 2019-05-02T19:11:49.500 回答