Question

如何为TControl创建约束比例（在我的情况下为TGraphicControl）？
因此，如果我更改Width - Height将改变比例（反之亦然）。
此外，如果我设置BoundsRect，控件应保持比例。在我的控制下，我有AspectRatio: TPoint属性，设置：

AspectRatio.X := 4;
AspectRatio.Y := 3;

现在我的AspectRatioFactor = 4/3。这个比例应该始终保持。

如何做到这一点？

Answer 1

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TPanel = Class(ExtCtrls.TPanel)
  private
    FAspectRatio: TPoint;
    procedure SetAspectRatio(const Value: TPoint);
  public
    constructor Create(AOwner: TComponent); override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    property AspectRatio: TPoint read FAspectRatio write SetAspectRatio;
  end;

  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
{ TPanel }

constructor TPanel.Create(AOwner: TComponent);
begin
  inherited;
  FAspectRatio.X := 4;
  FAspectRatio.Y := 3;
end;

procedure TPanel.SetAspectRatio(const Value: TPoint);
begin
  FAspectRatio := Value;
  AdjustSize;
end;

procedure TPanel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
  vh: Double;
begin
  if FAspectRatio.Y <> 0 then
  begin
    vh := FAspectRatio.X / FAspectRatio.Y;
    if Round(AHeight * vh) <> AWidth then
    begin
      if AWidth <> Width then
        AHeight := Round(AWidth / vh)
      else
        AWidth := Round(AHeight * vh);
    end;
  end;
  inherited;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Panel1.Width := 101;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Panel1.Height := 101;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  p: TPoint;
begin
  p.X := 5;
  p.Y := 3;
  Panel1.AspectRatio := p;
end;

end.

重写Setbounds将确保维持给定的AspectRatio AspectRatio设置器中的AdjustSize将确保一次应用AspectRatio的更改按钮事件仅用于演示。

Answer 2

覆盖控件中的CanResize虚拟方法：

function TMyControl.CanResize(var NewWidth, NewHeight: Integer): Boolean;
begin
  NewHeight := MulDiv(NewWidth, AspectRatio.Y, AspectRatio.X); 
  Result := True;
end;

这使得width成为主维度。如果你想要高度负责，那么你可以重新安排公式。

你可以尝试聪明地选择哪个维度是主人。

function TMyControl.CanResize(var NewWidth, NewHeight: Integer): Boolean;
begin
  if abs(NewWidth-Width)>abs(NewHeight-Height) then
    NewHeight := MulDiv(NewWidth, AspectRatio.Y, AspectRatio.X)
  else
    NewWidth := MulDiv(NewHeight, AspectRatio.X, AspectRatio.Y);
  Result := True;
end;

您还需要为AspectRatio属性的属性设置器添加代码。因为对该属性的修改将需要激活控件的重新调整大小。

限制TControl的比例

2 个答案: