paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 21:49:09 +02:00
Code Issues Packages Projects Releases Wiki Activity

* patch from Bart to fix convutils temperature fix.

Browse Source 
(cherry picked from commit 7ddeaa54c0)
This commit is contained in:
marcoonthegit 2022-06-05 18:51:52 +02:00
parent ba7a8ff709
commit 229d9f89ae
2 changed files with 65 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -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; Description : String;
Value : TConvUtilFloat; Value : TConvUtilFloat;
Fam : TConvFamily; 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;

38
packages/rtl-objpas/src/inc/stdconvs.pp
View File

@ -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; siKilo = siHecto*10;
siMega = siKilo*1000; siMega = siKilo*1000;
siGiga = siMega*1000; siGiga = siMega*1000;
siTera = Int64(siGiga*1000); siTera = Int64(siGiga*1000);
siPeta = Int64(siTera*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); tuKelvin := RegisterConversionType(cbTemperature,txttuKelvin,@KelvinToCelsius,@CelsiusToKelvin);
tuFahrenheit := RegisterConversionType(cbTemperature,txttuFahrenheit,5/9); tuFahrenheit := RegisterConversionType(cbTemperature,txttuFahrenheit,@FahrenheitToCelsius,@CelsiusToFahrenheit);
tuRankine := RegisterConversionType(cbTemperature,txttuRankine,0.5555556); tuRankine := RegisterConversionType(cbTemperature,txttuRankine,@RankineToCelsius,@CelsiusToRankine);
tuReamur := RegisterConversionType(cbTemperature,txttuReamur,10/8); // Reaumur? tuReamur := RegisterConversionType(cbTemperature,txttuReamur,10/8); // Reaumur?
end; end;