Delphi 调整窗体大小并保持纵横比

类似问题如下：

基本上，我想要的是调整窗体的大小并保持其纵横比，但我也希望调整大小以跟随光标。上述主题中的答案提供了一半令人满意的解决方案-它可以工作，但调整大小的速度比它应该的慢2倍。当我开始按X轴调整窗体的大小时，您可以看到光标的位置以及窗体的大小：

我认为，由于它的大小调整慢了2倍，我应该在代码中省略0.5倍的乘法器，它会工作，但没有骰子。下面是我目前正在使用的代码：

type
  TfrmTable = class(TForm)
    procedure FormCanResize(Sender: TObject; var NewWidth, NewHeight: Integer; var Resize: Boolean);
    procedure FormCreate(Sender: TObject);
  private
    FAspectRatio: Double;
  public
  end;

var
  frmTable: TfrmTable;

implementation

{$R *.dfm}

procedure TfrmTable.FormCreate(Sender: TObject);
begin
  FAspectRatio := Width / Height;
end;

procedure TfrmTable.FormCanResize(Sender: TObject; var NewWidth, NewHeight: Integer; var Resize: Boolean);
begin
  NewHeight := Round(0.50 * (NewHeight + NewWidth / FAspectRatio));
  NewWidth := Round(NewHeight * FAspectRatio);
end;

我尝试了另一种方法，通过使用如下内容：

procedure TfrmTable.FormCanResize(Sender: TObject; var NewWidth, NewHeight: Integer; var Resize: Boolean);
begin
  if NewWidth <> Width then
    NewHeight := Round(NewWidth / FAspectRatio)
  else
    if NewHeight <> Height then
      NewWidth := Round(NewHeight * FAspectRatio);
end;

procedure TfrmTable.FormCanResize（发送方：TObject；变量NewWidth，NewHeight:Integer；变量Resize:Boolean）；
开始
如果是NewWidth，那么
NewHeight:=圆形（NewWidth/FAspectRatio）
其他的
如果是新高度，那么
NewWidth:=圆形（NewHeight*FAspectRatio）；
结束；

---

这应该做什么？好的，我的想法是，我首先检查

NewWidth

是否与当前的

Width

不同，如果是，这意味着用户正在按X轴调整表单的大小。然后我应该将

NewHeight

设置为适当的值。否则，我将检查

NewHeight

是否与当前的

Height

不同，并将

NewWidth

值设置为适当的值。这也会产生奇怪的结果，当我将窗体拖动X轴时，它似乎工作了，一旦我停止调整大小，窗体就会返回到其原始大小-我得出结论，一旦我停止调整大小（让鼠标按钮向上），就会使用旧的

NewHeight

值调用

FormCanResize（）

事件，然后它会把形状恢复到原来的大小。

我认为你不能没有辅助设备

在这里，我使用一个简单的整数字段来存储您是否水平、垂直地调整大小。您还可以为此声明一个枚举

  ...
  private
    FAspectRatio: Double;
    FResizing: Integer;
    procedure WMExitSizeMove(var Message: TMessage); message WM_EXITSIZEMOVE;
  end;

...

procedure TForm1.FormCanResize(Sender: TObject; var NewWidth,
  NewHeight: Integer; var Resize: Boolean);
begin
  if FResizing = 0 then
    FResizing := Abs(NewHeight - Height) - Abs(NewWidth - Width);
  if FResizing < 0 then
    NewHeight := Round(NewWidth / FAspectRatio)
  else
    NewWidth := Round(NewHeight * FAspectRatio);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FAspectRatio := Width / Height;
end;

procedure TForm1.WMExitSizeMove(var Message: TMessage);
begin
  inherited;
  FResizing := 0;
end;

