What is a best free way to make form resizeable in Delphi 7?

2022-12-24 11:07 问答作者：

I need my form in Delphi to be resizeable, and all components and controls should stretch proportionally, along with font sizes etc. Right now in order to resize components I write a code inside "OnResize" event, and manually calculate all components' sizes and fonts. I would like to have more simple solution, which I can apply to different applications without rewriting this code for each form. I found some components on 开发者_JS百科the web, but they are shareware. Can you suggest something?

You can use the Anchor property on each control. This allows you to "anchor" the sides of the control to a particular side of the form.

For instance, if you want a TMemo to fill the middle of a form as it is resized, set Anchor property to [akLeft,akTop,akRight,akBottom]. Or, if you want a button to follow the bottom of a form as you resize it, set the Anchor property to [akLeft,akBottom]

You can use my 'TArtPercentageWireGrid' component. I've used it for years. Drop it onto a form, place any component where you like and then as you change the form size, the outline of the component will resize in proportion. Brian

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}
{ ---------------------------------------------------------------------------- }

More info:

@Ulrich and others: I'm sorry, I had forgotten a couple of things. Simple example follows:

Get the grid working - set it Align=alClient and when form is resized you should see the grid resize with it.
Declare the following form PRIVATE field:

FBounds : array of TFloatRect;
Assume you only want a single button resized 'Button1'. Put the following in FormCreate:

SetLength( FBounds, 1 ); FBounds[0] := ARTPercentageWireGrid1.PixelRectToGrid( Button1.BoundsRect );
Finally, put the following in FormResize:

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

When you resize the form, the button will track the form in proportion. To work with all controls do:

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;

Apologies for the scrappy code. Brian.

Useful block of code (after all the changes had been made) but, as it is posted now 3 years later, it is not working as the component is not registered. You would need to add the following code around the implementation statement in the unit before you can add the component.

    procedure Register;

    implementation

    procedure Register;
    begin
      RegisterComponents('ComponentName', [TARTPercentageWireGrid]);
    end;

If you are happy with the code you have used in the OnResize event, it may be worthwhile creating your own custom components incorporating this code. This would then simplify future use of these components.

Check ResizeKit component for Delphi. It can resize components and fonts.
There is free trial download.

继续阅读：components controls delphi resize stretch

What is a best free way to make form resizeable in Delphi 7?

更多精彩内容

精彩评论

最新问答

第一次出国飞行流程+注意事项？

再生油（关于再生油的介绍）？

东莞科技进修学院（关于东莞科技进修学院的介绍）？

均为镇政府人员平均年龄不超30？

手机msn在哪里下载（其实很简单）？

问答排行榜

王昌瑞《潜梦追凶》剧组庆生新锐演员未来可期？

Is it allowed to ask users to enter credit card details for own payment method?

Escaping "<" in Perl-generated XML

imessage会显示已读吗？

微信重新建群怎么建？