unit testAppl;

interface

uses
  TestFramework, SysUtils, Controls, Forms, Appl;

type
  TTestUnitAppl = class(TTestCase)
  published
    procedure TestScaleValue;
    procedure TestDsgnVsRtmPPI;
    procedure TestChangeConstraints;
    procedure TestScaleLabel;
    procedure TestScaleEdit;
    procedure TestScaleLabeledEdit;
    procedure TestScaleGroupBox;
    procedure TestFuncScale;
  private
    function TestScaleControl(Control: TControl): boolean;
  end;

const
  testOldPPI = 120;
  testNewPPI = 96;

implementation

uses testUnit;

procedure TTestUnitAppl.TestScaleValue;
var
  Test: integer;
begin
  Test := ScaleValue(testOldPPI, testNewPPI, testOldPPI);
  Check( Test = testNewPPI, Format('return wrong %d',[Test]));
end;

procedure TTestUnitAppl.TestDsgnVsRtmPPI;
begin
  Check(not IsChangePPI, Format('Design time PixelsPerInch not %d DPI', [RtmPPI]));
end;

procedure TTestUnitAppl.TestChangeConstraints;
var
  OK1, OK2: boolean;
  Size1, Size2: integer;
begin
  OK1 := False;
  OK2 := False;
  Size1 := testOldPPI * 4;
  Size2 := ScaleValue(Size1, testNewPPI, testOldPPI);
  testForm := TtestForm.Create(Application);
  try
    testForm.Constraints.MaxHeight := Size1;
    testForm.Constraints.MinHeight := Size1;
    testForm.Constraints.MaxWidth := 0;
    testForm.Constraints.MinWidth := Size1;
    ChangeConstraints(testForm as TControl, testNewPPI, testOldPPI);
    OK1 := (testForm.Constraints.MaxHeight = Size2) and
      (testForm.Constraints.MinHeight = Size2) and
      (testForm.Constraints.MaxWidth = 0) and
      (testForm.Constraints.MinWidth = Size2);
    ChangeConstraints(testForm as TControl, testOldPPI, testNewPPI);
    OK2 := (testForm.Constraints.MaxHeight = Size1) and
      (testForm.Constraints.MinHeight = Size1) and
      (testForm.Constraints.MaxWidth = 0) and
      (testForm.Constraints.MinWidth = Size1);
  finally
    testForm.Close;
    Check(OK1 and OK2, 'failed test ');
  end;
end;

function TTestUnitAppl.TestScaleControl(Control: TControl): boolean;
var
  OK1, OK2: boolean;
  Size1, Size2: integer;
begin
  OK1 := False;
  OK2 := False;
  Size1 := testOldPPI;
  Size2 := ScaleValue(Size1, testNewPPI, testOldPPI);
  testForm := TtestForm.Create(Application);
  try
    Control.Constraints.MaxHeight := Size1;
    Control.Constraints.MinHeight := 0;
    Control.Constraints.MaxWidth := Size1;
    Control.Constraints.MinWidth := Size1;
    ChangeConstraints(Control, testNewPPI, testOldPPI);
    OK1 := (Control.Constraints.MaxHeight = Size2) and
      (Control.Constraints.MinHeight = 0) and
      (Control.Constraints.MaxWidth = Size2) and
      (Control.Constraints.MinWidth = Size2);
    ChangeConstraints(Control, testOldPPI, testNewPPI);
    OK2 := (Control.Constraints.MaxHeight = Size1) and
      (Control.Constraints.MinHeight = 0) and
      (Control.Constraints.MaxWidth = Size1) and
      (Control.Constraints.MinWidth = Size1);
  finally
    testForm.Close;
    Result := OK1 and OK2;
  end;
end;

procedure TTestUnitAppl.TestScaleLabel;
begin
  Check(TestScaleControl(testForm.Label1 as TControl), 'failed test ');
end;

procedure TTestUnitAppl.TestScaleEdit;
begin
  Check(TestScaleControl(testForm.Edit1 as TControl), 'failed test ');
end;

procedure TTestUnitAppl.TestScaleLabeledEdit;
begin
  Check(TestScaleControl(testForm.LabeledEdit1 as TControl), 'failed test ');
end;

procedure TTestUnitAppl.TestScaleGroupBox;
begin
  Check(TestScaleControl(testForm.GroupBox1 as TControl), 'failed test ');
end;

procedure TTestUnitAppl.TestFuncScale;
begin
  if IsChangePPI then
  begin
    testForm := TtestForm.Create(Application);
    try
      testForm.ShowModal;
    finally
      testForm.Close;
    end;
  end;
  Check(True, 'very strange ');
end;

initialization
  TestFramework.RegisterTest(TTestUnitAppl.Suite);
end.