coverter.pas

Yahoo Messenger for Mobile

unit coverter;

interface

uses
  ConvUtils, StdConvs, EuroConv, StrUtils, ComCtrls, StdCtrls, Classes,
  Controls, Forms, Sysutils, Dialogs, SkinCtrls, SkinBoxCtrls, SkinTabs, YchatU1,
  Mask;

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

var
  FConverter: TFConverter;

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 TFConverter.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;
  ConvValueChange(Sender);
end;

procedure TFConverter.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 TFConverter.ConvTypesClick(Sender: TObject);
begin
  ConvValueChange(Sender);
end;

procedure TFConverter.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;

procedure TFConverter.ConvResultsDblClick(Sender: TObject);
Var
 R1,R2,N: Integer;
begin
 For N:=0 to ConvTypes.Items.Count-1 do
   If ConvTypes.Selected[N] Then
     R1:=N;
 For N:=0 to ConvResults.Items.Count-1 do
   If ConvResults.Selected[N] Then
     R2:=N;

  Form1.Say(Form1.Richedit1,ConvValue.Text+' '+ConvTypes.Items[R1]+' is equal to '+ConvResults.Items[R2],False,False,False);
end;

end.