delphi - 调整表单大小并保持纵横比

Question

类似问题:Resize Form while keeping aspect ratio

基本上，我想要的是调整表单大小并保持其纵横比，但我也希望调整大小以跟随光标。上面主题中的答案提供了一半令人满意的解决方案 - 它有效，但调整大小的速度比应有的速度慢 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;

这应该做什么？好吧，我的想法是，我首先检查 NewWidth 是否与当前 Width 不同，如果是，则意味着用户正在通过 X 轴调整表单大小。然后我应该将 NewHeight 设置为适当的值。否则，我检查 NewHeight 是否与当前 Height 不同，并将 NewWidth 值设置为其适当的值。这也会产生奇怪的结果，当我通过 X 轴拖动表单时，它似乎起作用了，一旦我停止调整大小，表单就会返回到其原始大小 - 我得出的结论是，一旦停止调整大小(让鼠标按钮向上)，FormCanResize() 事件使用旧的 NewHeight 值调用，然后将表单恢复到原来的大小。

Answer 1

处理此问题的正确消息是WM_SIZING:

By processing this message, an application can monitor the size and position of the drag rectangle and, if needed, change its size or position.

procedure TForm1.WMSizing(var Message: TMessage);
begin
  case Message.wParam of
    WMSZ_LEFT, WMSZ_RIGHT, WMSZ_BOTTOMLEFT:
      with PRect(Message.LParam)^ do
        Bottom := Top + Round((Right-Left)/FAspectRatio);
    WMSZ_TOP, WMSZ_BOTTOM, WMSZ_TOPRIGHT, WMSZ_BOTTOMRIGHT:
      with PRect(Message.LParam)^ do
        Right := Left + Round((Bottom-Top)*FAspectRatio);
    WMSZ_TOPLEFT:
      with PRect(Message.LParam)^ do
        Top := Bottom - Round((Right-Left)/FAspectRatio);
  end;
  inherited;
end;