[Lazarus] TControl.ChangeScale impl

Alexey aaa5500 at ya.ru
Fri Sep 1 07:29:42 CEST 2017


There is such procedure. why not to rewrite it via call to 
AutoAdjustLayout. to not have "dup" code.

procedure TControl.ChangeScale(Multiplier, Divider: Integer);
var
   R: TRect;
begin
   if Multiplier <> Divider then
   begin
     ScaleConstraints(Multiplier, Divider);
     if not ParentFont then
       Font.Height := MulDiv(GetFontData(Font.Reference.Handle).Height, 
Multiplier, Divider);
     R := BaseBounds;
     if (Self is TCustomForm) and (GetParentForm(Self, True) = Self) then
     begin
       //Dont change Left,Top if this is the topmost form
       R.Right := R.Left + MulDiv(R.Right-R.Left, Multiplier, Divider);
       R.Bottom := R.Top + MulDiv(R.Bottom-R.Top, Multiplier, Divider);
     end
     else
     begin
       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);
     end;
     BoundsRect := R;
   end;
end;

-- 
Regards,
Alexey



More information about the Lazarus mailing list