Browse Source

* patch from Bart to fix convutils temperature fix.

marcoonthegit 3 years ago
parent
commit
7ddeaa54c0
2 changed files with 65 additions and 22 deletions
  1. 39 10
      packages/rtl-objpas/src/inc/convutil.inc
  2. 26 12
      packages/rtl-objpas/src/inc/stdconvs.pp

+ 39 - 10
packages/rtl-objpas/src/inc/convutil.inc

@@ -39,6 +39,7 @@ Type TConvType        = type Integer;
 
 
 Function RegisterConversionFamily(Const S : String):TConvFamily;
 Function RegisterConversionFamily(Const S : String):TConvFamily;
 Function RegisterConversionType(Fam:TConvFamily;Const S:String;Value:TConvUtilFloat):TConvType;
 Function RegisterConversionType(Fam:TConvFamily;Const S:String;Value:TConvUtilFloat):TConvType;
+Function RegisterConversionType(Fam:TConvFamily;Const S:String;const AToCommonFunc, AFromCommonFunc: TConversionProc): TConvType;
 
 
 function Convert ( const Measurement  : Double; const FromType, ToType  : TConvType ) :TConvUtilFloat;
 function Convert ( const Measurement  : Double; const FromType, ToType  : TConvType ) :TConvUtilFloat;
 function Convert ( const Measurement  : Double; const FromType1, FromType2, ToType1, ToType2  : TConvType ) :TConvUtilFloat;
 function Convert ( const Measurement  : Double; const FromType1, FromType2, ToType1, ToType2  : TConvType ) :TConvUtilFloat;
@@ -99,9 +100,11 @@ uses
   RtlConsts;
   RtlConsts;
 
 
 Type ResourceData = record
 Type ResourceData = record
-                      Description : String;
-                      Value       : TConvUtilFloat;
-                      Fam         : TConvFamily;
+                      Description   : String;
+                      Value         : TConvUtilFloat;
+                      ToCommonFunc  : TConversionProc;
+                      FromCommonFunc: TConversionProc;
+                      Fam           : TConvFamily;
                      end;
                      end;
 
 
 
 
@@ -157,7 +160,7 @@ begin
      begin
      begin
        atypes[j]:=i;
        atypes[j]:=i;
        inc(j);
        inc(j);
-     end;	
+     end;
 end;
 end;
 
 
 function ConvTypeToDescription(const AType: TConvType): string;
 function ConvTypeToDescription(const AType: TConvType): string;
@@ -242,7 +245,8 @@ end;
 
 
 const macheps=1E-9;
 const macheps=1E-9;
 
 
-Function RegisterConversionType(Fam:TConvFamily;Const S:String;Value:TConvUtilFloat):TConvType;
+Function InternalRegisterConversionType(Fam:TConvFamily;Const S:String;Value:TConvUtilFloat;
+  const AToCommonFunc, AFromCommonFunc: TConversionProc):TConvType;
 
 
 var l1 : Longint;
 var l1 : Longint;
 
 
@@ -255,10 +259,23 @@ begin
   Setlength(theunits,l1+1);
   Setlength(theunits,l1+1);
   theunits[l1].description:=s;
   theunits[l1].description:=s;
   theunits[l1].value:=value;
   theunits[l1].value:=value;
+  theunits[l1].ToCommonFunc:=AToCommonFunc;
+  theunits[l1].FromCommonFunc:=AFromCommonFunc;
   theunits[l1].fam:=fam;
   theunits[l1].fam:=fam;
   Result:=l1;
   Result:=l1;
 end;
 end;
 
 
+Function RegisterConversionType(Fam:TConvFamily;Const S:String;Value:TConvUtilFloat):TConvType;
+begin
+  InternalRegisterConversionType(Fam,S,Value,nil,nil);
+end;
+
+function RegisterConversionType(Fam: TConvFamily; const S: String;
+  const AToCommonFunc, AFromCommonFunc: TConversionProc): TConvType;
+begin
+  InternalRegisterConversionType(Fam,S,(AToCommonFunc(1)-AToCommonFunc(0)),AToCommonFunc,AFromCommonFunc);
+end;
+
 function SearchConvert(TheType:TConvType; var r:ResourceData):Boolean;
 function SearchConvert(TheType:TConvType; var r:ResourceData):Boolean;
 
 
 var l1 : longint;
 var l1 : longint;
