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轴拖动窗体时，它似乎工作，并且一旦我停止调整大小，窗体返回到其原始大小 - 我得出结论，一旦我停止调整大小（让鼠标按钮向上），{{ 1}}使用旧的FormCanResize()值调用事件，然后将表单恢复为旧的大小。

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;

Answer 2

我认为你不能没有辅助。

这里我使用一个简单的整数字段来存储水平，垂直或者根本不是大小。你也可以为它声明一个枚举。

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

这是我对此的看法。在这里，我试图根据哪个被移动最多来调整宽度或高度。

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;

我非常喜欢Sertac的回答。简短又甜蜜。我已经开始基于他的代码了。但是当你在角落里调整大小时，Sertac的代码会有所帮助。对于特定的角落，它总是偏向垂直或水平。在这里，我尝试了不可知，并允许角度调整基于水平或垂直边缘，具体取决于您执行拖动的方式。

请注意，没有算法会完全令人满意。事实上，我认为如果我这样做，我会非常考虑禁用角落调整大小。

Answer 4

如果您使用firemonkey定位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;

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

4 个答案: