2

我需要我在 Delphi 中的表单可以调整大小，并且所有组件和控件都应该按比例拉伸，以及字体大小等。现在为了调整组件的大小，我在“OnResize”事件中编写了一个代码，并手动计算所有组件的大小和字体。我想要更简单的解决方案，我可以将其应用于不同的应用程序，而无需为每个表单重写此代码。我在网上找到了一些组件，但它们是共享软件。你能提出一些建议吗？

4

5 回答 5

3

您可以在每个控件上使用 Anchor 属性。这允许您将控件的侧面“锚定”到表单的特定侧面。

例如，如果您希望 TMemo 在调整大小时填充表单的中间，请将Anchor属性设置为[akLeft,akTop,akRight,akBottom]. 或者，如果您希望按钮在调整大小时跟随表单底部，请将Anchor属性设置为[akLeft,akBottom]

于 2010-03-22T07:46:07.953 回答
2

您可以使用我的“TArtPercentageWireGrid”组件。我已经用了很多年了。将其拖放到表单上，将任何组件放置在您喜欢的位置，然后当您更改表单大小时，组件的轮廓将按比例调整大小。布赖恩

unit UArtWireGrids;

interface


uses
  Windows,
  Messages,
  SysUtils,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs;

type

  float = double;

  TFloatPoint = record X, Y : float end;

  TFloatRect = record
    case Integer of
     0: (Left, Top, Right, Bottom: float);
     1: (TopLeft, BottomRight: TFloatPoint);
  end;



  TARTSimpleWireGrid = class(TGraphicControl)
  private
    { Private declarations }
    FGridSpacing : integer;
    FPen         : TPen;
    FBrush       : TBrush;
    procedure SetGridSpacing( AValue : integer );
    procedure SetBrush( AValue : TBrush );
    procedure SetPen( AValue : TPen );
  protected
    { Protected declarations }
    procedure Paint; override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
  published
    { Published declarations }
    property  Align;
    property  Brush : TBrush read FBrush write SetBrush;
    property  Pen : TPen read FPen write SetPen;
    property  GridSpacing : integer read FGridSpacing write SetGridSpacing;
    procedure StyleChanged(Sender : TObject);
    property  Visible;
  end;



  TGridStyle = ( gsLines, gsPoints );



  TARTPercentageWireGrid = class(TGraphicControl)
  private
    { Private declarations }
    FLineSpacing : double;
    FPen         : TPen;
    FBrush       : TBrush;
    FGridVisible : boolean;
    FGridStyle   : TGridStyle;
    procedure SetLineSpacing( AValue : double );
    procedure SetBrush( AValue : TBrush );
    procedure SetPen( AValue : TPen );
    function  GetLineSpacingPixelX : integer;
    function  GetLineSpacingPixelY : integer;
    procedure SetGridVisible( AState : boolean );
    procedure SetGridStyle( AValue : TGridStyle );
    function  RoundToGrid( AValue : float ) : float;
  protected
    { Protected declarations }
    procedure Paint; override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    procedure   DrawPointsOnCanvas( ACanvas : TCanvas );
    function    GridXToPixel( const AGridX : float ) : integer;
    function    GridYToPixel( const AGridY : float ) : integer;
    function    GridPointToPixel( const APoint : TFloatPoint ) : TPoint;
    function    GridRectToPixel( const ARect : TFloatRect ) : TRect;
    function    PixelXToGrid( AValue : integer ) : float;
    function    PixelYToGrid( AValue : integer ) : float;
    function    PixelPointToGrid( const APoint : TPoint ) : TFloatPoint;
    function    PixelRectToGrid( const ARect : TRect ) : TFloatRect;
    function    GridAlignPixelX( AValue : integer ) : integer;
    function    GridAlignPixelY( AValue : integer ) : integer;
    function    GridAlignPixelPoint( const APoint : TPoint ) : TPoint;
    function    GridAlignPixelRect( const ARect : TRect ) : TRect;
    function    MoveGridRect( const ARect : TFloatRect;
                              const ADeltaX, ADeltaY : float ) : TFloatRect;
    function    ScaleGridRect( const ARect  : TFloatRect;
                               const AScale : float ) : TFloatRect;
    function    GridLineXToPixel( AValue : integer ) : integer;
    function    GridLineYToPixel( AValue : integer ) : integer;
    function    GridLinePointToPixel( const APoint : TPoint ) : TPoint;
    function    GridLineRectToPixel( const ARect : TRect ) : TRect;
    function    PixelXToGridLine( AValue : integer ) : integer;
    function    PixelYToGridLine( AValue : integer ) : integer;
    function    PixelPointToGridLine( const APoint : TPoint ) : TPoint;
    function    PixelRectToGridLine( const ARect : TRect ) : TRect;
  published
    { Published declarations }
    property  Align;
    property  Brush : TBrush read FBrush write SetBrush;
    property  Pen : TPen read FPen write SetPen;
    property  LineSpacing : double read FLineSpacing write SetLineSpacing;
    property  LineSpacingPixelX : integer read GetLineSpacingPixelX;
    property  LineSpacingPixelY : integer read GetLineSpacingPixelY;
    procedure StyleChanged(Sender : TObject);
    property  Visible;
    property  GridVisible : boolean read FGridVisible write SetGridVisible;
    property  GridStyle   : TGridStyle read FGridStyle write SetGridSTyle;
  end;



