|
@@ -144,13 +144,13 @@ const
|
|
macheps=1E-9;
|
|
macheps=1E-9;
|
|
zeroRes=1E-17;
|
|
zeroRes=1E-17;
|
|
|
|
|
|
-Type ResourceData = record
|
|
|
|
- Description : String;
|
|
|
|
- Value : TConvUtilFloat;
|
|
|
|
- ToCommonFunc : TConversionProc;
|
|
|
|
- FromCommonFunc: TConversionProc;
|
|
|
|
- Fam : TConvFamily;
|
|
|
|
- Deleted : Boolean;
|
|
|
|
|
|
+Type TResourceData = record
|
|
|
|
+ Description : String;
|
|
|
|
+ Value : TConvUtilFloat;
|
|
|
|
+ ToCommonFunc : TConversionProc;
|
|
|
|
+ FromCommonFunc: TConversionProc;
|
|
|
|
+ Fam : TConvFamily;
|
|
|
|
+ Deleted : Boolean;
|
|
end;
|
|
end;
|
|
TFamilyData = record
|
|
TFamilyData = record
|
|
Description: String;
|
|
Description: String;
|
|
@@ -158,9 +158,16 @@ Type ResourceData = record
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
|
|
-var TheUnits : array of ResourceData =nil;
|
|
|
|
|
|
+var TheUnits : array of TResourceData =nil;
|
|
TheFamilies : array of TFamilyData =nil;
|
|
TheFamilies : array of TFamilyData =nil;
|
|
|
|
|
|
|
|
+
|
|
|
|
+Function CheckFamily(i:TConvFamily):Boolean; inline;
|
|
|
|
+
|
|
|
|
+begin
|
|
|
|
+ Result:=(i<Length(TheFamilies)) and (not TheFamilies[i].Deleted);
|
|
|
|
+end;
|
|
|
|
+
|
|
function FindFamily(const ADescription: String; out AFam: TConvFamily): Boolean;
|
|
function FindFamily(const ADescription: String; out AFam: TConvFamily): Boolean;
|
|
|
|
|
|
var
|
|
var
|
|
@@ -179,7 +186,12 @@ begin
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
-function FindConvType(AFam: TConvFamily; const ADescription: string; out AResourceData: ResourceData): Boolean;
|
|
|
|
|
|
+function CheckType(AType: TConvType): Boolean; inline;
|
|
|
|
+begin
|
|
|
|
+ result:=(AType<Length(TheUnits)) and (not TheUnits[AType].Deleted);
|
|
|
|
+end;
|
|
|
|
+
|
|
|
|
+function FindConvType(AFam: TConvFamily; const ADescription: string; out AResourceData: TResourceData): Boolean;
|
|
|
|
|
|
var
|
|
var
|
|
i: Integer;
|
|
i: Integer;
|
|
@@ -199,7 +211,7 @@ end;
|
|
function FindConvType(AFam: TConvFamily; const ADescription: string): Boolean;
|
|
function FindConvType(AFam: TConvFamily; const ADescription: string): Boolean;
|
|
|
|
|
|
var
|
|
var
|
|
- Data: ResourceData;
|
|
|
|
|
|
+ Data: TResourceData;
|
|
|
|
|
|
begin
|
|
begin
|
|
result:=FindConvType(AFam, ADescription, Data);
|
|
result:=FindConvType(AFam, ADescription, Data);
|
|
@@ -267,7 +279,7 @@ end;
|
|
function ConvFamilyToDescription(const AFamily: TConvFamily): string;
|
|
function ConvFamilyToDescription(const AFamily: TConvFamily): string;
|
|
|
|
|
|
begin
|
|
begin
|
|
- if (AFamily<length(TheFamilies)) and not (TheFamilies[AFamily].Deleted) then
|
|
|
|
|
|
+ if CheckFamily(AFamily) then
|
|
result:=TheFamilies[AFamily].Description
|
|
result:=TheFamilies[AFamily].Description
|
|
else
|
|
else
|
|
result:=format(SConvUnknownDescriptionWithPrefix,['$',AFamily]);
|
|
result:=format(SConvUnknownDescriptionWithPrefix,['$',AFamily]);
|
|
@@ -333,12 +345,10 @@ begin
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
-//since a conversion type actually can have any (incuding an empty) description we need a function that
|
|
|
|
-//properly checks and indicates wether or not AType actually exists
|
|
|
|
function TryConvTypeToDescription(const AType: TConvType; out S: string): Boolean;
|
|
function TryConvTypeToDescription(const AType: TConvType; out S: string): Boolean;
|
|
|
|
|
|
begin
|
|
begin
|
|
- result:=(AType<length(TheUnits)) and (not TheUnits[AType].Deleted);
|
|
|
|
|
|
+ result:=CheckType(AType);
|
|
if result then
|
|
if result then
|
|
S:=TheUnits[AType].Description;
|
|
S:=TheUnits[AType].Description;
|
|
end;
|
|
end;
|
|
@@ -389,7 +399,6 @@ function TryStrToConvUnit(AText: string; out AValue: Double; out AType: TConvTyp
|
|
var
|
|
var
|
|
P: SizeInt;
|
|
P: SizeInt;
|
|
ValueStr, TypeStr: String;
|
|
ValueStr, TypeStr: String;
|
|
- Data: ResourceData;
|
|
|
|
|
|
|
|
begin
|
|
begin
|
|
Result:=False;
|
|
Result:=False;
|
|
@@ -412,13 +421,11 @@ begin
|
|
raise EConversionError.CreateFmt(SConvStrParseError,[AText]);
|
|
raise EConversionError.CreateFmt(SConvStrParseError,[AText]);
|
|
end;
|
|
end;
|
|
|
|
|
|
-//since a conversion family actually can have any (including an empty) description we need a function that
|
|
|
|
-//properly checks and indicates wether or not AType actually exists
|
|
|
|
function TryConvTypeToFamily(const AType: TConvType; out AFam: TConvFamily): Boolean;
|
|
function TryConvTypeToFamily(const AType: TConvType; out AFam: TConvFamily): Boolean;
|
|
|
|
|
|
begin
|
|
begin
|
|
result:=false;
|
|
result:=false;
|
|
- if (AType<length(TheUnits)) and (not TheUnits[AType].Deleted) then begin
|
|
|
|
|
|
+ if CheckType(AType) then begin
|
|
AFam:=TheUnits[AType].Fam;
|
|
AFam:=TheUnits[AType].Fam;
|
|
result:=true;
|
|
result:=true;
|
|
end;
|
|
end;
|
|
@@ -459,9 +466,8 @@ end;
|
|
function CompatibleConversionTypes(const AFrom, ATo: TConvType): Boolean;
|
|
function CompatibleConversionTypes(const AFrom, ATo: TConvType): Boolean;
|
|
|
|
|
|
begin
|
|
begin
|
|
- //ConvTypeToFamily potentially raises an exception, make sure it doesn't here
|
|
|
|
- result:= (AFrom<length(TheUnits)) and (ATo<length(TheUnits)) and
|
|
|
|
- (not TheUnits[AFrom].Deleted) and (not TheUnits[ATo].Deleted) and
|
|
|
|
|
|
+ //ConvTypeToFamily potentially raises an exception, make sure it doesn't here
|
|
|
|
+ result:= CheckType(AFrom) and CheckType(ATo) and
|
|
(ConvTypeToFamily(AFrom)=ConvTypeToFamily(ATo));
|
|
(ConvTypeToFamily(AFrom)=ConvTypeToFamily(ATo));
|
|
end;
|
|
end;
|
|
|
|
|
|
@@ -493,7 +499,7 @@ var
|
|
|
|
|
|
begin
|
|
begin
|
|
//Apparently this procedure is not supposed to raise exceptions
|
|
//Apparently this procedure is not supposed to raise exceptions
|
|
- if AFamily<Length(TheFamilies) then
|
|
|
|
|
|
+ if CheckFamily(AFamily) then
|
|
begin
|
|
begin
|
|
TheFamilies[AFamily].Deleted:=True;
|
|
TheFamilies[AFamily].Deleted:=True;
|
|
for i:=0 to Length(TheUnits)-1 do
|
|
for i:=0 to Length(TheUnits)-1 do
|
|
@@ -504,24 +510,19 @@ begin
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
-Function CheckFamily(i:TConvFamily):Boolean;
|
|
|
|
-
|
|
|
|
-begin
|
|
|
|
- Result:=(i<Length(TheFamilies)) and (not TheFamilies[i].Deleted);
|
|
|
|
-end;
|
|
|
|
|
|
|
|
procedure UnregisterConversionType(const AType: TConvType);
|
|
procedure UnregisterConversionType(const AType: TConvType);
|
|
|
|
|
|
begin
|
|
begin
|
|
//Apparently this procedure is not supposed to raise exceptions
|
|
//Apparently this procedure is not supposed to raise exceptions
|
|
- if AType<Length(TheUnits) then
|
|
|
|
|
|
+ if CheckType(AType) then
|
|
TheUnits[AType].Deleted:=True;
|
|
TheUnits[AType].Deleted:=True;
|
|
end;
|
|
end;
|
|
|
|
|
|
Function InternalRegisterConversionType(Fam:TConvFamily; S:String;Value:TConvUtilFloat;
|
|
Function InternalRegisterConversionType(Fam:TConvFamily; S:String;Value:TConvUtilFloat;
|
|
const AToCommonFunc, AFromCommonFunc: TConversionProc):TConvType;
|
|
const AToCommonFunc, AFromCommonFunc: TConversionProc):TConvType;
|
|
|
|
|
|
-var l1 : Longint;
|
|
|
|
|
|
+var len : Longint;
|
|
|
|
|
|
begin
|
|
begin
|
|
If NOT CheckFamily(Fam) Then
|
|
If NOT CheckFamily(Fam) Then
|
|
@@ -532,20 +533,20 @@ begin
|
|
raise EConversionError.Create(SConvEmptyDescription);
|
|
raise EConversionError.Create(SConvEmptyDescription);
|
|
if IsZero(Value,zeroRes) then
|
|
if IsZero(Value,zeroRes) then
|
|
raise EZeroDivide.CreateFmt(SConvFactorZero,[S]);
|
|
raise EZeroDivide.CreateFmt(SConvFactorZero,[S]);
|
|
- l1:=length(theunits);
|
|
|
|
- if l1>0 then
|
|
|
|
|
|
+ len:=length(theunits);
|
|
|
|
+ if len>0 then
|
|
if FindConvType(Fam, S) then
|
|
if FindConvType(Fam, S) then
|
|
raise EConversionError.CreateFmt(SConvDuplicateType,[S,ConvFamilyToDescription(Fam)]);
|
|
raise EConversionError.CreateFmt(SConvDuplicateType,[S,ConvFamilyToDescription(Fam)]);
|
|
- if l1=Integer(High(TConvType))+1 then
|
|
|
|
|
|
+ if len=Integer(High(TConvType))+1 then
|
|
raise EConversionError.CreateFmt(SConvTooManyConvTypes,[High(TConvType)]);
|
|
raise EConversionError.CreateFmt(SConvTooManyConvTypes,[High(TConvType)]);
|
|
- Setlength(theunits,l1+1);
|
|
|
|
- theunits[l1].description:=s;
|
|
|
|
- theunits[l1].value:=value;
|
|
|
|
- theunits[l1].ToCommonFunc:=AToCommonFunc;
|
|
|
|
- theunits[l1].FromCommonFunc:=AFromCommonFunc;
|
|
|
|
- theunits[l1].fam:=fam;
|
|
|
|
- theunits[l1].deleted:=false;
|
|
|
|
- Result:=l1;
|
|
|
|
|
|
+ Setlength(theunits,len+1);
|
|
|
|
+ theunits[len].description:=s;
|
|
|
|
+ theunits[len].value:=value;
|
|
|
|
+ theunits[len].ToCommonFunc:=AToCommonFunc;
|
|
|
|
+ theunits[len].FromCommonFunc:=AFromCommonFunc;
|
|
|
|
+ theunits[len].fam:=fam;
|
|
|
|
+ theunits[len].deleted:=false;
|
|
|
|
+ Result:=len;
|
|
end;
|
|
end;
|
|
|
|
|
|
Function RegisterConversionType(Fam:TConvFamily;Const S:String;Value:TConvUtilFloat):TConvType;
|
|
Function RegisterConversionType(Fam:TConvFamily;Const S:String;Value:TConvUtilFloat):TConvType;
|
|
@@ -559,13 +560,10 @@ begin
|
|
result:=InternalRegisterConversionType(Fam,S,(AToCommonFunc(1)-AToCommonFunc(0)),AToCommonFunc,AFromCommonFunc);
|
|
result:=InternalRegisterConversionType(Fam,S,(AToCommonFunc(1)-AToCommonFunc(0)),AToCommonFunc,AFromCommonFunc);
|
|
end;
|
|
end;
|
|
|
|
|
|
-function SearchConvert(TheType:TConvType; out r:ResourceData):Boolean;
|
|
|
|
-
|
|
|
|
-var l1 : longint;
|
|
|
|
|
|
+function SearchConvert(TheType:TConvType; out r:TResourceData):Boolean;
|
|
|
|
|
|
begin
|
|
begin
|
|
- l1:=length(TheUnits);
|
|
|
|
- if (thetype>=l1) or (theunits[thetype].Deleted) then
|
|
|
|
|
|
+ if not CheckType(TheType) then
|
|
exit(false);
|
|
exit(false);
|
|
r:=theunits[thetype];
|
|
r:=theunits[thetype];
|
|
result:=true;
|
|
result:=true;
|
|
@@ -574,7 +572,7 @@ end;
|
|
function Convert ( const Measurement : Double; const FromType, ToType : TConvType ) :TConvUtilFloat;
|
|
function Convert ( const Measurement : Double; const FromType, ToType : TConvType ) :TConvUtilFloat;
|
|
|
|
|
|
var
|
|
var
|
|
- fromrec,torec : resourcedata;
|
|
|
|
|
|
+ fromrec,torec : TResourceData;
|
|
common: double;
|
|
common: double;
|
|
|
|
|
|
begin
|
|
begin
|
|
@@ -610,7 +608,7 @@ 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;
|
|
var
|
|
var
|
|
fromrec1,fromrec2,torec1 ,
|
|
fromrec1,fromrec2,torec1 ,
|
|
- torec2 : resourcedata;
|
|
|
|
|
|
+ torec2 : TResourceData;
|
|
|
|
|
|
begin
|
|
begin
|
|
if not SearchConvert(fromtype1,fromrec1) then
|
|
if not SearchConvert(fromtype1,fromrec1) then
|
|
@@ -639,7 +637,7 @@ end;
|
|
function ConvertFrom(const AFrom: TConvType; AValue: Double): TConvUtilFloat;
|
|
function ConvertFrom(const AFrom: TConvType; AValue: Double): TConvUtilFloat;
|
|
|
|
|
|
var
|
|
var
|
|
- fromrec : resourcedata;
|
|
|
|
|
|
+ fromrec : TResourceData;
|
|
|
|
|
|
begin
|
|
begin
|
|
if not SearchConvert(AFrom, fromrec) then
|
|
if not SearchConvert(AFrom, fromrec) then
|
|
@@ -653,7 +651,7 @@ end;
|
|
function ConvertTo(const AValue: Double; const ATo: TConvType): TConvUtilFloat;
|
|
function ConvertTo(const AValue: Double; const ATo: TConvType): TConvUtilFloat;
|
|
|
|
|
|
var
|
|
var
|
|
- torec : resourcedata;
|
|
|
|
|
|
+ torec : TResourceData;
|
|
|
|
|
|
begin
|
|
begin
|
|
if not SearchConvert(ATo, torec) then
|
|
if not SearchConvert(ATo, torec) then
|