converter.pas

Yahoo Messenger for Mobile

unit converter;

interface

uses
  ConvUtils, StdConvs, EuroConv, StrUtils, ComCtrls, StdCtrls, Classes,
  Controls, Forms, Sysutils;

type
  TForm56 = class(TForm)
  private
    ConvTypes: TListBox;
    ConvValue: TEdit;
    ConvResults: TListBox;
    ConvValueIncDec: TUpDown;
    ConvFamilies: TTabControl;
    StatusBar1: TStatusBar;
    procedure ConvFamiliesChange(Sender: TObject);
    procedure ConvTypesClick(Sender: TObject);
    procedure ConvValueChange(Sender: TObject);
    procedure FormShow(Sender: TObject);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form56: TForm56;

implementation

{$R *.DFM}


function StrToFloat(const S: string): Extended;
begin
  TextToFloat(PChar(S), Result, fvExtended);
end;

function StrToFloatDef(const S: string; const Default: Extended): Extended;
begin
  if not TextToFloat(PChar(S), Result, fvExtended) then
    Result := Default;
end;



function TryStrToFloat(const S: string; out Value: Single): Boolean;
var
  LValue: Extended;
begin
  Result := TextToFloat(PChar(S), LValue, fvExtended);
  if Result then
    Value := LValue;
end;


function StrToCurrDef(const S: string; const Default: Currency): Currency;
begin
  if not TextToFloat(PChar(S), Result, fvCurrency) then
    Result := Default;
end;

function TryStrToCurr(const S: string; out Value: Currency): Boolean;
begin
  Result := TextToFloat(PChar(S), Value, fvCurrency);
end;



procedure TForm56.FormShow(Sender: TObject);
var
  LFamilies: TConvFamilyArray;
  I: Integer;
  LStrings: TStringList;
begin
  ConvFamilies.Tabs.Clear;
  LStrings := TStringList.Create;
  try
    GetConvFamilies(LFamilies);
    for I := 0 to Length(LFamilies) - 1 do
      LStrings.AddObject(ConvFamilyToDescription(LFamilies[I]), TObject(LFamilies[I]));
    LStrings.Sort;
    ConvFamilies.Tabs.Assign(LStrings);
    ConvFamiliesChange(Sender);
  finally
    LStrings.Free;
  end;
end;

procedure TForm56.ConvFamiliesChange(Sender: TObject);
var
  LFamily: TConvFamily;
  LTypes: TConvTypeArray;
  I: Integer;
begin
  LFamily := TConvFamily(ConvFamilies.Tabs.Objects[ConvFamilies.TabIndex]);
  with ConvTypes, Items do
  begin
    BeginUpdate;
    Clear;
    GetConvTypes(LFamily, LTypes);
    for I := 0 to Length(LTypes) - 1 do
      AddObject(ConvTypeToDescription(LTypes[I]), TObject(LTypes[I]));
    ItemIndex := 0;
    EndUpdate;
  end;
  ConvTypesClick(Sender);
end;

procedure TForm56.ConvTypesClick(Sender: TObject);
begin
  ConvValueChange(Sender);
end;

procedure TForm56.ConvValueChange(Sender: TObject);
var
  LValue: Double;
  LBaseType, LTestType: TConvType;
  I: Integer;
begin
  with ConvResults, Items do
  try
    BeginUpdate;
    Clear;
    try
      LValue := StrToFloatDef(ConvValue.Text, 0);
      if ConvTypes.ItemIndex <> -1 then
      begin
        LBaseType := TConvType(ConvTypes.Items.Objects[ConvTypes.ItemIndex]);
        for I := 0 to ConvTypes.Items.Count - 1 do
        begin
          LTestType := TConvType(ConvTypes.Items.Objects[I]);
          Add(Format('%n %s', [Convert(LValue, LBaseType, LTestType),
                               ConvTypeToDescription(LTestType)]));
        end;
      end
      else
        Add('No base type');
    except
      Add('Cannot parse value');
    end;
  finally
    EndUpdate;
  end;
end;


end.