Project Structure

• EuroConv.dpr
• EuroForm.pas
• EuroConvConst.pas
• EuroForm.dfm

program EuroConv;

uses
  Forms,
  EuroForm in 'EuroForm.pas' {Form1},
  EuroConvConst in 'EuroConvConst.pas';

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

unit EuroForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    EditValue: TEdit;
    EditResult: TEdit;
    ListTypes: TListBox;
    ListTypes2: TListBox;
    Label1: TLabel;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses
   EuroConvConst, ConvUtils, Math;

procedure TForm1.Button1Click(Sender: TObject);
var
  nConverted: Double;
  BaseType, DestType: TConvType;
begin
  // simple conversions (test)
  {EditResult.Text := FloatToStrF (
    Convert (StrToFloat (EditValue.Text),
    cuDEM, cuITL), ffNumber, 15, 3)}

  DescriptionToConvType(cbEuroCurrency,
    ListTypes.Items [ListTypes.ItemIndex], BaseType);
  DescriptionToConvType(cbEuroCurrency,
    ListTypes2.Items [ListTypes2.ItemIndex], DestType);

  // plain conversions
  {nConverted := Convert (StrToFloat (EditValue.Text),
    BaseType, DestType);
  EditResult.Text := FloatToStrF (nConverted, ffNumber, 15, 4);}

  // Euro "rounding" conversion
  nConverted := EuroConvert (StrToFloat (EditValue.Text),
    BaseType, DestType, 4);
  EditResult.Text := FloatToStrF (nConverted, ffNumber, 15, 4);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  ATypes: TConvTypeArray;
  i: Integer;
begin
  GetConvTypes(cbEuroCurrency, ATypes);
  for i := Low(aTypes) to High(aTypes) do
    ListTypes.Items.Add (
      ConvTypeToDescription (aTypes[i]));
  // copy items to the second list
  ListTypes2.Items := ListTypes.Items;
  // select first of each list
  ListTypes.ItemIndex := 0;
  ListTypes2.ItemIndex := 0;
end;

end.

unit EuroConvConst;

interface

uses
  ConvUtils;

var
  // Euro Currency Conversion Units
  // basic unit of measurement is Euro
  cbEuroCurrency: TConvFamily;

  cuEUR: TConvType;
  cuDEM: TConvType; // Germany
  cuESP: TConvType; // Spain
  cuFRF: TConvType; // France
  cuIEP: TConvType; // Ireland
  cuITL: TConvType; // Italy
  cuBEF: TConvType; // Belgium
  cuNLG: TConvType; // Holland
  cuATS: TConvType; // Austria
  cuPTE: TConvType; // Portugal
  cuFIM: TConvType; // Finland
  cuGRD: TConvType; // Greece
  cuLUF: TConvType; // Luxembourg

type
  TEuroDecimals = 3..6;

function EuroConvert (const AValue: Double; const AFrom, ATo: TConvType;
  const Decimals: TEuroDecimals = 3): Double;

implementation

uses
  Math;

const
  DEMPerEuros = 1.95583;
  ESPPerEuros = 166.386;
  FRFPerEuros = 6.55957;
  IEPPerEuros =  0.787564;
  ITLPerEuros =  1936.27;
  BEFPerEuros =  40.3399;
  NLGPerEuros =  2.20371;
  ATSPerEuros =  13.7603;
  PTEPerEuros =  200.482;
  FIMPerEuros =  5.94573;
  GRDPerEuros = 340.750;
  LUFPerEuros = 40.3399;

function EuroConvert (const AValue: Double; const AFrom, ATo: TConvType;
  const Decimals: TEuroDecimals = 3): Double;
begin
  // check special case: no conversion
  if AFrom = ATo then
    Result := AValue
  else
  begin
    // convert to Euro, than round
    Result := ConvertFrom (AFrom, AValue);
    Result := RoundTo (Result, -Decimals);
    // convert to currency than round again
    Result := ConvertTo (Result, ATo);
    Result := RoundTo (Result, -Decimals);
  end;
end;


initialization
  // Euro Currency's family type
  cbEuroCurrency := RegisterConversionFamily('EuroCurrency');

  cuEUR := RegisterConversionType(cbEuroCurrency, 'Euro (€)', 1);
  cuDEM := RegisterConversionType(cbEuroCurrency, 'German Marks (DEM)', 1 / DEMPerEuros);
  cuESP := RegisterConversionType(cbEuroCurrency, 'Spanish Pesetas (ESP)', 1 / ESPPerEuros);
  cuFRF := RegisterConversionType(cbEuroCurrency, 'French Francs (FRF)', 1 / FRFPerEuros);
  cuIEP := RegisterConversionType(cbEuroCurrency, 'Irish Pounds (IEP)', 1 / IEPPerEuros);
  cuITL := RegisterConversionType(cbEuroCurrency, 'Italian Lire (ITL)', 1 / ITLPerEuros);
  cuBEF := RegisterConversionType(cbEuroCurrency, 'Belgian Francs (BEF)', 1 / BEFPerEuros);
  cuNLG := RegisterConversionType(cbEuroCurrency, 'Dutch Guilders (NLG)', 1 / NLGPerEuros);
  cuATS := RegisterConversionType(cbEuroCurrency, 'Austrian Schillings (ATS)', 1 / ATSPerEuros);
  cuPTE := RegisterConversionType(cbEuroCurrency, 'Portuguese Escudos (PTE)', 1 / PTEPerEuros);
  cuFIM := RegisterConversionType(cbEuroCurrency, 'Finnish Marks (FIM)', 1 / FIMPerEuros);
  cuGRD := RegisterConversionType(cbEuroCurrency, 'Greek Drachmas (GRD)', 1 / GRDPerEuros);
  cuLUF := RegisterConversionType(cbEuroCurrency, 'Luxembourg Francs (LUF)', 1 / LUFPerEuros);
end.

object Form1: TForm1
  Left = 195
  Top = 108
  Width = 414
  Height = 250
  Caption = 'Euro Conversion'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 8
    Top = 196
    Width = 30
    Height = 13
    Caption = 'Value:'
  end
  object Label2: TLabel
    Left = 214
    Top = 196
    Width = 33
    Height = 13
    Caption = 'Result:'
  end
  object Button1: TButton
    Left = 168
    Top = 8
    Width = 75
    Height = 177
    Caption = 'Convert'
    TabOrder = 0
    OnClick = Button1Click
  end
  object EditValue: TEdit
    Left = 40
    Top = 192
    Width = 145
    Height = 21
    TabOrder = 1
    Text = '120'
  end
  object EditResult: TEdit
    Left = 256
    Top = 192
    Width = 145
    Height = 21
    TabOrder = 2
  end
  object ListTypes: TListBox
    Left = 8
    Top = 8
    Width = 153
    Height = 177
    ItemHeight = 13
    TabOrder = 3
  end
  object ListTypes2: TListBox
    Left = 248
    Top = 5
    Width = 153
    Height = 180
    ItemHeight = 13
    TabOrder = 4
  end
end