implementation


{TARTSimpleWireGrid}
{ ---------------------------------------------------------------------------- }



constructor TARTSimpleWireGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPen            := TPen.Create;
  FPen.OnChange   := StyleChanged;
  FBrush          := TBrush.Create;
  FBrush.OnChange := StyleChanged;
  GridSpacing     := 20;
  Height          := 100;
  Width           := 100;
end;



destructor  TARTSimpleWireGrid.Destroy;
begin
  FPen.Free;
  FBrush.Free;
  Inherited Destroy;
end;


procedure TARTSimplewireGrid.SetGridSpacing( AValue : integer );
begin
  If AValue <> FGridSpacing then
    begin
    FGridSpacing := AValue;
    Invalidate;
    end;
end;

procedure TARTsimpleWireGrid.Paint;
var
 I : integer;
begin
   Inherited Paint;

   If FGridspacing < 20 then
    GridSpacing := 20;

   Canvas.Brush.Assign( FBrush );
   Canvas.Pen.Assign( FPen );

   // Vertical bars
   I := 0;
   While I < ClientWidth do
    begin
    Canvas.MoveTo( I,0 );
    Canvas.LineTo( I,ClientHeight);
    Inc(I,FGridSpacing);
    end;

   // Horiz bars
   I := 0;
   While I < ClientHeight do
    begin
    Canvas.MoveTo( 0,I );
    Canvas.LineTo( ClientWidth,I);
    Inc(I,FGridSpacing);
    end;
end;



procedure TARTSimplewireGrid.SetBrush( AValue : TBrush );
begin
  FBrush.Assign( AValue );
end;

procedure TARTSimplewireGrid.SetPen( AValue : TPen );
begin
  FPen.Assign( AValue );
end;


procedure TARTSimplewireGrid.StyleChanged(Sender : TObject);
begin
  Invalidate;
end;


//End TARTSimpleWireGrid

end.













{TARTPercentageWireGrid}
{ ---------------------------------------------------------------------------- }



constructor TARTPercentageWireGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  If AOwner is TForm then
    begin
    OnMouseDown := Tform(AOwner).OnMouseDown;
    OnMouseUp   := Tform(AOwner).OnMouseUp;
    OnMouseMove := Tform(AOwner).OnMouseMove;
    end;
  FPen            := TPen.Create;
  FPen.OnChange   := StyleChanged;
  FBrush          := TBrush.Create;
  FBrush.OnChange := StyleChanged;
  FGridVisible    := True;
  LineSpacing     := 10;
  Height          := 100;
  Width           := 100;
