paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-19 20:39:25 +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 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 FromType1, FromType2, ToType1, ToType2 : TConvType ) :TConvUtilFloat;
@ -99,9 +100,11 @@ uses
RtlConsts;
Type ResourceData = record
Description : String;
Value : TConvUtilFloat;
Fam : TConvFamily;
Description : String;
Value : TConvUtilFloat;
ToCommonFunc : TConversionProc;
FromCommonFunc: TConversionProc;
Fam : TConvFamily;
end;
@ -157,7 +160,7 @@ begin
begin
atypes[j]:=i;
inc(j);
end;
end;
end;
function ConvTypeToDescription(const AType: TConvType): string;
@ -242,7 +245,8 @@ end;
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;
@ -255,10 +259,23 @@ begin
Setlength(theunits,l1+1);
theunits[l1].description:=s;
theunits[l1].value:=value;
theunits[l1].ToCommonFunc:=AToCommonFunc;
theunits[l1].FromCommonFunc:=AFromCommonFunc;
theunits[l1].fam:=fam;
Result:=l1;
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;
var l1 : longint;
@ -275,6 +292,7 @@ function Convert ( const Measurement : Double; const FromType, ToType : TConvT
var
fromrec,torec : resourcedata;
common: double;
begin
if not SearchConvert(fromtype,fromrec) then
@ -286,7 +304,17 @@ begin
ConvFamilyToDescription(fromrec.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;
function Convert ( const Measurement : Double; const FromType1, FromType2, ToType1, ToType2 : TConvType ) :TConvUtilFloat;
@ -310,6 +338,7 @@ begin
ConvFamilyToDescription(fromrec2.fam),
ConvFamilyToDescription(torec2.fam)
]);
//using ToCommonFunc() and FromCommonFunc makes no sense in this context
result:=Measurement*(fromrec1.value/fromrec2.value)/(torec1.value/torec2.value);
end;
@ -338,12 +367,12 @@ begin
FFactor:=AFactor;
end;
function TConvTypeFactor.ToCommon(const AValue: Double): Double;
function TConvTypeFactor.ToCommon(const AValue: Double): Double;
begin
result:=AValue * FFactor;
end;
function TConvTypeFactor.FromCommon(const AValue: Double): Double;
function TConvTypeFactor.FromCommon(const AValue: Double): Double;
begin
result:=AValue / FFactor;
end;
@ -355,12 +384,12 @@ begin
ffromproc:=AFromProc;
end;
function TConvTypeProcs.ToCommon(const AValue: Double): Double;
function TConvTypeProcs.ToCommon(const AValue: Double): Double;
begin
result:=FTOProc(Avalue);
end;
function TConvTypeProcs.FromCommon(const AValue: Double): Double;
function TConvTypeProcs.FromCommon(const AValue: Double): Double;
begin
result:=FFromProc(Avalue);
end;

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

@ -37,22 +37,22 @@ const
siMilli = 1E-3;
siCenti = 1E-2;
siDeci = 1E-1;
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);
siZetta = 1E21;
siZetta = 1E21;
siYotta = 1E24;
// Powers of 2
iecKibi = 1024; // 10
iecMebi = iecKibi*1024; // 20
iecGibi = iecMebi*1024; // 30
iecGibi = iecMebi*1024; // 30
iecTebi = Int64(iecGibi*1024); // 40
iecPebi = Int64(iecTebi*1024); // 50
iecExbi = Int64(iecPebi*1024); // 60
@ -227,6 +227,9 @@ function CelsiusToFahrenheit(const AValue: Double): Double;
function FahrenheitToCelsius(const AValue: Double): Double;
function CelsiusToKelvin (const AValue: Double): Double;
function KelvinToCelsius (const AValue: Double): Double;
function RankineToCelsius (const AValue: Double): Double;
function CelsiusToRankine (const AValue: Double): Double;
implementation
@ -250,6 +253,17 @@ begin
result:=AValue-273.15;
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.
txtauSquareMillimeters = 'Square millimeters (mm^2)';
@ -474,9 +488,9 @@ end;
procedure RegisterTemperature;
begin
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?
end;