Изменить форму и сохранить пропорции

подобный вопрос здесь: изменение размера формы при сохранении соотношения сторон

в основном, я хочу изменить размер формы и сохранить ее соотношение сторон, но я хочу изменить размер, чтобы следовать курсору. Ответ в теме выше предоставил решение, которое наполовину удовлетворительно-оно работает, но изменение размера работает 2x медленнее, чем должно. Когда я начну изменять размер формы по оси X, вы увидите, где находится курсор и какой размер формы есть:

http://i.imgur.com/SUIli7N.png

Я думал, что, поскольку он изменяет размер 2x медленнее, я должен опустить 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 и set NewWidth значение для соответствующего значения. Это также приводит к странным результатам, когда я перетаскиваю форму по оси X, кажется, работает, и как только я прекращаю изменять размер, форма возвращается к своему исходному размеру - я пришел к выводу, что как только я прекращаю изменять размер (пусть кнопка мыши вверх), FormCanResize() событие вызывается со старыми NewHeight значение, которое затем возвращает форму обратно к ее старому размеру.

7
delphi delphi-xe2

4 ответов

правильное сообщение для обработки этого -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;
6

Я не думаю, что можно обойтись без вспомогательных.

здесь я использую простое целое поле для хранения размера по горизонтали, вертикали или вообще нет. Вы также можете объявить перечисление для этого.

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

вот мой взгляд на это. Здесь я пытаюсь основать размер на ширине или высоте в зависимости от того, какой из них был перемещен больше всего.

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 принимает стороны при изменении размера в углах. Для определенного угла он всегда благоприятствует вертикальному или горизонтальному. Здесь я попытался быть агностиком и разрешить изменение размера угла на основе горизонтальных или вертикальных ребер, в зависимости от того, как вы выполните перетаскивание.

обратите внимание, что ни один алгоритм не будет полностью удовлетворительным. На самом деле, я думаю, что если бы я делал это, я бы очень подумал об отключении изменения размера угла.

2

Если вы нацелены на OSX с помощью firemonkey, соответствующий 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