@@ -275,6 +292,7 @@ function Convert ( const Measurement  : Double; const FromType, ToType  : TConvT
 
 
 var
 var
   fromrec,torec :   resourcedata;
   fromrec,torec :   resourcedata;
+  common: double;
 
 
 begin
 begin
   if not SearchConvert(fromtype,fromrec) then
   if not SearchConvert(fromtype,fromrec) then
@@ -286,7 +304,17 @@ begin
       ConvFamilyToDescription(fromrec.fam),
       ConvFamilyToDescription(fromrec.fam),
       ConvFamilyToDescription(torec.fam)
       ConvFamilyToDescription(torec.fam)
     ]);
     ]);
-  result:=Measurement*fromrec.value/torec.value;
+  if assigned(fromrec.ToCommonFunc) or assigned(torec.FromCommonFunc) then begin
+    if assigned(fromrec.ToCommonFunc) then
+      common:=fromrec.ToCommonFunc(MeasureMent)
+    else
+      common:=Measurement*fromrec.value;
+    if assigned(torec.FromCommonFunc) then
+      result:=torec.FromCommonFunc(common)
+    else
+      result:=common/torec.value;
+  end else
+    result:=Measurement*fromrec.value/torec.value;
 end;
 end;
 
 
 function Convert ( const Measurement  : Double; const FromType1, FromType2, ToType1, ToType2  : TConvType ) :TConvUtilFloat;
 function Convert ( const Measurement  : Double; const FromType1, FromType2, ToType1, ToType2  : TConvType ) :TConvUtilFloat;
@@ -310,6 +338,7 @@ begin
       ConvFamilyToDescription(fromrec2.fam),
       ConvFamilyToDescription(fromrec2.fam),
       ConvFamilyToDescription(torec2.fam)
       ConvFamilyToDescription(torec2.fam)
     ]);
     ]);
+  //using ToCommonFunc() and FromCommonFunc makes no sense in this context
   result:=Measurement*(fromrec1.value/fromrec2.value)/(torec1.value/torec2.value);
   result:=Measurement*(fromrec1.value/fromrec2.value)/(torec1.value/torec2.value);
 end;
 end;
 
 
@@ -338,12 +367,12 @@ begin
   FFactor:=AFactor;
   FFactor:=AFactor;
 end;
 end;
 
 
-function TConvTypeFactor.ToCommon(const AValue: Double): Double; 
+function TConvTypeFactor.ToCommon(const AValue: Double): Double;
 begin
 begin
   result:=AValue * FFactor;
   result:=AValue * FFactor;
 end;
 end;
 
 
-function TConvTypeFactor.FromCommon(const AValue: Double): Double; 
+function TConvTypeFactor.FromCommon(const AValue: Double): Double;
 begin
 begin
   result:=AValue / FFactor;
   result:=AValue / FFactor;
 end;
 end;
@@ -355,12 +384,12 @@ begin
   ffromproc:=AFromProc;
   ffromproc:=AFromProc;
 end;
 end;
 
 
-function TConvTypeProcs.ToCommon(const AValue: Double): Double; 
+function TConvTypeProcs.ToCommon(const AValue: Double): Double;
 begin
 begin
   result:=FTOProc(Avalue);
   result:=FTOProc(Avalue);
 end;
 end;
 
 
-function TConvTypeProcs.FromCommon(const AValue: Double): Double; 
+function TConvTypeProcs.FromCommon(const AValue: Double): Double;
 begin
 begin
   result:=FFromProc(Avalue);
   result:=FFromProc(Avalue);
 end;
 end;

+ 26 - 12
packages/rtl-objpas/src/inc/stdconvs.pp

@@ -37,22 +37,22 @@ const
   siMilli = 1E-3;
   siMilli = 1E-3;
   siCenti = 1E-2;
   siCenti = 1E-2;
   siDeci  = 1E-1;
   siDeci  = 1E-1;
-  
+
   siDeca  = 10;
   siDeca  = 10;
   siHecto = siDeca*10;
   siHecto = siDeca*10;
