unit Appl;

interface

uses
  Windows, Forms, SysUtils, Classes, Controls;

function RtmPPI: integer;
function DsgnPPI: integer;
function IsChangePPI: boolean;
function ScaleValue(Value, NewPPI, OldPPI: Integer): integer;
procedure ChangeConstraints(Control: TControl; NewPPI, OldPPI: integer);

implementation

function ScaleValue(Value, NewPPI, OldPPI: Integer): integer;
begin
  Result := MulDiv(Value, NewPPI, OldPPI);
end;

function RtmPPI: integer;
begin
  Result := Screen.PixelsPerInch;
end;

function DsgnPPI: integer;
begin
  Result := 120;
end;

function IsChangePPI: boolean;
begin
  Result := DsgnPPI <> RtmPPI;
end;

procedure ChangeConstraints(Control: TControl; NewPPI, OldPPI: integer);
begin
  with Control.Constraints do
  begin
    if NewPPI > OldPPI then
    begin
      if MaxHeight > 0 then MaxHeight := ScaleValue(MaxHeight, NewPPI, OldPPI);
      if MinHeight > 0 then MinHeight := ScaleValue(MinHeight, NewPPI, OldPPI);
      if MaxWidth > 0 then MaxWidth := ScaleValue(MaxWidth, NewPPI, OldPPI);
      if MinWidth > 0 then MinWidth := ScaleValue(MinWidth, NewPPI, OldPPI);
    end
    else
    begin
      if MinHeight > 0 then MinHeight := ScaleValue(MinHeight, NewPPI, OldPPI);
      if MaxHeight > 0 then MaxHeight := ScaleValue(MaxHeight, NewPPI, OldPPI);
      if MinWidth > 0 then MinWidth := ScaleValue(MinWidth, NewPPI, OldPPI);
      if MaxWidth > 0 then MaxWidth := ScaleValue(MaxWidth, NewPPI, OldPPI);
    end;
  end;
end;

end.