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

Question

类似的问题:在保持宽高比的同时调整表格大小

基本上,我想要的是调整窗体大小并保持其宽高比,但我也希望调整大小以跟随光标.上面主题中的答案提供了半满意的解决方案 - 它可以工作,但调整大小比它应该慢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:

通过处理此消息,应用程序可以监视拖动矩形的大小和位置,并在需要时更改其大小或位置.

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;