paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-15 13:03:04 +02:00
Code Issues Packages Projects Releases Wiki Activity

lcl: add ScalyBy and ChangeScale by Zaher Dirkey (mantis #0017250)

Browse Source 
git-svn-id: trunk@28174 -
This commit is contained in:
paul 2010-11-10 06:46:42 +00:00
parent 3a9c1584fa
commit 0db1bd73c2
3 changed files with 60 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lcl/controls.pp
View File

@ -1053,6 +1053,7 @@ type
procedure UpdateAnchorRules;
procedure ChangeBounds(ALeft, ATop, AWidth, AHeight: integer; KeepBase: boolean); virtual;
procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); virtual;
procedure ScaleConstraints(Multiplier, Divider: Integer);
procedure ChangeScale(Multiplier, Divider: Integer); virtual;
function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; virtual;
procedure UpdateAlignIndex;
@ -1741,6 +1742,8 @@ type
procedure PaintHandler(var TheMessage: TLMPaint);
procedure PaintWindow(DC: HDC); virtual;
procedure CreateBrush; virtual;
procedure ScaleControls(Multiplier, Divider: Integer); virtual;
procedure ChangeScale(Multiplier, Divider: Integer); override;
protected
// messages
procedure CMBiDiModeChanged(var Message: TLMessage); message CM_BIDIMODECHANGED;
@ -1951,6 +1954,7 @@ type
procedure Update; override;
procedure SetFocus; virtual;
procedure FlipChildren(AllLevels: Boolean); virtual;
procedure ScaleBy(Multiplier, Divider: Integer);
function GetDockCaption(AControl: TControl): String; virtual;
procedure UpdateDockCaption(Exclude: TControl = nil); virtual;
procedure GetTabOrderList(List: TFPList);

31
lcl/include/control.inc
View File

@ -450,15 +450,42 @@ begin
if Parent <> nil then Parent.InvalidatePreferredSize;
end;
procedure TControl.ScaleConstraints(Multiplier, Divider: Integer);
begin
with Constraints do
begin
if MinWidth > 0 then
MinWidth := MulDiv(MinWidth, Multiplier, Divider);
if MaxWidth > 0 then
MaxWidth := MulDiv(MaxWidth, Multiplier, Divider);
if MinHeight > 0 then
MinHeight := MulDiv(MinHeight, Multiplier, Divider);
if MaxHeight > 0 then
MaxHeight := MulDiv(MaxHeight, Multiplier, Divider);
end;
end;
{------------------------------------------------------------------------------
TControl.ChangeScale
Scale contorl by factor Multiplier/Divider
------------------------------------------------------------------------------}
procedure TControl.ChangeScale(Multiplier, Divider: Integer);
var
R: TRect;
begin
// TODO: TCONTROL.CHANGESCALE
//Assert(False, 'Trace:TODO: [TControl.ChangeScale]');
if Multiplier <> Divider then
begin
ScaleConstraints(Multiplier, Divider);
if not ParentFont then
Font.Size := MulDiv(Font.Size, Multiplier, Divider);
R := BaseBounds;
R.Left := MulDiv(R.Left, Multiplier, Divider);
R.Top := MulDiv(R.Top, Multiplier, Divider);
R.Right := MulDiv(R.Right, Multiplier, Divider);
R.Bottom := MulDiv(R.Bottom, Multiplier, Divider);
BoundsRect := R;
end;
end;
{------------------------------------------------------------------------------

27
lcl/include/wincontrol.inc
View File

@ -4394,6 +4394,11 @@ begin
end;
end;
procedure TWinControl.ScaleBy(Multiplier, Divider: Integer);
begin
ChangeScale(Multiplier, Divider);
end;
{------------------------------------------------------------------------------}
{ TWinControl FindNextControl }
{------------------------------------------------------------------------------}
@ -4828,6 +4833,28 @@ begin
FBrush.Color := Color;
end;
procedure TWinControl.ScaleControls(Multiplier, Divider: Integer);
var
i: Integer;
begin
for i := 0 to ControlCount - 1 do
Controls[i].ChangeScale(Multiplier, Divider);
end;
procedure TWinControl.ChangeScale(Multiplier, Divider: Integer);
begin
if Multiplier <> Divider then
begin
DisableAlign;
try
inherited;
ScaleControls(Multiplier, Divider);
finally
EnableAlign;
end;
end;
end;
{------------------------------------------------------------------------------
procedure TWinControl.EraseBackground;
------------------------------------------------------------------------------}