Marco's Web Center

Menu for Development

Site Menu
Object Pascal Handbook
Delphi Handbooks Collection
Mastering Borland Delphi 2005
(Old) White Papers
(Old)Tools
(Old) Conferences

My Other Sites
Italian Site (www.marcocantu.it)
the delphi search

Spirit of delphi

Advertising
Home My Blog Books Object Pascal Marco

Home: Code Repository: Mastering Delphi 6

Chapter 04 - Project EuroConv

Project Structure

EuroConv.dpr
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.
EuroForm.pas
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.
EuroConvConst.pas
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.
EuroForm.dfm
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