mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-10 08:34:28 +01:00
* partial fix for 7481. TConvFactor not added, too little docs/examples.
git-svn-id: trunk@4869 -
This commit is contained in:
parent
cf13a7d0cb
commit
76f73ed2ec
@ -27,6 +27,9 @@ interface
|
|||||||
|
|
||||||
Type TConvType = type Integer;
|
Type TConvType = type Integer;
|
||||||
TConvFamily = type Integer;
|
TConvFamily = type Integer;
|
||||||
|
TConvFamilyArray = array of TConvFamily;
|
||||||
|
TConvTypeArray = array of TConvType;
|
||||||
|
TConversionProc = function(const AValue: Double): Double;
|
||||||
|
|
||||||
var
|
var
|
||||||
|
|
||||||
@ -200,6 +203,25 @@ Function RegisterConversionType(Fam:TConvFamily;Const S:String;Value:TConvUtilFl
|
|||||||
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;
|
||||||
|
|
||||||
|
function ConvFamilyToDescription(const AFamily: TConvFamily): string;
|
||||||
|
function ConvTypeToDescription(const AType: TConvType): string;
|
||||||
|
procedure GetConvFamilies(out AFamilies: TConvFamilyArray);
|
||||||
|
procedure GetConvTypes(const AFamily: TConvFamily; out ATypes: TConvTypeArray);
|
||||||
|
|
||||||
|
Type
|
||||||
|
TConvTypeInfo = Class(Tobject)
|
||||||
|
private
|
||||||
|
FDescription : String;
|
||||||
|
FConvFamily : TConvFamily;
|
||||||
|
FConvType : TConvType;
|
||||||
|
public
|
||||||
|
Constructor Create(Const AConvFamily : TConvFamily;const ADescription:String);
|
||||||
|
function ToCommon(const AValue: Double) : Double; virtual; abstract;
|
||||||
|
function FromCommon(const AValue: Double) : Double; virtual; abstract;
|
||||||
|
property ConvFamily : TConvFamily read FConvFamily;
|
||||||
|
property ConvType : TConvType read FConvType;
|
||||||
|
property Description: String read FDescription;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
Implementation
|
Implementation
|
||||||
@ -350,6 +372,50 @@ Type ResourceData = record
|
|||||||
var TheUnits : array of ResourceData =nil;
|
var TheUnits : array of ResourceData =nil;
|
||||||
TheFamilies : array of string =nil;
|
TheFamilies : array of string =nil;
|
||||||
|
|
||||||
|
function ConvFamilyToDescription(const AFamily: TConvFamily): string;
|
||||||
|
|
||||||
|
begin
|
||||||
|
result:='';
|
||||||
|
if AFamily<length(TheFamilies) then
|
||||||
|
result:=TheFamilies[AFamily];
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure GetConvFamilies(out AFamilies: TConvFamilyArray);
|
||||||
|
|
||||||
|
var i : integer;
|
||||||
|
begin
|
||||||
|
setlength(AFamilies,length(thefamilies));
|
||||||
|
for i:=0 to length(TheFamilies)-1 do
|
||||||
|
AFamilies[i]:=i;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure GetConvTypes(const AFamily: TConvFamily; out ATypes: TConvTypeArray);
|
||||||
|
|
||||||
|
var i,j,nrTypes:integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
nrTypes:=0;
|
||||||
|
for i:=0 to length(TheUnits)-1 do
|
||||||
|
if TheUnits[i].fam=AFamily Then
|
||||||
|
inc(nrTypes);
|
||||||
|
setlength(atypes,nrtypes);
|
||||||
|
j:=0;
|
||||||
|
for i:=0 to length(TheUnits)-1 do
|
||||||
|
if TheUnits[i].fam=AFamily Then
|
||||||
|
begin
|
||||||
|
atypes[j]:=i;
|
||||||
|
inc(j);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ConvTypeToDescription(const AType: TConvType): string;
|
||||||
|
|
||||||
|
Begin
|
||||||
|
result:='';
|
||||||
|
if AType<length(TheUnits) then
|
||||||
|
result:=TheUnits[AType].Description;
|
||||||
|
end;
|
||||||
|
|
||||||
Function RegisterConversionFamily(Const S:String):TConvFamily;
|
Function RegisterConversionFamily(Const S:String):TConvFamily;
|
||||||
|
|
||||||
var i,l : Longint;
|
var i,l : Longint;
|
||||||
@ -445,6 +511,13 @@ begin
|
|||||||
result:=Measurement*(fromrec1.value/fromrec2.value)/(torec1.value/torec2.value);
|
result:=Measurement*(fromrec1.value/fromrec2.value)/(torec1.value/torec2.value);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
Constructor TConvTypeInfo.Create(Const AConvFamily : TConvFamily;const ADescription:String);
|
||||||
|
|
||||||
|
begin
|
||||||
|
FDescription:=ADescription;
|
||||||
|
FConvFamily :=AConvFamily;
|
||||||
|
end;
|
||||||
|
|
||||||
// initial FFU factors from a HP48g calculator and BSD units program. However after
|
// initial FFU factors from a HP48g calculator and BSD units program. However after
|
||||||
// a while, the bushels/forthnight got boring, so please check.
|
// a while, the bushels/forthnight got boring, so please check.
|
||||||
// undefined/uncertain factors get -1, and convert() functions
|
// undefined/uncertain factors get -1, and convert() functions
|
||||||
@ -637,7 +710,6 @@ begin
|
|||||||
RegisterArea;
|
RegisterArea;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
initialization
|
initialization
|
||||||
registerall;
|
registerall;
|
||||||
finalization
|
finalization
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user