end;



destructor  TARTPercentageWireGrid.Destroy;
begin
  FPen.Free;
  FBrush.Free;
  Inherited Destroy;
end;


procedure TARTPercentagewireGrid.SetLineSpacing( AValue : double );
begin
  If AValue <> FLineSpacing then
    begin
    FLineSpacing := AValue;
    If FLineSpacing < 1.0 then
     FLineSpacing := 1.0;
    Invalidate;
    end;
end;



procedure TARTPercentagewireGrid.DrawPointsOnCanvas( ACanvas : TCanvas );
var
 X, Y   : integer;
 FX, FY : float;
  begin
   FY := 0.0;
   Repeat
    FY := FY + FLineSpacing;
    FX := 0.0;
    Y := GridYToPixel(FY);
    Repeat
     FX := FX + FLineSpacing;
     X := GridXToPixel(FX);
     ACanvas.Pixels[ X, Y ] := clBlack;
    until FX >= 100;
   until FY >= 100;
end;




procedure TARTPercentageWireGrid.Paint;

  procedure DrawLines;

    procedure LinesVert;
    var
     X : integer;
     F : double;
    begin
      F := 0.0;
      Repeat
       F := F + FLineSpacing;
       X := GridXToPixel(F);
       Canvas.MoveTo( X, 0 );
       Canvas.LineTo( X, Height );
      until X >= ClientWidth;
    end;

    procedure LinesHorz;
    var
     F : double;
     Y : integer;
    begin
      F := 0.0;
      Repeat
       F := F + FLineSpacing;
       Y := GridYToPixel(F);
       Canvas.MoveTo( 0, Y );
       Canvas.LineTo( Width, Y );
      until Y >= ClientHeight;
    end;

  begin
     LinesVert;
     LinesHorz;
  end;









begin
   Inherited Paint;

   If FGridVisible then
     begin
     Canvas.Brush.Assign( FBrush );
     Canvas.Pen.Assign( FPen );

     Case FGridStyle of
       gsLines  : DrawLines;
       gsPoints : DrawPointsOnCanvas( Canvas );
     end;
     end;

end;



procedure TARTPercentagewireGrid.SetBrush( AValue : TBrush );
begin
  FBrush.Assign( AValue );
end;

procedure TARTPercentagewireGrid.SetPen( AValue : TPen );
begin
  FPen.Assign( AValue );
end;


procedure TARTPercentagewireGrid.StyleChanged(Sender : TObject);
begin
  Invalidate;
end;



function TARTPercentageWireGrid.GridXToPixel( const AGridX : float ) : integer;
begin
  Result  := Round(AGridX * Width / 100);
end;


function TARTPercentageWireGrid.GridYToPixel( const AGridY : float ) : integer;
begin
  Result  := Round(AGridY * Height / 100);
end;



function TARTPercentageWireGrid.GetLineSpacingPixelX : integer;
begin
  Result := GridXToPixel( FLineSpacing );
end;

function TARTPercentageWireGrid.GetLineSpacingPixelY : integer;
begin
  Result := GridYToPixel( FLineSpacing );
end;


function TARTPercentageWireGrid.GridPointToPixel( const APoint : TFloatPoint ) : TPoint;
begin
  Result.X := GridXToPixel( APoint.X );
  Result.Y := GridYToPixel( APoint.Y );
end;


function TARTPercentageWireGrid.GridRectToPixel( const ARect : TFloatRect ) : TRect;
begin
  Result.TopLeft     := GridPointToPixel( ARect.TopLeft );
  Result.BottomRight := GridPointToPixel( ARect.BottomRight );
end;


function TARTPercentageWireGrid.PixelXToGrid( AValue : integer ) : float;
begin
  Result  := (Trunc(AValue) * 100) / Width;
end;


function TARTPercentageWireGrid.PixelYToGrid( AValue : integer ) : float;
begin
  Result  := (Trunc(AValue) * 100) / Height;