。。。
私有的
比例：两倍；
菲林化：整数；
过程WMExitSizeMove（var消息：TMessage）；消息WM_EXITSIZEMOVE；
结束；
...
过程TForm1.FormCanResize（发送方：TObject；var NewWidth，
NewHeight:Integer；var Resize:Boolean）；
开始
如果FResizing=0，则
菲林化：=Abs（新高度-高度）-Abs（新宽度-宽度）；
如果菲林化<0，则
NewHeight:=圆形（NewWidth/FAspectRatio）
其他的
NewWidth:=圆形（NewHeight*FAspectRatio）；
结束；
过程TForm1.FormCreate（发送方：TObject）；
开始
FAspectRatio:=宽度/高度；
结束；
过程TForm1.WMExitSizeMove（var消息：TMessage）；
开始
继承；
菲林化：=0；
结束；

处理此问题的正确信息是

WM\u size

：

通过处理此消息，应用程序可以监视大小和 拖动矩形的位置，如果需要，更改其大小或 位置

---

这是我的看法。在这里，我试图根据宽度或高度来调整大小，这取决于哪一个移动得最多

type
  TMyForm = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    FAspectRatio: Double;
    FWidthAtStartOfSize: Integer;
    FHeightAtStartOfSize: Integer;
  protected
    procedure WMEnterSizeMove(var Message: TMessage); message WM_ENTERSIZEMOVE;
    procedure WMSizing(var Message: TMessage); message WM_SIZING;
  end;

procedure TMyForm.FormCreate(Sender: TObject);
begin
  FAspectRatio := Width / Height;
end;

procedure TMyForm.WMEnterSizeMove(var Message: TMessage);
begin
  inherited;
  FWidthAtStartOfSize := Width;
  FHeightAtStartOfSize := Height;
end;

procedure TMyForm.WMSizing(var Message: TMessage);
var
  SizeBasedOnWidth: Boolean;
  NewHeight, NewWidth: Integer;
  Rect: PRect;
begin
  inherited;

  Rect := PRect(Message.LParam);
  case Message.wParam of
  WMSZ_LEFT, WMSZ_RIGHT:
    Rect.Bottom := Rect.Top + Round(Rect.Width/FAspectRatio);
  WMSZ_TOP, WMSZ_BOTTOM:
    Rect.Right := Rect.Left + Round(Rect.Height*FAspectRatio);
  WMSZ_TOPLEFT, WMSZ_TOPRIGHT, WMSZ_BOTTOMLEFT, WMSZ_BOTTOMRIGHT:
    begin
      if Rect.Width>FWidthAtStartOfSize then begin
        SizeBasedOnWidth := Rect.Height<MulDiv(FHeightAtStartOfSize, Rect.Width, FWidthAtStartOfSize)
      end else begin
        SizeBasedOnWidth := Rect.Width>MulDiv(FWidthAtStartOfSize, Rect.Height, FHeightAtStartOfSize);
      end;
      if SizeBasedOnWidth then begin
        NewHeight := Round(Rect.Width/FAspectRatio);
        case Message.wParam of
        WMSZ_TOPLEFT, WMSZ_TOPRIGHT:
          Rect.Top := Rect.Bottom - NewHeight;
        WMSZ_BOTTOMLEFT, WMSZ_BOTTOMRIGHT:
          Rect.Bottom := Rect.Top + NewHeight;
        end;
      end else begin
        NewWidth := Round(Rect.Height*FAspectRatio);
        case Message.wParam of
        WMSZ_TOPLEFT, WMSZ_BOTTOMLEFT:
          Rect.Left := Rect.Right - NewWidth;
        WMSZ_TOPRIGHT, WMSZ_BOTTOMRIGHT:
          Rect.Right := Rect.Left + NewWidth;
        end;
      end;
    end;
  end;
end;

