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

* partial fix for 7481. TConvFactor not added, too little docs/examples.

Browse Source 
git-svn-id: trunk@4869 -
This commit is contained in:
marco 2006-10-12 17:13:39 +00:00
parent cf13a7d0cb
commit 76f73ed2ec
1 changed files with 75 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

78
rtl/objpas/convutil.inc
View File

@ -25,8 +25,11 @@ interface
{$mode objfpc}
{$H+}
Type TConvType = type Integer;
TConvFamily = type Integer;
Type TConvType = type Integer;
TConvFamily = type Integer;
TConvFamilyArray = array of TConvFamily;
TConvTypeArray = array of TConvType;
TConversionProc = function(const AValue: Double): Double;
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 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
@ -350,6 +372,50 @@ Type ResourceData = record
var TheUnits : array of ResourceData =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;
var i,l : Longint;
@ -445,6 +511,13 @@ begin
result:=Measurement*(fromrec1.value/fromrec2.value)/(torec1.value/torec2.value);
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
// a while, the bushels/forthnight got boring, so please check.
// undefined/uncertain factors get -1, and convert() functions
@ -637,7 +710,6 @@ begin
RegisterArea;
end;
initialization
registerall;
finalization