end;





function TARTPercentageWireGrid.PixelPointToGrid( const APoint : TPoint ) : TFloatPoint;
begin
  Result.X := PixelXToGrid( APoint.X );
  Result.Y := PixelYToGrid( APoint.Y );
end;

function TARTPercentageWireGrid.PixelRectToGrid( const ARect : TRect ) : TFloatRect;
begin
  Result.TopLeft     := PixelPointToGrid( ARect.TopLeft );
  Result.BottomRight := PixelPointToGrid( ARect.BottomRight );
end;


function TARTPercentageWireGrid.RoundToGrid( AValue : float ) : float;
begin
    Result := LineSpacing * Round( AValue / LineSpacing );
end;



function TARTPercentageWireGrid.GridAlignPixelX( AValue : integer ) : integer;
begin
  Result := GridXToPixel( RoundToGrid( PixelXToGrid( AValue )));
end;


function TARTPercentageWireGrid.GridAlignPixelY( AValue : integer ) : integer;
begin
  Result := GridYToPixel( RoundToGrid( PixelYToGrid( AValue )));
end;



function TARTPercentageWireGrid.GridAlignPixelPoint( const APoint : TPoint ) : TPoint;
begin
  Result.X := GridAlignPixelX( APoint.X );
  Result.Y := GridAlignPixelY( APoint.Y );
end;


function TARTPercentageWireGrid.GridAlignPixelRect( const ARect : TRect ) : TRect;
begin
  Result.TopLeft     := GridAlignPixelPoint( ARect.TopLeft );
  Result.BottomRight := GridAlignPixelPoint( ARect.BottomRight );

  // Its possible that aligning may have collapsed a width or height to
  // zero. If so, make it at least 1 unit in size
  If Result.Top = Result.Bottom then
    Result.Bottom := Result.Top + LineSpacingPixelY;
  If Result.Left = Result.Right then
    Result.Right := Result.Left + LineSpacingPixelX;

end;


procedure TARTPercentageWireGrid.SetGridVisible( AState : boolean );
begin
  If AState <> FGridVisible then
    begin
    FGridVisible := AState;
    Invalidate;
    end;
end;


function TARTPercentageWireGrid.MoveGridRect( const ARect : TFloatRect;
                                              const ADeltaX, ADeltaY : float ) : TFloatRect;
begin
  Result.Left   := ARect.Left + ADeltaX;
  Result.right  := ARect.Right + ADeltaX;
  Result.Top    := ARect.Top  + ADeltaY;
  Result.Bottom := ARect.Bottom + ADeltaY;
end;


function TARTPercentageWireGrid.ScaleGridRect( const ARect  : TFloatRect;
                                               const AScale : float ) : TFloatRect;
begin
  Result.Left   := ARect.Left * AScale;
  Result.right  := ARect.Right * Ascale;
  Result.Top    := ARect.Top  * AScale;
  Result.Bottom := ARect.Bottom * AScale;
end;


procedure TARTPercentageWireGrid.SetGridStyle( AValue : TGridStyle );
begin
   If AValue <> FGridStyle then
     begin
     FGridStyle := AValue;
     Invalidate;
     end;
end;


function TARTPercentageWireGrid.GridLineXToPixel( AValue : integer ) : integer;
begin
  Result  := GridXToPixel(Trunc(AValue) * LineSpacing);
end;

function TARTPercentageWireGrid.GridLineYToPixel( AValue : integer ) : integer;
begin
  Result  := GridYToPixel(Trunc(AValue) * LineSpacing);
end;



function TARTPercentageWireGrid.GridLinePointToPixel( const APoint : TPoint ) : TPoint;
begin
  Result.X   := GridLineXToPixel( APoint.X );
  Result.Y   := GridLineYToPixel( APoint.Y );
end;


