Scaling (DPI Change) + Anchors

[Attila Kovacs 617]

Could you help me identify from which Delphi version this works correctly? If it does at all.....

 

Anchors are akTop + akRight

 

original:

 

pressing "+", (scale up with 24dpi)

 

 

the same thing happens if the anchors are akTop + akLeft + akRigt

 

I'm on Berlin U2. A hint or a patch or workaround would also be appreciated if available.

 

 

Scale-Test.7z

[Stano 140]

Try putting them on the panel. This is a common solution.

[Attila Kovacs 617]

12 minutes ago, Stano said:

Try putting them on the panel. This is a common solution.

They are on a TPanel. o.O

[Stano 140]

To clarify. I meant a custom panel for each group.

[Attila Kovacs 617]

33 minutes ago, Stano said:

To clarify. I meant a custom panel for each group.

 

didn't work, the bottom pane is now on 3 panels in groups

[Uwe Raabe 1891]

Tested in 10.3.3 and 11.3 - works in both of them.

 

Update: Works also in 10.2.3, but fails in 10.1.2

Edited August 18, 2023 by Uwe Raabe

[Attila Kovacs 617]

It seems I can't postpone an upgrade much longer, perhaps I can bridge it until then with this.

Very basic, only tested with the form from above, (also inserting/removing components may break it)...

 

unit AnchorPanel;

interface

uses
  Winapi.Windows,
  Winapi.Messages,

  System.Classes,

  Vcl.Controls,
  Vcl.ExtCtrls;

type
  TControl = class(Vcl.Controls.TControl);

  TControlData = record
    Anchors: TAnchors;
    Bounds: TRect;
    Align: TAlign;
    IsScaling: boolean;
  end;

  TAnchorPanel = class(TPanel)
  private
    FOriginalSize: TRect;
    FControlData: TArray<TControlData>;
    FCalcWidth: integer;
    FCalcHeight: integer;
    FScale: single;
    procedure SaveControls;
    procedure ResizeControls;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
  protected
    procedure ChangeScale(M, D: integer; isDpiChange: boolean); override;
    procedure Loaded; override;
  public
  published
  end;

procedure Register;

implementation


procedure Register;
begin
  RegisterComponents('Samples', [TAnchorPanel]);
end;

{ TAnchorPanel }


procedure TAnchorPanel.ChangeScale(M, D: integer; isDpiChange: boolean);
var
  i: integer;
begin
  if (csDesigning in ComponentState) then
  begin
    inherited ChangeScale(M, D, isDpiChange);
  end
  else
  begin
    SaveControls;
    inherited ChangeScale(M, D, True);
    if csLoading in ComponentState then
    begin
      FCalcWidth := Width;
      FCalcHeight := Height;
      FScale := 1;
    end
    else
    begin
      FCalcWidth := MulDiv(Width, M, D);
      FCalcHeight := MulDiv(Height, M, D);
      FScale := FScale * M / D;
    end;
    if not isDpiChange then
    begin
      for i := 0 to ControlCount - 1 do
      begin
        FControlData[i].IsScaling := True;
        TControl(Controls[i]).ChangeScale(M, D, isDpiChange);
      end;
    end;
  end;
end;


procedure TAnchorPanel.Loaded;
begin
  inherited;
  if not(csDesigning in ComponentState) then
  begin
    FOriginalSize := Self.BoundsRect;
    FCalcWidth := Self.Width;
  end;
end;


procedure TAnchorPanel.ResizeControls;
var
  i: integer;
begin
  if FOriginalSize.Width <> 0 then
    for i := 0 to High(FControlData) do
    begin
      if FControlData[i].Align = alNone then
        if akRight in FControlData[i].Anchors then
        begin
          if akLeft in FControlData[i].Anchors then
          begin
            Controls[i].Width := Trunc(FControlData[i].Bounds.Width * FScale) + Trunc(Self.Width - (FOriginalSize.Width * FScale));
          end
          else
          begin
            if not FControlData[i].IsScaling then
              Controls[i].Left := Trunc(FControlData[i].Bounds.Left * FScale) + (Self.Width - FCalcWidth) + Trunc(FCalcWidth - (FOriginalSize.Width * FScale));
          end;
        end;
      FControlData[i].IsScaling := False;
    end;
end;


procedure TAnchorPanel.SaveControls;
var
  i: integer;
begin
  if not(csDesigning in ComponentState) then
  begin
    if Length(FControlData) <> Self.ControlCount then
    begin
      SetLength(FControlData, Self.ControlCount);
      for i := 0 to Self.ControlCount - 1 do
      begin
        FControlData[i].Anchors := Self.Controls[i].Anchors;
        FControlData[i].Bounds := Self.Controls[i].BoundsRect;
        FControlData[i].Align := Self.Controls[i].Align;
        FControlData[i].IsScaling := False;
        Self.Controls[i].Anchors := [akLeft, akTop];
      end;
    end;
  end;
end;


procedure TAnchorPanel.WMSize(var Message: TWMSize);
begin
  if not(csDesigning in ComponentState) then
    SaveControls;
  inherited;
  if not(csDesigning in ComponentState) then
    ResizeControls
end;

end.

 

Scale-Test5.7z

Edited August 19, 2023 by Attila Kovacs