What is a best free way to make form resizeable in Delphi 7?
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.
加载中,请稍侯......
精彩评论