logo标签列表

如何在FireMonkey中限制表单的最小宽度？

delphidelphi-xe2firemonkey
12

如何在FireMonkey中限制最小表单宽度？ 在VCL中很容易做到 - 只需在表单属性中设置Max和Min约束。

2
tondog - 你介意把我的答案标记为正确吗？谢谢！ - LaKraven
7个回答
14

未来读者注意：

这仅适用于版本低于XE3的情况，因为在XE3中删除了Fmx::Platform::TPlatform类。感谢@Alain Thiffault在评论中指出。

原始帖子：

以下是一种更复杂（但更优雅）的替代解决方案，定义了一个完全自定义的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，将其添加到您的表单的“uses”部分，并修改您的表单声明，使其不再是：

TForm1 = class(TForm)
"它说："
TForm1 = class(TConstrainedForm)
由于缺乏自定义设计（至少在这个阶段，这是一个“快速解决方案”），您需要将表单的OnCreate事件挂钩如下所示：

由于缺乏自定义设计（至少在这个阶段，这是一个“快速解决方案”），您需要将表单的OnCreate事件挂钩如下所示：

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

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

同样，在不对FireMonkey平台本身进行一些实质性的更改的情况下，这是目前最好的解决方案！

1
天啊...！现在设置表单最小值需要这么复杂的操作吗？在Delphi中，它只需要一个字段就可以了。 - tdog2
请问，我应该把上面的代码放在哪里？是新建一个单元吗？请原谅我的无知，我对离开默认的 Delphi 表单一无所知。您能否将此代码嵌入默认的 Form1 中？ - tdog2
是的，你最好将它放在一个名为“FMX.ConstrainedForm.pas”的单独单元中，然后将其链接到你的项目中！ - LaKraven
2
我建议使用InRange（FConstraints.FMinTop，0，ATop）使代码变得更简短，以免吓到人们。 - Kromster
@Krom 给出了一个好建议...我承认我不知道InRange函数！我可能很快会编辑这个解决方案以反映这一点。不过，我现在正在为另一个问题努力研究一个更复杂的解决方案。 - LaKraven
2
请注意，这是一篇旧文章，但由于我通过谷歌进入了这里，应该注意Fmx :: Platform :: TPlatform类在XE3中已被移除。有关更多详细信息，请参见此链接：https://forums.embarcadero.com/thread.jspa？ThreadID=117749。 - Alain Thiffault
5
在表单的“OnResize”事件中放置此代码，并根据需要替换值。 虽然不是世界上最好的解决方案，但在属性重新引入之前，它可以帮助你度过难关！
procedure TForm1.FormResize(Sender: TObject);
begin
  if Width < 400 then
    Width := 400;
  if Height < 400 then
    Height := 400;
end;

以上代码很容易改变任何最大或最小值的组合，所以尽情享受吧！

实际上，我会为您创建一个自定义的TForm类，您可以在任何地方使用它，并为您提供约束属性 :) - LaKraven
谢谢。上述“FormResize”代码的问题在于，它会导致奇怪的窗体行为和动画“伪像”，例如窗体的闪烁和屏幕上的垃圾。 - tdog2
我会使用这个。它并不完美，但现在可以帮你度过难关。另外，让用户将表单设置得尽可能小也是一个应急之策。大多数应用程序都不会限制用户在这方面的选择。 - Marcus Adams
5

刚发现Delphi 11中的TForm有一个Constraints属性。

演示

对我来说完美无瑕且没有闪烁。

4
LaKraven，模拟一个mouseUp事件来消除闪烁问题。
if (Width > maxWidth) then
begin
  Width := maxWidth;
  Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
end;
这是一个伟大而简单的解决方案。它对我很有效。由于在Mac上表格不会闪烁，所以只要它在Windows上工作就足够了。 - Hans
啊，当窗口缩小到一定程度时，它会释放用户的鼠标，以防止拖动大小调整器。如果用户想要将其大小向后移动，则必须将鼠标移回调整器并再次按下。这是一个不好的决定，但可能比闪烁更好... - Nashev
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;
2
以下是Sunec的答案的更新版本，用于消除闪烁。
根据MSDN，Mouse_Event已经被取代，应该使用SendInput： 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;
请注意，当我使用ClientWidth / ClientHeight时，如果窗体的Transparency属性已启用，则该值在某些Windows机器上似乎是错误的。 ClientWidth似乎为0，导致窗口在首次显示时缩小到最小尺寸。但是，改用Width和Height就可以了。 - XylemFlow
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;
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接