EuroConvConst.pas
上传用户:fh681027
上传日期:2022-07-23
资源大小:1959k
文件大小:3k
源码类别:

Delphi控件源码

开发平台:

Delphi

  1. unit EuroConvConst;
  2. interface
  3. uses
  4.   ConvUtils;
  5. var
  6.   // Euro Currency Conversion Units
  7.   // basic unit of measurement is Euro
  8.   cbEuroCurrency: TConvFamily;
  9.   cuEUR: TConvType;
  10.   cuDEM: TConvType; // Germany
  11.   cuESP: TConvType; // Spain
  12.   cuFRF: TConvType; // France
  13.   cuIEP: TConvType; // Ireland
  14.   cuITL: TConvType; // Italy
  15.   cuBEF: TConvType; // Belgium
  16.   cuNLG: TConvType; // Holland
  17.   cuATS: TConvType; // Austria
  18.   cuPTE: TConvType; // Portugal
  19.   cuFIM: TConvType; // Finland
  20.   cuGRD: TConvType; // Greece
  21.   cuLUF: TConvType; // Luxembourg
  22. type
  23.   TEuroDecimals = 3..6;
  24. function EuroConvert (const AValue: Double; const AFrom, ATo: TConvType;
  25.   const Decimals: TEuroDecimals = 3): Double;
  26. implementation
  27. uses
  28.   Math;
  29. const
  30.   DEMPerEuros = 1.95583;
  31.   ESPPerEuros = 166.386;
  32.   FRFPerEuros = 6.55957;
  33.   IEPPerEuros =  0.787564;
  34.   ITLPerEuros =  1936.27;
  35.   BEFPerEuros =  40.3399;
  36.   NLGPerEuros =  2.20371;
  37.   ATSPerEuros =  13.7603;
  38.   PTEPerEuros =  200.482;
  39.   FIMPerEuros =  5.94573;
  40.   GRDPerEuros = 340.750;
  41.   LUFPerEuros = 40.3399;
  42. function EuroConvert (const AValue: Double; const AFrom, ATo: TConvType;
  43.   const Decimals: TEuroDecimals = 3): Double;
  44. begin
  45.   // check special case: no conversion
  46.   if AFrom = ATo then
  47.     Result := AValue
  48.   else
  49.   begin
  50.     // convert to Euro, than round
  51.     Result := ConvertFrom (AFrom, AValue);
  52.     Result := RoundTo (Result, -Decimals);
  53.     // convert to currency than round again
  54.     Result := ConvertTo (Result, ATo);
  55.     Result := RoundTo (Result, -Decimals);
  56.   end;
  57. end;
  58. initialization
  59.   // Euro Currency's family type
  60.   cbEuroCurrency := RegisterConversionFamily('EuroCurrency');
  61.   cuEUR := RegisterConversionType(cbEuroCurrency, 'Euro (