* Add system.devices for Delphi compatibility

packages/vcl-compat/fpmake.pp

@@ -42,6 +42,7 @@ begin
     T.ResourceStrings := True;
     T:=P.Targets.AddUnit('system.ioutils.pp');
     T.ResourceStrings := True;
+    T:=P.Targets.AddUnit('system.devices.pp');
 
 
 {$ifndef ALLPACKAGES}

packages/vcl-compat/src/system.devices.pp

@@ -0,0 +1,457 @@
+{
+    This file is part of the Free Pascal Run Time Library (rtl)
+    Copyright (c) 1999-2019 by the Free Pascal development team
+
+    This file provides the base for the pluggable sorting algorithm
+    support. It also provides a default QuickSort implementation.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$mode objfpc}
+{$h+}
+unit system.devices;
+
+{$WARN 3018 off : Constructor should be public}
+interface
+{$IFDEF FPC_DOTTEDUNITS}
+uses System.Types, System.SysUtils, System.Contnrs;
+{$ELSE}
+uses types, sysUtils, contnrs;
+{$ENDIF}
+
+{$SCOPEDENUMS ON}
+
+const
+  sDevAttrDisplayName = 'DisplayName'; 
+  sDevAttrOPDefine    = 'OPDefine'; 
+  sDevAttrCPPDefine   = 'CPPDefine'; 
+  sDevAttrPlatforms   = 'Platforms';
+
+Type
+  TDeviceInfo = class;
+  TDeviceInfoArray = Array of TDeviceInfo;
+
+  { TDeviceInfoEnumerator }
+
+  TDeviceInfoEnumerator = class
+  private
+    FPosition: Integer;
+  public
+    constructor Create;
+    function GetCurrent: TDeviceInfo;
+    function MoveNext: Boolean;
+    property Current: TDeviceInfo read GetCurrent;
+  end;
+
+  { TBaseDeviceInfo }
+
+  TBaseDeviceInfo = class
+  public 
+    type
+      TDeviceClass = (Unknown, Desktop, Phone, MediaPlayer, Tablet, Automotive, Industrial, Embedded, Watch, Glasses, Elf, Dwarf, Wizard);
+  private
+    class var _Devices: TObjectList;
+    class var _ThisDevice: TDeviceInfo;
+    class constructor Init;
+    class destructor Done;
+    class procedure SetThisDevice(const Device: TDeviceInfo); static;
+    class function GetThisDevice: TDeviceInfo; static;
+    class function GetDeviceCount: Integer; static; inline;
+    class function GetDevice(aIndex: Integer): TDeviceInfo; static;  inline;
+    class function GetDeviceByID(const aID: string): TDeviceInfo; static;
+    class function IndexOfDevice(const aID: string): Integer; static;
+  public
+    class function AddDevice(aDeviceClass: TDeviceClass; const aID: string;
+      const aPhysicalScreenSize, aLogicalScreenSize: TSize; aPlatform: TOSVersion.TPlatform; aPixelsPerInch: Integer;
+      AExclusive: Boolean = False): TBaseDeviceInfo; overload;
+    class function AddDevice(aDeviceClass: TDeviceClass; const aID: string;
+      const aMinPhysicalScreenSize, aMinLogicalScreenSize, aMaxPhysicalScreenSize, aMaxLogicalScreenSize: TSize;
+      APlatform: TOSVersion.TPlatform; aPixelsPerInch: Integer; aExclusive: Boolean = False): TDeviceInfo; overload;
+    class procedure RemoveDevice(const aID: string);
+    class procedure ClearDevices;
+    class function SelectDevices(aDeviceClass: TDeviceClass; const aPhysicalScreenSize, aLogicalScreenSize: TSize;
+      aPlatform: TOSVersion.TPlatform; aPixelsPerInch: Integer; aSetThisDevice: Boolean = True): TDeviceInfoArray;
+    class property DeviceCount: Integer read GetDeviceCount;
+    class property Devices[Index: Integer]: TDeviceInfo read GetDevice;
+    class property DeviceByID[const aID: string]: TDeviceInfo read GetDeviceByID;
+    class property ThisDevice: TDeviceInfo read GetThisDevice write SetThisDevice;
+  private
+    FDeviceClass: TDeviceClass;
+    FID: string;
+    FPlatform: TOSVersion.TPlatform;
+    FMinPhysicalScreenSize: TSize;
+    FMinLogicalScreenSize: TSize;
+    FMaxPhysicalScreenSize: TSize;
+    FMaxLogicalScreenSize: TSize;
+    FAspectRatio: Single;
+    FLowDelta, FHighDelta: Single;
+    FPixelsPerInch: Integer;
+    FExclusive: Boolean;
+    FAttributes: TFPStringHashTable;
+    function GetAttribute(const Key: string): string;
+    function GetMaxDiagonal: Single;
+    function GetMinDiagonal: Single;
+    property LowDelta: Single read FLowDelta write FLowDelta;
+    property HighDelta: Single read FHighDelta write FHighDelta;
+  Protected
+    constructor Create(aDeviceClass: TDeviceClass; const aID: string;
+                       const aMinPhysicalScreenSize, aMinLogicalScreenSize, aMaxPhysicalScreenSize, aMaxLogicalScreenSize: TSize;
+                       aPlatform: TOSVersion.TPlatform; aPixelsPerInch: Integer; aExclusive: Boolean); overload;
+  public
+    constructor Create; overload;
+    destructor Destroy; override;
+    function GetEnumerator: TDeviceInfoEnumerator;
+    function Equals(Obj: TObject): Boolean; override;
+    procedure AddAttribute(const aKey, aValue: string);
+    function HasAttribute(const aKey: string): Boolean;
+    function MatchDiagonal(const aDiag : Single) : Boolean;
+    property DeviceClass: TDeviceClass read FDeviceClass;
+    property Exclusive: Boolean read FExclusive;
+    property ID: string read FID;
+    property Platform: TOSVersion.TPlatform read FPlatform;
+    property MinPhysicalScreenSize: TSize read FMinPhysicalScreenSize;
+    property MinLogicalScreenSize: TSize read FMinLogicalScreenSize;
+    property MaxPhysicalScreenSize: TSize read FMaxPhysicalScreenSize;
+    property MaxLogicalScreenSize: TSize read FMaxLogicalScreenSize;
+    property AspectRatio: Single read FAspectRatio;
+    property PixelsPerInch: Integer read FPixelsPerInch;
+    property MaxDiagonal: Single read GetMaxDiagonal;
+    property MinDiagonal: Single read GetMinDiagonal;
+    property Attributes[const Key: string]: string read GetAttribute;
+  end;
+
+  TDeviceInfo = class sealed (TBaseDeviceInfo);
+
+implementation
+
+uses sortbase;
+
+{ TBaseDeviceInfo }
+
+class constructor TBaseDeviceInfo.Init;
+begin
+  _Devices:=TObjectList.Create(True);
+end;
+
+class destructor TBaseDeviceInfo.Done;
+begin
+  FreeAndNil(_Devices);
+end;
+
+class procedure TBaseDeviceInfo.SetThisDevice(const Device: TDeviceInfo);
+begin
+  _ThisDevice:=Device;
+end;
+
+class function TBaseDeviceInfo.GetThisDevice: TDeviceInfo;
+begin
+  Result:=_ThisDevice;
+end;
+
+class function TBaseDeviceInfo.GetDeviceCount: Integer;
+begin
+  Result:=_Devices.Count;
+end;
+
+class function TBaseDeviceInfo.GetDevice(aIndex: Integer): TDeviceInfo;
+begin
+  Result:=TDeviceInfo(_Devices[aIndex])
+end;
+
+class function TBaseDeviceInfo.GetDeviceByID(const aID: string): TDeviceInfo;
+
+var
+  Idx : Integer;
+
+begin
+  Idx:=IndexOfDevice(aId);
+  if Idx<>-1 then
+    Result:=GetDevice(Idx)
+  else
+    Result:=Nil;
+end;
+
+class function TBaseDeviceInfo.IndexOfDevice(const aID: string): Integer;
+begin
+  Result:=GetDeviceCount-1;
+  While (Result>=0) and Not SameText(GetDevice(Result).ID,aID) do
+    Dec(Result);
+end;
+
+function TBaseDeviceInfo.GetEnumerator: TDeviceInfoEnumerator;
+begin
+  Result:=TDeviceInfoEnumerator.Create;
+end;
+
+class function TBaseDeviceInfo.AddDevice(aDeviceClass: TDeviceClass;
+  const aID: string; const aPhysicalScreenSize, aLogicalScreenSize: TSize;
+  aPlatform: TOSVersion.TPlatform; aPixelsPerInch: Integer; AExclusive: Boolean
+  ): TBaseDeviceInfo;
+
+begin
+  Result:=TBaseDeviceInfo.Create(aDeviceClass,aID,
+                        aPhysicalScreenSize,aLogicalScreenSize,
+                        aPhysicalScreenSize,aLogicalScreenSize,
+                        aPlatForm,aPixelsPerInch,
+                        aExclusive);
+  _Devices.Add(Result);
+end;
+
+class function TBaseDeviceInfo.AddDevice(aDeviceClass: TDeviceClass;
+  const aID: string; const aMinPhysicalScreenSize, aMinLogicalScreenSize,
+  aMaxPhysicalScreenSize, aMaxLogicalScreenSize: TSize;
+  APlatform: TOSVersion.TPlatform; aPixelsPerInch: Integer; aExclusive: Boolean
+  ): TDeviceInfo;
+begin
+  Result:=TDeviceInfo.Create(aDeviceClass,aID,
+                        aMinPhysicalScreenSize,aMinLogicalScreenSize,
+                        aMaxPhysicalScreenSize,amaxLogicalScreenSize,
+                        aPlatForm,aPixelsPerInch,
+                        aExclusive);
+  _Devices.Add(Result);
+end;
+
+class procedure TBaseDeviceInfo.RemoveDevice(const aID: string);
+
+var
+  Idx : Integer;
+
+begin
+  Idx:=IndexOfDevice(aId);
+  If Idx<>-1 then
+    _Devices.Delete(Idx);
+end;
+
+class procedure TBaseDeviceInfo.ClearDevices;
+begin
+  _Devices.Clear;
+end;
+
+function CompareDevices (Item1, Item2, aContext : Pointer): Integer;
+
+var
+  aThis:  TBaseDeviceInfo absolute aContext;
+  Dev1 : TBaseDeviceInfo absolute Item1;
+  Dev2 : TBaseDeviceInfo absolute Item2;
+  D1,D2 : Single;
+
+begin
+  // Distance to this.Diagonal
+  D1:=Abs(Dev1.MaxDiagonal-aThis.MaxDiagonal);
+  D2:=Abs(Dev2.MaxDiagonal-aThis.MaxDiagonal);
+  Result:=Round(D1-D2); // Closest wins
+end;
+
+
+class function TBaseDeviceInfo.SelectDevices(aDeviceClass: TDeviceClass;
+  const aPhysicalScreenSize, aLogicalScreenSize: TSize;
+  aPlatform: TOSVersion.TPlatform; aPixelsPerInch: Integer;
+  aSetThisDevice: Boolean): TDeviceInfoArray;
+
+var
+  I: Integer;
+  aFound, aThis,aDev : TDeviceInfo;
+  aList: TDeviceInfoArray;
+  nCount, ResCount : Integer;
+  aDiag : Single;
+  isMatch : Boolean;
+
+begin
+  Result:=[];
+  aList:=[];
+  if aPixelsPerInch=0 then
+    aDiag:=0
+  else
+    aDiag:=Sqrt(Sqr(aPhysicalScreenSize.cx) + Sqr(aPhysicalScreenSize.cy))/aPixelsPerInch;
+  SetLength(aList,_Devices.Count);
+  nCount:=0;
+  aFound:=nil;
+  aThis:=TDeviceInfo.Create(aDeviceClass,'', aPhysicalScreenSize, aLogicalScreenSize,
+                            aPhysicalScreenSize, aLogicalScreenSize, aPlatform, aPixelsPerInch, True);
+  try
+    // Construct a list of platform matching devices.
+    for I:=0 to DeviceCount-1 do
+      begin
+      aDev:=GetDevice(I);
+      if aDev.Equals(aThis) then
+        aFound:=aDev;
+      isMatch:=(aDev.Platform=aPlatform);
+      if IsMatch then
+        begin
+        aList[nCount]:=aDev;
+        Inc(nCount);
+        end;
+      end;
+    // Sort the list on distance to diagonal of aThis
+    QuickSort_PtrList_Context(Pointer(aList),nCount,@CompareDevices,aThis);
+    // Prepare result
+    SetLength(Result,nCount);
+    ResCount:=0;
+    // Add the ones where device class and diagonal matches.
+    For I:=0 to nCount-1 do
+      begin
+      aDev:=aList[i];
+      if (aDev.DeviceClass=aDeviceClass) and aDev.MatchDiagonal(aDiag) then
+        begin
+        Result[ResCount]:=aDev;
+        inc(ResCount);
+        aList[i]:=Nil;
+        end;
+      end;
+    // Add the non-exclusive ones with matching diagonal
+    For I:=0 to nCount-1 do
+      begin
+      aDev:=aList[i];
+      if (aDev<>Nil) and (Not aDev.Exclusive) and aDev.MatchDiagonal(aDiag) then
+        begin
+        Result[ResCount]:=aDev;
+        inc(ResCount);
+        aList[i]:=Nil;
+        end;
+      end;
+    // Add the rest
+    For I:=0 to nCount-1 do
+      begin
+      aDev:=aList[i];
+      if (aDev<>Nil) then
+        begin
+        Result[ResCount]:=aDev;
+        inc(ResCount);
+        aList[i]:=Nil;
+        end;
+      end;
+    If aSetThisDevice then
+      begin
+      if Not Assigned(aFound) then
+        begin
+        aFound:=aThis;
+        aThis:=Nil;
+        end;
+      _ThisDevice:=aFound;
+      end;
+  Finally
+    aThis.Free;
+  end;
+end;
+
+constructor TBaseDeviceInfo.Create(aDeviceClass: TDeviceClass; const aID: string;
+  const aMinPhysicalScreenSize, aMinLogicalScreenSize, aMaxPhysicalScreenSize,
+  aMaxLogicalScreenSize: TSize; aPlatform: TOSVersion.TPlatform;
+  aPixelsPerInch: Integer; aExclusive: Boolean);
+
+var
+  aMaxr,aMinr : Single;
+
+begin
+  FID:=aID;
+  FDeviceClass:=aDeviceClass;
+  FPlatform:=aPlatform;
+  FPixelsPerInch:=aPixelsPerInch;
+  FExclusive:=aExclusive;
+  FMinPhysicalScreenSize:=aMinPhysicalScreenSize;
+  FMaxPhysicalScreenSize:=aMaxPhysicalScreenSize;
+  FMinLogicalScreenSize:=aMinLogicalScreenSize;
+  FMaxLogicalScreenSize:=aMaxLogicalScreenSize;
+  FAttributes:=TFPStringHashTable.Create;
+  aMaxr:=FMinPhysicalScreenSize.cy;
+  if aMaxr<FMinPhysicalScreenSize.cx then
+    aMaxr:=FMinPhysicalScreenSize.cx;
+  aMinr:=FMinPhysicalScreenSize.cy;
+  if aMinr>FMinPhysicalScreenSize.cx then
+    aMinr:=FMinPhysicalScreenSize.cx;
+  if aMinr=0 then
+    FAspectRatio:=0
+  else
+    FAspectRatio:=aMaxr/aMinr;
+end;
+
+constructor TBaseDeviceInfo.Create;
+begin
+  Raise ENoConstructException.Create('Cannot create manually');
+end;
+
+function TBaseDeviceInfo.GetAttribute(const Key: string): string;
+begin
+  Result:=FAttributes.Items[Key];
+end;
+
+function TBaseDeviceInfo.GetMaxDiagonal: Single;
+begin
+  if FPixelsPerInch=0 then
+    Result:=0
+  else
+    Result:=Sqrt(Sqr(FMaxPhysicalScreenSize.CX)+Sqr(FMaxPhysicalScreenSize.CY))/FPixelsPerInch;
+end;
+
+function TBaseDeviceInfo.GetMinDiagonal: Single;
+begin
+  if FPixelsPerInch=0 then
+    Result:=0
+  else
+    Result:=Sqrt(Sqr(FMinPhysicalScreenSize.CX)+Sqr(FMinPhysicalScreenSize.CY))/FPixelsPerInch;
+end;
+
+
+destructor TBaseDeviceInfo.Destroy;
+begin
+  FreeAndNil(FAttributes);
+  inherited Destroy;
+end;
+
+function TBaseDeviceInfo.Equals(Obj: TObject): Boolean;
+var
+  D : TBaseDeviceInfo absolute Obj;
+begin
+  Result := (Obj = Self);
+  if (Not Result) and (Obj is TBaseDeviceInfo) then
+     Result:=(Platform=D.Platform)
+             and (DeviceClass=D.DeviceClass)
+             and (PixelsPerInch=D.PixelsPerInch)
+             and (MaxPhysicalScreenSize=D.MaxPhysicalScreenSize)
+             and (MaxLogicalScreenSize=D.MaxLogicalScreenSize)
+             and (MinPhysicalScreenSize=D.MinPhysicalScreenSize)
+             and (MinLogicalScreenSize=D.MinLogicalScreenSize);
+end;
+
+procedure TBaseDeviceInfo.AddAttribute(const aKey, aValue: string);
+begin
+  if FAttributes.Find(aKey)=Nil then
+    FAttributes.Add(aKey,aValue);
+end;
+
+function TBaseDeviceInfo.HasAttribute(const aKey: string): Boolean;
+begin
+  Result:=FAttributes.Find(aKey)<>Nil;
+end;
+
+function TBaseDeviceInfo.MatchDiagonal(const aDiag: Single): Boolean;
+begin
+  Result:=(aDiag>=(MinDiagonal+LowDelta)) and (aDiag<=MaxDiagonal+HighDelta)
+end;
+
+{ TDeviceInfoEnumerator }
+
+constructor TDeviceInfoEnumerator.Create;
+begin
+  FPosition:=-1;
+end;
+
+function TDeviceInfoEnumerator.GetCurrent: TDeviceInfo;
+begin
+  Result:=TDeviceInfo.GetDevice(FPosition);
+end;
+
+function TDeviceInfoEnumerator.MoveNext: Boolean;
+begin
+  Inc(FPosition);
+  Result:=(FPosition<TDeviceInfo.GetDeviceCount);
+end;
+
+end.

