Index: controls.pp
===================================================================
--- controls.pp	(revision 27167)
+++ controls.pp	(working copy)
@@ -1052,6 +1052,7 @@
     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;
@@ -1738,6 +1739,8 @@
     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;
@@ -1948,6 +1951,7 @@
     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);
Index: include/control.inc
===================================================================
--- include/control.inc	(revision 27167)
+++ include/control.inc	(working copy)
@@ -450,15 +450,42 @@
   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;
 
 {------------------------------------------------------------------------------
Index: include/wincontrol.inc
===================================================================
--- include/wincontrol.inc	(revision 27167)
+++ include/wincontrol.inc	(working copy)
@@ -4389,6 +4389,11 @@
   end;
 end;
 
+procedure TWinControl.ScaleBy(Multiplier, Divider: Integer);
+begin
+  ChangeScale(Multiplier, Divider);
+end;
+
 {------------------------------------------------------------------------------}
 {  TWinControl FindNextControl                                                 }
 {------------------------------------------------------------------------------}
@@ -4817,6 +4822,28 @@
   // ToDo: ParentColor
 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;
 ------------------------------------------------------------------------------}

unit uscaleby;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,Forms,Controls;

type
  TCustomClassScaler=tclass;
  TScaleProcedure=procedure(const AControl: TControl;const AOrigin,ATarget: SizeUint);

  TRegisteredScaler=record
    ClassToScale: TCustomClassScaler;
    ClassScaleProcedure: TScaleProcedure;
  end;

procedure ScaleBy(const AControl: TControl;const AOrigin,ATarget: SizeUint);
procedure ScaleByRecursive(const AControl: TControl;const AOrigin,ATarget: SizeUint);
procedure ScaleRectBy(var ARect: TRect;const AOrigin,ATarget: SizeUint);
procedure ScaleByRegisterScaler(const AScaleClass: tclass;const AScaler: TScaleProcedure);

implementation

var
  Scalers: array of TRegisteredScaler;

function FindRegisteredScaler(const AControl: TControl): TScaleProcedure; forward;

procedure ScaleBy(const AControl: TControl; const AOrigin, ATarget: SizeUint
  );
var
  TheRect: TRect;
begin
  if AOrigin=ATarget then exit;
  //If control is aligned only some things should be chaned based in which
  //alignement it has.
  if AControl.Align=alClient then begin
    //Nothing to do, it has been autoresized when the parent has been resized.
    Exit;
  end;

  //First scale the constraints.
  TheRect.Left   := AControl.Constraints.MinWidth;
  TheRect.Right  := AControl.Constraints.MaxWidth;
  TheRect.Top    := AControl.Constraints.MinHeight;
  TheRect.Bottom := AControl.Constraints.MaxHeight;
  ScaleRectBy(TheRect,AOrigin,ATarget);
  AControl.Constraints.MinWidth  := TheRect.Left;
  AControl.Constraints.MaxWidth  := TheRect.Right;
  AControl.Constraints.MinHeight := TheRect.Top;
  AControl.Constraints.MaxHeight := TheRect.Bottom;

  //Now scale the origin and size of the control.
  TheRect.Left   := AControl.Left;
  TheRect.Right  := AControl.Width;
  TheRect.Top    := AControl.Top;
  TheRect.Bottom := AControl.Height;
  ScaleRectBy(TheRect,AOrigin,ATarget);
  if (AControl.Align=AlNone) or (AControl.Align=alCustom) then begin
    if (akLeft in AControl.Anchors) then begin
      AControl.Left   := TheRect.Left;
    end;
    if not (akRight in AControl.Anchors) then begin
      AControl.Width  := TheRect.Right;
    end;
    if (akTop in AControl.Anchors) then begin
      AControl.Top    := TheRect.Top;
    end;
    if not (akBottom in AControl.Anchors) then begin
      AControl.Height := TheRect.Bottom;
    end;
  end else begin
    if ((AControl.Align=alTop) or (AControl.Align=alBottom)) and (not (akBottom in AControl.Anchors)) then begin
      //Only scale the height...
      AControl.Height := TheRect.Bottom;
    end else if ((AControl.Align=alLeft) or (AControl.Align=alRight)) and (not (akRight in AControl.Anchors)) then begin
      //Only scale the width...
      AControl.Width := TheRect.Right;
    end;
  end;
  TheRect.Left   := AControl.Left;
  TheRect.Right  := AControl.Width;
  TheRect.Top    := AControl.Top;
  TheRect.Bottom := AControl.Height;
