LCL: headercontrol: implement ChangeScale, issue #30812, patch by Anton Kavalenka

git-svn-id: trunk@53251 -

lcl/comctrls.pp

@@ -3846,6 +3846,7 @@ type
     function GetSectionAt(P: TPoint): Integer;
     procedure Paint; override;
     procedure PaintSection(Index: Integer); virtual;
+    procedure ChangeScale(M, D: Integer);override;
   published
     property DragReorder: boolean read FDragReorder write FDragReorder;
     property Images: TCustomImageList read FImages write SetImages;

lcl/include/headercontrol.inc

@@ -417,6 +417,25 @@ begin
     ThemeServices.DrawText(Canvas, Details, Section.Text, ContentRect, AlignmentMap[Section.Alignment] or DT_VCENTER or DT_SINGLELINE, 0);
 end;
 
+procedure TCustomHeaderControl.ChangeScale(M, D: Integer);
+var
+  I: integer;
+  Sect: THeaderSection;
+begin
+  inherited;
+
+  Sections.BeginUpdate;
+  try
+    for I := 0 to Sections.Count-1 do
+    begin
+      Sect := Sections.Items[I];
+      Sect.Width := MulDiv(Sect.Width, M, D);
+    end;
+  finally
+    Sections.EndUpdate;
+  end;
+end;
+
 { THeaderSections }
 
 function THeaderSections.GetItem(Index: Integer): THeaderSection;