packages/vcl-compat/tests/testcompat.lpi

@@ -40,6 +40,10 @@
         <Filename Value="utmessagemanager.pp"/>
         <IsPartOfProject Value="True"/>
       </Unit>
+      <Unit>
+        <Filename Value="utcdevices.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

packages/vcl-compat/tests/testcompat.lpr

@@ -4,7 +4,7 @@ program testcompat;
 
 uses
   {$IFDEF UNIX}cwstring,{$ENDIF}
-  Classes, consoletestrunner, tcnetencoding, tciotuils, utmessagemanager;
+  Classes, consoletestrunner, tcnetencoding, tciotuils, utmessagemanager, utcdevices;
 
 type
 

packages/vcl-compat/tests/utcdevices.pas

@@ -0,0 +1,264 @@
+{
+    This file is part of the Free Pascal Run Time Library (rtl)
+    Copyright (c) 1999-2019 by the Free Pascal development team
+
+    This file provides the base for the pluggable sorting algorithm
+    support. It also provides a default QuickSort implementation.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit utcdevices;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testutils, testregistry, types, system.devices;
+
+type
+  TMyDeviceInfo = Class(TBaseDeviceInfo)
+  //
+  end;
+
+  { TTestDevices }
+
+  TTestDevices= class(TTestCase)
+  private
+    FDevice: TMyDeviceInfo;
+    procedure AddSampleDevice1;
+    procedure AddSampleDevice2;
+    procedure AssertSampleDevice2(aDevice: TBaseDeviceInfo);
+    procedure CreateEmpty;
+    procedure AssertSampleDevice(aDevice: TBaseDeviceInfo);
+    function CreateSampleDevice: TMyDeviceInfo;
+    function CreateSampleDevice2: TMyDeviceInfo;
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+    Procedure AssertEquals(Msg : String; aExpected,aActual : TSize); overload;
+    Procedure AssertEquals(Msg : String; aExpected,aActual : TDeviceInfo.TDeviceClass); overload;
+    Procedure AssertEquals(Msg : String; aExpected,aActual : TOSVersion.TPlatform);overload;
+    // Freed in teardown
+    Property Device : TMyDeviceInfo Read FDevice Write FDevice;
+  published
+    procedure TestHookUp;
+    Procedure TestCreate;
+    Procedure TestCreateEmpty;
+    Procedure TestDiagonal;
+    Procedure TestAddDevice;
+    Procedure TestAttribute;
+    procedure TestSelect;
+    procedure TestSelect2;
+    procedure TestSelect3;
+  end;
+
+implementation
+
+uses typinfo;
+
+procedure TTestDevices.TestHookUp;
+begin
+  AssertNull('No this device',TDeviceInfo.ThisDevice);
+  AssertEquals('No devices',0, TDeviceInfo.DeviceCount);
+end;
+
+function TTestDevices.CreateSampleDevice: TMyDeviceInfo;
+
+begin
+  Result:=TMyDeviceInfo.Create(TDeviceInfo.TDeviceClass.Desktop,'1',
+                               TSize.Create(1200,900),
+                               TSize.Create(2400,1800),
+                               TSize.Create(1900,1200),
+                               TSize.Create(3800,2400),TOSVersion.TPlatform.pfLinux,96,True);
+end;
+
+function TTestDevices.CreateSampleDevice2: TMyDeviceInfo;
+begin
+  Result:=TMyDeviceInfo.Create(TDeviceInfo.TDeviceClass.Tablet,'2',
+                        TSize.Create(1600,1024),
+                        TSize.Create(3200,2048),
+                        TSize.Create(2048,1600),
+                        TSize.Create(4096,3200),TOSVersion.TPlatform.pfLinux,128,False);
+
+end;
+
+procedure TTestDevices.TestCreate;
+
+begin
+  Device:=CreateSampleDevice;
+  AssertSampleDevice(Device);
+end;
+
+procedure TTestDevices.AssertSampleDevice(aDevice : TBaseDeviceInfo);
+
+begin
+  AssertEquals('MinPhysicalScreenSize',TSize.Create(1200,900),aDevice.MinPhysicalScreenSize);
+  AssertEquals('MinLogicalScreenSize',TSize.Create(2400,1800),aDevice.MinLogicalScreenSize);
+  AssertEquals('MaxPhysicalScreenSize',TSize.Create(1900,1200),aDevice.MaxPhysicalScreenSize);
+  AssertEquals('MaxLogicalScreenSize',TSize.Create(3800,2400),aDevice.MaxLogicalScreenSize);
+  AssertEquals('Platform',TOSVersion.TPlatform.pfLinux,aDevice.Platform);
+  AssertEquals('DeviceClass',TDeviceInfo.TDeviceClass.Desktop,aDevice.DeviceClass);
+  AssertEquals('ID','1',aDevice.ID);
+  AssertEquals('PixelsPerInch',96,aDevice.PixelsPerInch);
+  AssertEquals('Exclusive',True,aDevice.Exclusive);
+end;
+
+procedure TTestDevices.AssertSampleDevice2(aDevice : TBaseDeviceInfo);
+
+begin
+  AssertEquals('MinPhysicalScreenSize',TSize.Create(1600,1024),aDevice.MinPhysicalScreenSize);
+  AssertEquals('MinLogicalScreenSize',TSize.Create(3200,2048),aDevice.MinLogicalScreenSize);
+  AssertEquals('MaxPhysicalScreenSize',TSize.Create(2048,1600),aDevice.MaxPhysicalScreenSize);
+  AssertEquals('MaxLogicalScreenSize',TSize.Create(4096,3200),aDevice.MaxLogicalScreenSize);
+  AssertEquals('Platform',TOSVersion.TPlatform.pfLinux,aDevice.Platform);
+  AssertEquals('DeviceClass',TDeviceInfo.TDeviceClass.Tablet,aDevice.DeviceClass);
+  AssertEquals('ID','2',aDevice.ID);
+  AssertEquals('PixelsPerInch',128,aDevice.PixelsPerInch);
+  AssertEquals('Exclusive',False,aDevice.Exclusive);
+end;
+
+procedure TTestDevices.CreateEmpty;
+
+begin
+  TDeviceInfo.create;
+end;
+
+procedure TTestDevices.TestCreateEmpty;
+begin
+  AssertException('Cannot create directly',ENoConstructException,@CreateEmpty);
+end;
+
+procedure TTestDevices.TestDiagonal;
+
+Var
+  D: Single;
+
+begin
+  Device:=CreateSampleDevice;
+  D:=Sqrt(Sqr(1900)+Sqr(1200))/96;
+  AssertEquals('MaxDiagonal',D,Device.MaxDiagonal);
+  D:=Sqrt(Sqr(1200)+Sqr(900))/96;
+  AssertEquals('MinDiagonal',D,Device.MinDiagonal);
+end;
+
+procedure TTestDevices.AddSampleDevice1;
+begin
+  TDeviceInfo.AddDevice(TDeviceInfo.TDeviceClass.Desktop,'1',
+                        TSize.Create(1200,900),
+                        TSize.Create(2400,1800),
+                        TSize.Create(1900,1200),
+                        TSize.Create(3800,2400),TOSVersion.TPlatform.pfLinux,96,True);
+end;
+
+procedure TTestDevices.AddSampleDevice2;
+begin
+  TDeviceInfo.AddDevice(TDeviceInfo.TDeviceClass.Tablet,'2',
+                        TSize.Create(1600,1024),
+                        TSize.Create(3200,2048),
+                        TSize.Create(2048,1600),
+                        TSize.Create(4096,3200),TOSVersion.TPlatform.pfLinux,128,False);
+end;
+
+procedure TTestDevices.TestAddDevice;
+begin
+  AddSampleDevice1;
+  AssertEquals('Count correct',1,TDeviceInfo.DeviceCount);
+  AssertSampleDevice(TDeviceInfo.Devices[0]);
+  AddSampleDevice2;
+  AssertEquals('Count correct',2,TDeviceInfo.DeviceCount);
+  AssertSampleDevice2(TDeviceInfo.Devices[1]);
+end;
+
+procedure TTestDevices.TestAttribute;
+begin
+  Device:=CreateSampleDevice;
+  Device.AddAttribute('tutu','toto');
+  AssertEquals('Has existing attribute',True,Device.HasAttribute('tutu'));
+  AssertEquals('Does not have non-existing attribute',False,Device.HasAttribute('titi'));
+  AssertEquals('Value of existing attribute','toto',Device.Attributes['tutu']);
+  AssertEquals('Value of non-existing attribute','',Device.Attributes['titi']);
+end;
+
+procedure TTestDevices.TestSelect;
+
+Var
+  Arr : TDeviceInfoArray;
+
+begin
+  AddSampleDevice1;
+  AddSampleDevice2;
+  Arr:=TDeviceInfo.SelectDevices(TDeviceInfo.TDeviceClass.Automotive,TSize.Create(100,100),TSize.Create(200,200),TOSVersion.TPlatform.pfAndroid,96,False);
+  AssertEquals('Empty, platform does not match',0,Length(Arr));
+end;
+
+procedure TTestDevices.TestSelect2;
+
+Var
+  Arr : TDeviceInfoArray;
+
+begin
+  AddSampleDevice1;
+  AddSampleDevice2;
+  Arr:=TDeviceInfo.SelectDevices(TDeviceInfo.TDeviceClass.Desktop,TSize.Create(100,100),TSize.Create(200,200),TOSVersion.TPlatform.pfLinux,96,False);
+  AssertEquals('platform matches',2,Length(Arr));
+  AssertSame('El 1',TDeviceInfo.Devices[0],Arr[1]);
+  AssertSame('El 2',TDeviceInfo.Devices[1],Arr[0]);
+end;
+
+procedure TTestDevices.TestSelect3;
+Var
+  Arr : TDeviceInfoArray;
+
+begin
+  AddSampleDevice1;
+  AddSampleDevice2;
+  Arr:=TDeviceInfo.SelectDevices(TDeviceInfo.TDeviceClass.Desktop,TSize.Create(1200,900),TSize.Create(2400,1800),TOSVersion.TPlatform.pfLinux,96,False);
+  AssertEquals('platform matches',2,Length(Arr));
+  AssertSame('El 1',TDeviceInfo.Devices[0],Arr[0]);
+  AssertSame('El 2',TDeviceInfo.Devices[1],Arr[1]);
+end;
+
+procedure TTestDevices.SetUp;
+begin
+  TDeviceInfo.ClearDevices;
+end;
+
+procedure TTestDevices.TearDown;
+
+begin
+  TDeviceInfo.ClearDevices;
+  FreeAndNil(FDevice);
+end;
+
+procedure TTestDevices.AssertEquals(Msg: String; aExpected, aActual: TSize);
+begin
+  AssertEquals(Msg+': cx',aExpected.cx,aActual.cx);
+  AssertEquals(Msg+': cy',aExpected.cy,aActual.cy);
+end;
+
+procedure TTestDevices.AssertEquals(Msg: String; aExpected,
+  aActual: TDeviceInfo.TDeviceClass);
+begin
+  AssertEquals(Msg,GetEnumName(TypeInfo(TDeviceInfo.TDeviceClass),Ord(aExpected)),
+                   GetEnumName(TypeInfo(TDeviceInfo.TDeviceClass),Ord(aActual)));
+end;
+
+procedure TTestDevices.AssertEquals(Msg: String; aExpected,
+  aActual: TOSVersion.TPlatform);
+begin
+  AssertEquals(Msg,GetEnumName(TypeInfo(TOSVersion.TPlatform),Ord(aExpected)),
+                   GetEnumName(TypeInfo(TOSVersion.TPlatform),Ord(aActual)));
+end;
+
+
+initialization
+  RegisterTest(TTestDevices);
+end.
+