-  siKilo  = siHecto*10; 
-  siMega  = siKilo*1000; 
-  siGiga  = siMega*1000; 
-  siTera  = Int64(siGiga*1000); 
-  siPeta  = Int64(siTera*1000); 
+  siKilo  = siHecto*10;
+  siMega  = siKilo*1000;
+  siGiga  = siMega*1000;
+  siTera  = Int64(siGiga*1000);
+  siPeta  = Int64(siTera*1000);
   siExa   = Int64(siPeta*1000);
   siExa   = Int64(siPeta*1000);
-  siZetta = 1E21;  
+  siZetta = 1E21;
   siYotta = 1E24;
   siYotta = 1E24;
-  
+
   // Powers of 2
   // Powers of 2
   iecKibi = 1024;                 // 10
   iecKibi = 1024;                 // 10
   iecMebi = iecKibi*1024;         // 20
   iecMebi = iecKibi*1024;         // 20
-  iecGibi = iecMebi*1024;         // 30 
+  iecGibi = iecMebi*1024;         // 30
   iecTebi = Int64(iecGibi*1024);  // 40
   iecTebi = Int64(iecGibi*1024);  // 40
   iecPebi = Int64(iecTebi*1024);  // 50
   iecPebi = Int64(iecTebi*1024);  // 50
   iecExbi = Int64(iecPebi*1024);  // 60
   iecExbi = Int64(iecPebi*1024);  // 60
@@ -227,6 +227,9 @@ function CelsiusToFahrenheit(const AValue: Double): Double;
 function FahrenheitToCelsius(const AValue: Double): Double;
 function FahrenheitToCelsius(const AValue: Double): Double;
 function CelsiusToKelvin    (const AValue: Double): Double;
 function CelsiusToKelvin    (const AValue: Double): Double;
 function KelvinToCelsius    (const AValue: Double): Double;
 function KelvinToCelsius    (const AValue: Double): Double;
+function RankineToCelsius   (const AValue: Double): Double;
+function CelsiusToRankine   (const AValue: Double): Double;
+
 
 
 implementation
 implementation
 
 
@@ -250,6 +253,17 @@ begin
   result:=AValue-273.15;
   result:=AValue-273.15;
 end;
 end;
 
 
+function RankineToCelsius(const AValue: Double): Double;
+begin
+  result:=(AValue*Double(5/9))-273.15;
+end;
+
+function CelsiusToRankine(const AValue: Double): Double;
+begin
+  result:=(AValue+273.15)*1.8;
+end;
+
+
 ResourceString  // Note, designations for FFU's are guesses.
 ResourceString  // Note, designations for FFU's are guesses.
 
 
   txtauSquareMillimeters   = 'Square millimeters (mm^2)';
   txtauSquareMillimeters   = 'Square millimeters (mm^2)';
@@ -474,9 +488,9 @@ end;
 procedure RegisterTemperature;
 procedure RegisterTemperature;
 begin
 begin
  tuCelsius    := RegisterConversionType(cbTemperature,txttuCelsius,1);
  tuCelsius    := RegisterConversionType(cbTemperature,txttuCelsius,1);
- tuKelvin     := RegisterConversionType(cbTemperature,txttuKelvin,1);
- tuFahrenheit := RegisterConversionType(cbTemperature,txttuFahrenheit,5/9);
- tuRankine    := RegisterConversionType(cbTemperature,txttuRankine,0.5555556);
+ tuKelvin     := RegisterConversionType(cbTemperature,txttuKelvin,@KelvinToCelsius,@CelsiusToKelvin);
+ tuFahrenheit := RegisterConversionType(cbTemperature,txttuFahrenheit,@FahrenheitToCelsius,@CelsiusToFahrenheit);
+ tuRankine    := RegisterConversionType(cbTemperature,txttuRankine,@RankineToCelsius,@CelsiusToRankine);
  tuReamur     := RegisterConversionType(cbTemperature,txttuReamur,10/8);   // Reaumur?
  tuReamur     := RegisterConversionType(cbTemperature,txttuReamur,10/8);   // Reaumur?
 end;
 end;