end;

procedure ScaleByRecursive(const AControl: TControl; const AOrigin,
  ATarget: SizeUint);
var
  j: SizeUint;
  TheControl: TControl;
  TheWinControl: TWinControl;
  Scaler: TScaleProcedure;
begin
  if AOrigin=ATarget then exit;
  Scaler:=FindRegisteredScaler(AControl);
  Scaler(AControl,AOrigin,ATarget);
  if AControl is TWinControl then begin
    TheWinControl:=TWinControl(AControl);
    if TheWinControl.ControlCount>0 then begin
      for j := 0 to TheWinControl.ControlCount-1 do begin
        TheControl:=TheWinControl.Controls[j];
        if TheControl is TControl then begin
          ScaleByRecursive(TheWinControl.Controls[j],AOrigin,ATarget);
        end;
      end;
    end;
  end;
end;

procedure ScaleRectBy(var ARect: TRect; const AOrigin, ATarget: SizeUint);
begin
  ARect.Top:=ARect.Top*int64(ATarget) div int64(AOrigin);
  ARect.Left:=ARect.Left*int64(ATarget) div int64(AOrigin);
  ARect.Right:=ARect.Right*int64(ATarget) div int64(AOrigin);
  ARect.Bottom:=ARect.Bottom*int64(ATarget) div int64(AOrigin);
end;

procedure ScaleByRegisterScaler(const AScaleClass: tclass;
  const AScaler: TScaleProcedure);
begin
  SetLength(Scalers,Length(Scalers)+1);
  with Scalers[High(Scalers)] do begin
    ClassToScale:=AScaleClass;
    ClassScaleProcedure:=AScaler;
  end;
end;

function FindRegisteredScaler(const AControl: TControl): TScaleProcedure;
var
  j: SizeInt;
begin
  for j := 0 to High(Scalers) do begin
    if AControl.ClassType=Scalers[j].ClassToScale then begin
      Result:=Scalers[j].ClassScaleProcedure;
      Exit;
    end;
  end;
  //Default is the default ScaleBy
  Result:=@ScaleBy;
end;

end.

unit uscalebycomctrls;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,uscaleby,Controls,ComCtrls;

implementation

procedure ListViewScaleBy(const AControl: TControl; const AOrigin,
  ATarget: SizeUint);
var
  j: SizeUint;
  TheCol: TListColumn;
  ListView: TListView;
begin
  ListView:=TListView(AControl);
  //ListView only scales the columns size in report mode
  for j := 0 to ListView.Columns.Count-1 do begin
    TheCol:=ListView.Columns[j];
    TheCol.Width:=TheCol.Width*ATarget div AOrigin;
  end;
end;

procedure StatusBarScaleBy(const AControl: TControl; const AOrigin,
  ATarget: SizeUint);
var
  j: SizeUint;
  ThePanel: TStatusPanel;
  StatusBar: TStatusBar;
begin
  StatusBar:=TStatusBar(AControl);
  //Status only scales the panel width
  for j := 0 to StatusBar.Panels.Count-1 do begin
    ThePanel:=StatusBar.Panels[j];
    ThePanel.Width:=ThePanel.Width*int64(ATarget) div AOrigin;
  end;
end;

initialization
  ScaleByRegisterScaler(TListView,@ListViewScaleBy);
  ScaleByRegisterScaler(TStatusBar,@StatusBarScaleBy);

end.