delphi10.2的度量单位转换实用程序单元ConvUtils.pas

这个单元提供了度量单位转换引擎，没有内置转换类型，需要与StdConvs.pas配合使用 。

type
  TConvFamily = type Word;
  TConvType = type Word;
  TConversionProc = function(const AValue: Double): Double;
  TConvTypeArray = array of TConvType;
  TConvFamilyArray = array of TConvFamily;

// 两种度量类型之间的简单转换
function Convert(const AValue: Double; const AFrom, ATo: TConvType): Double; overload;

// 两个双重度量类型之间的复杂转换。
//  一个例子是将英里/小时换算成米/分钟( 速度) 或者加仑/分钟换算成升/小时(流量) 。
//  有很多组合，但不是所有的组合都有意义。
function Convert(const AValue: Double; const AFrom1, AFrom2, ATo1, ATo2: TConvType): Double; overload;

// 转换为一个特定的转换家族的基本单位类型
function ConvertFrom(const AFrom: TConvType; const AValue: Double): Double;
function ConvertTo(const AValue: Double; const ATo: TConvType): Double;

// 加/减两个值并以指定的类型返回结果
function ConvUnitAdd(const AValue1: Double; const AType1: TConvType; const AValue2: Double; const AType2, AResultType: TConvType): Double;
function ConvUnitDiff(const AValue1: Double; const AType1: TConvType; const AValue2: Double; const AType2, AResultType: TConvType): Double;

// 通过指定类型的值递增/递减一个值
function ConvUnitInc(const AValue: Double; const AType, AAmountType: TConvType): Double; overload;
function ConvUnitInc(const AValue: Double; const AType: TConvType; const AAmount: Double; const AAmountType: TConvType): Double; overload;
function ConvUnitDec(const AValue: Double; const AType, AAmountType: TConvType): Double; overload;
function ConvUnitDec(const AValue: Double; const AType: TConvType; const AAmount: Double; const AAmountType: TConvType): Double; overload;

//
// 检查给定值是否在一个给定确定类型的单位的前一个（或下一个）中
function ConvUnitWithinPrevious(const AValue, ATest: Double; const AType: TConvType; const AAmount: Double; const AAmountType: TConvType): Boolean;
function ConvUnitWithinNext(const AValue, ATest: Double; const AType: TConvType; const AAmount: Double; const AAmountType: TConvType): Boolean;

// 比较和等式测试
function ConvUnitCompareValue(const AValue1: Double; const AType1: TConvType; const AValue2: Double; const AType2: TConvType): TValueRelationship;
function ConvUnitSameValue(const AValue1: Double; const AType1: TConvType; const AValue2: Double; const AType2: TConvType): Boolean;

// 转换类型的注册/注销。
//  当注册的单位完成或不再使用时，您应该注销您的转换类型。

function RegisterConversionType(const AFamily: TConvFamily;const ADescription: string; const AFactor: Double): TConvType; overload;
function RegisterConversionType(const AFamily: TConvFamily; const ADescription: string; const AToCommonProc, AFromCommonProc: TConversionProc): TConvType; overload;
procedure UnregisterConversionType(const AType: TConvType);

// 转换家族的注册/注销。
//  当注册的单位完成或不再使用时，您应该注销您的转换家族。
function RegisterConversionFamily(const ADescription: string): TConvFamily;
procedure UnregisterConversionFamily(const AFamily: TConvFamily);

// 兼容性测试
function CompatibleConversionTypes(const AFrom, ATo: TConvType): Boolean;
function CompatibleConversionType(const AType: TConvType; const AFamily: TConvFamily): Boolean;

// 发现支持函数
procedure GetConvTypes(const AFamily: TConvFamily; out ATypes: TConvTypeArray);
procedure GetConvFamilies(out AFamilies: TConvFamilyArray);

// 字符串解析支持
function StrToConvUnit(AText: string; out AType: TConvType): Double;
function TryStrToConvUnit(AText: string; out AValue: Double; out AType: TConvType): Boolean;
function ConvUnitToStr(const AValue: Double; const AType: TConvType): string;

// 描述 格式/解析函数
function ConvTypeToDescription(const AType: TConvType): string;
function ConvFamilyToDescription(const AFamily: TConvFamily): string;
function DescriptionToConvType(const ADescription: string;out AType: TConvType): Boolean; overload;
function DescriptionToConvType(const AFamily: TConvFamily;const ADescription: string; out AType: TConvType): Boolean; overload;
function DescriptionToConvFamily(const ADescription: string; out AFamily: TConvFamily): Boolean;

// ConvType 家族支持
function ConvTypeToFamily(const AType: TConvType): TConvFamily; overload;
function TryConvTypeToFamily(const AType: TConvType; out AFamily: TConvFamily): Boolean; overload;

function ConvTypeToFamily(const AFrom, ATo: TConvType): TConvFamily; overload;
function TryConvTypeToFamily(const AFrom, ATo: TConvType; out AFamily: TConvFamily): Boolean; overload;

// Error procs
procedure RaiseConversionError(const AText: string); overload;
procedure RaiseConversionError(const AText: string; const AArgs: array of const); overload;
procedure RaiseConversionRegError(AFamily: TConvFamily; const ADescription: string);

type
  EConversionError = class(Exception);

const
  CIllegalConvFamily: TConvFamily = 0;
  CIllegalConvType: TConvType = 0;

var
  GConvUnitToStrFmt: string = '%f %s';

// 自定义转换类型支持
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;
  TConvTypeList = array of TConvTypeInfo;

  TConvTypeFactor = class(TConvTypeInfo)
  private
    FFactor: Double;
  protected
    property Factor: Double read FFactor;
  public
    constructor Create(const AConvFamily: TConvFamily; const ADescription: string; const AFactor: Double);
    function ToCommon(const AValue: Double): Double; override;
    function FromCommon(const AValue: Double): Double; override;
  end;

  TConvTypeProcs = class(TConvTypeInfo)
  private
    FToCommonProc: TConversionProc;
    FFromCommonProc: TConversionProc;
  public
    constructor Create(const AConvFamily: TConvFamily; const ADescription: string; const AToCommonProc, AFromCommonProc: TConversionProc);
    function ToCommon(const AValue: Double): Double; override;
    function FromCommon(const AValue: Double): Double; override;
  end;

function RegisterConversionType(AConvTypeInfo: TConvTypeInfo; out AType: TConvType): Boolean; overload;