类型
TMyForm=类（TForm）
过程表单创建（发送方：ToObject）；
私有的
比例：两倍；
FWidthAtStartOfSize:整数；
fheightstartofsize：整数；
受保护的
过程WMEnterSizeMove（var消息：TMessage）；消息WM_ENTERSIZEMOVE；
过程WMSIZE（var消息：TMessage）；消息WM_大小；
结束；
程序TMyForm.FormCreate（发送方：TObject）；
开始
FAspectRatio:=宽度/高度；
结束；
过程TMyForm.WMEnterSizeMove（变量消息：TMessage）；
开始
继承；
FWidthAtStartOfSize:=宽度；
Fheightstartofsize:=高度；
结束；
过程TMyForm.WMSizing（var消息：TMessage）；
变量
SizeBasedOnWidth：布尔值；
NewHeight、NewWidth：整数；
Rect:PRect；
开始
继承；
Rect:=PRect（Message.LParam）；
的case Message.wParam
WMSZ_左，WMSZ_右：
矩形底部：=矩形顶部+圆形（矩形宽度/宽度比）；
WMSZ_顶部，WMSZ_底部：
右矩形：=左矩形+圆形（矩形高度*比例）；
WMSZ_上左、WMSZ_上右、WMSZ_下左、WMSZ_下右：
开始
如果矩形宽度>FWidthAtStartOfSize，则开始
SizeBasedOnWidth:=垂直高度muldiv（FWidthAtStartOfSize，垂直高度，FHEIGHTSTARTOFSIZE）；
结束；
如果是SizeBasedOnWidth，则开始
新高度：=圆形（矩形宽度/宽度比）；
的case Message.wParam
WMSZ_左上角，WMSZ_右上角：
Rect.Top:=Rect.Bottom-新高度；
WMSZ_底部左，WMSZ_底部右：
矩形底部：=矩形顶部+新高度；
结束；
结束，否则开始
新宽度：=圆形（矩形高度*比例）；
的case Message.wParam
WMSZ_左上角，WMSZ_左下角：
Rect.Left:=Rect.Right-NewWidth；
WMSZ_右上角，WMSZ_右下角：
右矩形：=左矩形+新宽度；
结束；
结束；
结束；
结束；
结束；

我很喜欢塞塔克的回答。又短又甜。我已经开始了我的代码基于他的。但当你在角落里调整尺寸时，Sertac的代码偏袒了你。对于特定的角点，它总是倾向于垂直或水平角。在这里，我尝试不可知论，允许根据水平或垂直边调整角的大小，这取决于您执行拖动的方式

---

请注意，没有一种算法是完全令人满意的。事实上，如果我这么做的话，我会考虑禁用拐角调整大小。

如果你用火猴瞄准OSX，相应的API提供了一个简单的锁定纵横比的方法：

uses {...} FMX.Platform.Mac, Macapi.AppKit, Macapi.CocoaTypes;

// ...

procedure TMyForm.FormShow(Sender: TObject);
  var Window: NSWindow;
begin
  if not FRunOnce then
  begin
    FRunOnce := true;
    Window := WindowHandleToPlatform(Handle).Wnd;
    Window.setContentAspectRatio(NSSize(TPointF.Create(ClientWidth, ClientHeight)));
  end;
end;

---

我过去也做过类似的事情。试着调整代码的一边，而用户则调整另一边。这就是我在上面发布的第二个代码段中尝试的。所谓的0.5乘数是计算平均值。求和两个高度，除以二，这是算术平均值。你应该明确你所说的“慢两倍”是什么意思。速度从何而来？我能猜出你的意思。我希望你是精确的。我相信你希望能够调整一条边的大小，而另一条边是e

uses {...} FMX.Platform.Mac, Macapi.AppKit, Macapi.CocoaTypes;

// ...

procedure TMyForm.FormShow(Sender: TObject);
  var Window: NSWindow;
begin
  if not FRunOnce then
  begin
    FRunOnce := true;
    Window := WindowHandleToPlatform(Handle).Wnd;
    Window.setContentAspectRatio(NSSize(TPointF.Create(ClientWidth, ClientHeight)));
  end;
end;