Resize form and maintain aspect ratio

Question

Similar question here: Resize Form while keeping aspect ratio

Basically, what I want is to resize form and maintain its aspect ratio, but I want resizing to follow the cursor as well. The answer in the topic above provided solution that is half-satisfactory - it works, but resizing is working 2x slower than it should. When I start to resize the form by X axis, you can see where the cursor is, and what the form size is:

I thought that since it resizes 2x slower, I should omit 0.5 multiplier in the code and it will work, but no dice. Here is the code that I'm using at the moment:

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;

I've tried another approach, by using something like this:

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;

What this should do? Well, my thinking is that I first check if NewWidth is different than current Width, and if it is, that means user is resizing form by X axis. Then I should set NewHeight to appropriate value. Otherwise, I check if NewHeight is different than current Height, and set NewWidth value to its appropriate value. This also produces weird results, when I drag form by X axis, it seems to work, and as soon as I stop resizing, form returns to its original size - I concluded that once I stop resizing (let mouse button up), FormCanResize() event gets called with old NewHeight value, which then reverts form back to its old size.

Answer 1

I don't think you can do without auxiliary.

Here I use a simple integer field to store whether you size horizontally, vertically, or not at all. You could also declare an enumeration for that.

  ...
  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;

Answer 2

The correct message to handle this is 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;