lazarus/lcl/include/customdesigncontrol.inc

{%MainUnit ../forms.pp}

{
 *****************************************************************************
  This file is part of the Lazarus Component Library (LCL)

  See the file COPYING.modifiedLGPL.txt, included in this distribution,
  for details about the license.
 *****************************************************************************
}

{ TCustomDesignControl }

constructor TCustomDesignControl.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);

  FScaled := True;
  FDesignTimePPI := 96;
  FPixelsPerInch := FDesignTimePPI;
  if Application.Scaled then
    Font.PixelsPerInch := FDesignTimePPI;
end;

procedure TCustomDesignControl.AutoAdjustLayout(AMode: TLayoutAdjustmentPolicy;
  const AFromPPI, AToPPI, AOldFormWidth, ANewFormWidth: Integer);
begin
  inherited;

  if AMode = lapAutoAdjustForDPI then
    FPixelsPerInch := AToPPI;
end;

procedure TCustomDesignControl.DoAutoAdjustLayout(
  const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double
  );
var
  NewWidth, NewHeight: Integer;
begin
  if Assigned(Parent) then
  begin
    inherited;
    Exit;
  end;

  // Apply the changes
  if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
  begin
    NewWidth := Round(Width*AXProportion);
    NewHeight := Round(Height*AYProportion);

    BorderSpacing.AutoAdjustLayout(AXProportion, AYProportion);
    Constraints.AutoAdjustLayout(AXProportion, AYProportion);

    SetBounds(Left, Top, NewWidth, NewHeight);
  end;
end;

procedure TCustomDesignControl.Loaded;
  procedure FixChildren(const AParent: TWinControl);
  var
    I: Integer;
  begin
    for I := 0 to AParent.ControlCount-1 do
    begin
      AParent.Controls[I].FixDesignFontsPPI(FDesignTimePPI);
      if AParent.Controls[I] is TWinControl then
        FixChildren(TWinControl(AParent.Controls[I]));
    end;
  end;
begin
  inherited Loaded;

  FPixelsPerInch := FDesignTimePPI;

  if Application.Scaled and Scaled then
  begin
    FixDesignFontsPPI(FDesignTimePPI);
    FixChildren(Self);
  end;
end;

procedure TCustomDesignControl.SetDesignTimePPI(const ADesignTimePPI: Integer);
begin
  if FDesignTimePPI=ADesignTimePPI then
    Exit;

  if (csLoading in ComponentState) // allow setting only when loading
  or not (csDesigning in ComponentState) // or in runtime (the programmer has to know why he is doing that)
  or ((csDesigning in ComponentState) and (ADesignTimePPI=Screen.PixelsPerInch)) // or in designtime when setting the correct value
  then
    FDesignTimePPI := ADesignTimePPI
  else
    raise EInvalidOperation.Create(sCannotSetDesignTimePPI);
end;

procedure TCustomDesignControl.SetScaled(const AScaled: Boolean);
begin
  if FScaled=AScaled then
    Exit;

  FScaled := AScaled;
  if not FScaled then
    Font.PixelsPerInch := Screen.PixelsPerInch;
end;