function TARTPercentageWireGrid.GridLineRectToPixel( const ARect : TRect ) : TRect;
begin
  Result.TopLeft     := GridLinePointToPixel( ARect.TopLeft );
  Result.BottomRight := GridLinePointToPixel( ARect.BottomRight );
end;


function TARTPercentageWireGrid.PixelXToGridLine( AValue : integer ) : integer;
begin
  Result  := Round(PixelXToGrid( AValue ) / FLineSpacing);
end;


function TARTPercentageWireGrid.PixelYToGridLine( AValue : integer ) : integer;
begin
  Result  := Round(PixelYToGrid( AValue ) / FLineSpacing);
end;


function TARTPercentageWireGrid.PixelPointToGridLine( const APoint : TPoint ) : TPoint;
begin
  Result.X := PixelXToGridLine( APoint.X );
  Result.Y := PixelYToGridLine( APoint.Y );
end;

function TARTPercentageWireGrid.PixelRectToGridLine( const ARect : TRect ) : TRect;
begin
  Result.TopLeft     := PixelPointToGridLine( ARect.TopLeft );
  Result.BottomRight := PixelPointToGridLine( ARect.BottomRight );
end;


{End TARTPercentageWireGrid}
{ ---------------------------------------------------------------------------- }

更多信息：

@Ulrich 和其他人：对不起，我忘记了几件事。简单示例如下：

  1. 让网格正常工作 - 将其设置为 Align=alClient ，当调整表单大小时，您应该会看到网格随之调整大小。

  2. 声明以下表单 PRIVATE 字段：

    FBounds : TFloatRect 数组；

  3. 假设您只想要一个调整大小的按钮“Button1”。将以下内容放入 FormCreate：

    SetLength(FBounds, 1); FBounds[0] := ARTPercentageWireGrid1.PixelRectToGrid( Button1.BoundsRect );

  4. 最后，将以下内容放入 FormResize 中：

    Button1.BoundsRect := ARTPercentageWireGrid1.GridRectToPixel( FBounds[0] );

当您调整表单大小时，按钮将按比例跟踪表单。要使用所有控件，请执行以下操作：

procedure TForm1.FormResize(Sender: TObject);
var
   I : integer;
begin
  //Button1.BoundsRect := ARTPercentageWireGrid1.GridRectToPixel( FBounds[0] );

  For I := 0 to ComponentCount-1 do
    If Components[I] is TControl then
      With Components[I] as TControl do
        If Align <> alClient then
          BoundsRect := ARTPercentageWireGrid1.GridRectToPixel( FBounds[I] );

end;

procedure TForm1.FormCreate(Sender: TObject);
var
  I : integer;
begin
  //SetLength( FBounds, 1 );
  //FBounds[0] := ARTPercentageWireGrid1.PixelRectToGrid( Button1.BoundsRect );

  SetLength( FBounds, ComponentCount );
  For I := 0 to ComponentCount-1 do
    If Components[I] is TControl then
      With Components[I] as TControl do
        If Align <> alClient then
          FBounds[I] := ARTPercentageWireGrid1.PixelRectToGrid( BoundsRect );
end;

为杂乱无章的代码道歉。布赖恩。

于 2010-03-22T10:37:38.103 回答
1

有用的代码块（在进行了所有更改之后），但是，因为它在 3 年后发布，它无法正常工作，因为该组件未注册。您需要 implementation 在单元中的语句周围添加以下代码，然后才能添加组件。

    procedure Register;

    implementation

    procedure Register;
    begin
      RegisterComponents('ComponentName', [TARTPercentageWireGrid]);
    end;
于 2013-10-08T07:53:42.543 回答
0

如果您对在 OnResize 事件中使用的代码感到满意，那么创建您自己的包含此代码的自定义组件可能是值得的。这将简化这些组件的未来使用。

于 2010-03-22T08:28:50.647 回答
0

检查Delphi 的ResizeKit组件。它可以调整组件和字体的大小。
有免费试用下载。

于 2010-03-23T11:46:31.843 回答