2

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

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

所以现在我的AspectRatioFactor = 4/3. 并且这个比例应该一直保持。

如何才能做到这一点？

4

2 回答 2

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.

覆盖 Setbounds 将确保保持给定的 AspectRatio。
AspectRatio 的 Setter 中的 AdjustSize 将确保立即应用 AspectRatio 的更改。
按钮事件仅用于演示。

于 2012-12-30T18:11:34.480 回答
4

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

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

这使得宽度成为主要尺寸。如果您希望高度负责，那么您可以重新安排公式。

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

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。因为对该属性的修改将需要引起控件的重新调整大小。

于 2012-12-30T17:55:57.680 回答