Constrain proportion for TControl

Question

How can I create constrain proportion for a TControl (in my case TGraphicControl)?
So if I change it's Width - the Height will change proportionality (and vice versa).
Also if I set BoundsRect the control should maintain the proportions. In my control I have an AspectRatio: TPoint property, setting:

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

So now my AspectRatioFactor = 4/3. and this proportion should maintain always.

How can this be done?

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.

Overriding Setbounds will ensure that the given AspectRatio is maintained.
AdjustSize in the Setter of AspectRatio will ensure the changing of AspectRatio will applied at once.
The button events are only implemented for demonstration.

Answer 2

Override the CanResize virtual method in your control:

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

This makes width be the master dimension. If you want height to be in charge then you can re-arrange the formula.

You could try to be intelligent in choosing which dimension is the master.

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;

You will also need to add code to your property setter for the AspectRatio property. Because a modification of that property will need to provoke a re-sizing of the control.