paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 22:29:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Implement ConvUtils.ConvUnitCompareValue and ConvUtils.ConvUnitSameValue bug

Browse Source 
#39768

(cherry picked from commit 7da3e17571)
This commit is contained in:
marcoonthegit 2022-06-06 23:05:02 +02:00
parent 25986a6398
commit 3c778ccfb6
1 changed files with 26 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
packages/rtl-objpas/src/inc/convutil.inc
View File

@ -27,7 +27,7 @@ interface
{$ifndef FPUNONE}
uses
sysutils;
sysutils, math;
Type TConvType = type Integer;
TConvFamily = type Integer;
@ -47,6 +47,11 @@ function Convert ( const Measurement : Double; const FromType1, FromType2, ToTy
function ConvertFrom(const AFrom: TConvType; AValue: Double): TConvUtilFloat;
function ConvertTo(const AValue: Double; const ATo: TConvType): TConvUtilFloat;
function ConvUnitCompareValue(const AValue1: Double; const AType1: TConvType;
const AValue2: Double; const AType2: TConvType): TValueRelationship;
function ConvUnitSameValue(const AValue1: Double; const AType1: TConvType;
const AValue2: Double; const AType2: TConvType): Boolean;
function ConvFamilyToDescription(const AFamily: TConvFamily): string;
function ConvTypeToDescription(const AType: TConvType): string;
function DescriptionToConvFamily(const ADescription: String; out AFamily: TConvFamily): Boolean;
@ -112,6 +117,7 @@ Type ResourceData = record
var TheUnits : array of ResourceData =nil;
TheFamilies : array of string =nil;
function ConvFamilyToDescription(const AFamily: TConvFamily): string;
begin
@ -371,6 +377,25 @@ begin
result:=Avalue/torec.value;
end;
function ConvUnitCompareValue(const AValue1: Double; const AType1: TConvType;
const AValue2: Double; const AType2: TConvType): TValueRelationship;
var
D1, D2: TConvUtilFloat;
begin
D1:=ConvertFrom(AType1, AValue1);
D2:=ConvertFrom(AType2, Avalue2);
result:=CompareValue(D1,D2,macheps);
end;
function ConvUnitSameValue(const AValue1: Double; const AType1: TConvType;
const AValue2: Double; const AType2: TConvType): Boolean;
begin
result:=ConvUnitCompareValue(Avalue1, AType1, AValue2, AType2)=0;
end;
Constructor TConvTypeInfo.Create(Const AConvFamily : TConvFamily;const ADescription:String);
begin