限制TControl的比例

Zig*_*giZ 2 delphi delphi-7

如何为TControl 创建约束比例(在我的情况下为TGraphicControl)?
因此,如果我改变它Width- Height意志改变比例(反之亦然).
另外,如果我设置BoundsRect控件应保持比例.在我的控制下,我有一个AspectRatio: TPoint属性,设置:

AspectRatio.X := 4;
AspectRatio.Y := 3;
Run Code Online (Sandbox Code Playgroud)

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

如何才能做到这一点?

bum*_*mmi 6

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.
Run Code Online (Sandbox Code Playgroud)

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

  • @DavidHeffernan谢谢,我在完成我的帖子后确实看到了它.我现在不会改变它,所以两者都可以相反.您的评论将引导其他读者. (5认同)