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 ConvDemo

Project Structure

ConvDemo.dpr
program ConvDemo;

uses
  Forms,
  ConvForm in 'ConvForm.pas' {Form1};

{$R *.RES}

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

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Types, StdCtrls, ConvUtils, StdConvs, StrUtils;

type
  TForm1 = class(TForm)
    ComboFamilies: TComboBox;
    ListTypes: TListBox;
    EditType: TEdit;
    EditAmount: TEdit;
    EditConverted: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    BtnSimple: TButton;
    Label6: TLabel;
    EditDestination: TEdit;
    BtnConvert: TButton;
    Label7: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure ChangeFamily(Sender: TObject);
    procedure BtnSimpleClick(Sender: TObject);
    procedure DoConvert(Sender: TObject);
    procedure EditTypeDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure EditTypeDragDrop(Sender, Source: TObject; X, Y: Integer);
  private
    aFamilies: TConvFamilyArray;
    CurrFamily: TConvFamily;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
begin
  GetConvFamilies (aFamilies);
  for i := Low(aFamilies) to High(aFamilies) do
    ComboFamilies.Items.Add (
      ConvFamilyToDescription (aFamilies[i]));
  // get the first and fire event
  ComboFamilies.ItemIndex := 0;
  ChangeFamily (self);
end;

procedure TForm1.ChangeFamily(Sender: TObject);
var
  aTypes: TConvTypeArray;
  i: Integer;
begin
  ListTypes.Clear;
  CurrFamily := aFamilies [ComboFamilies.ItemIndex];
  GetConvTypes (CurrFamily, aTypes);
  for i := Low(aTypes) to High(aTypes) do
    ListTypes.Items.Add (
      ConvTypeToDescription (aTypes[i]));
end;

procedure TForm1.BtnSimpleClick(Sender: TObject);
begin
  // samples

  // convert temperatures: celsius to fahrenheit
  ShowMessage ('31 Celsius -> ' + FloatToStr (
    Convert (31, tuCelsius, tuFahrenheit)) + ' Fahrenheit');

  // convert speed: miles per hour to meters per seconds
  ShowMessage ('20 Miles/Hour -> ' + FloatToStr (
    Convert(20, duMiles, tuHours, duMeters, tuSeconds)) +
    ' Meters/Second');
end;

procedure TForm1.DoConvert(Sender: TObject);
var
  BaseType, DestType: TConvType;
begin
  // get and check base type
  if not DescriptionToConvType(CurrFamily, EditType.Text, BaseType) then
    EditType.Font.Color := clRed
  else
    EditType.Font.Color := clBlack;

  // get and check destination type
  if not DescriptionToConvType(CurrFamily, EditDestination.Text, DestType) then
    EditDestination.Font.Color := clRed
  else
    EditDestination.Font.Color := clBlack;

  if (DestType = 0) or (BaseType = 0) then
    EditConverted.Text := 'Invalid type'
  else
    EditConverted.Text := FloatToStr (Convert (
      StrToFloat (EditAmount.Text), BaseType, DestType));
end;

procedure TForm1.EditTypeDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept := True;
end;

procedure TForm1.EditTypeDragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  (Sender as TEdit).Text := (Source as TListBox).Items
    [(Source as TListBox).ItemIndex];
end;

end.
ConvForm.dfm
object Form1: TForm1
  Left = 192
  Top = 107
  Width = 557
  Height = 290
  Caption = 'ConvDemo (Conversion Demo)'
  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 = 224
    Top = 72
    Width = 54
    Height = 13
    Caption = 'Base &Type:'
  end
  object Label2: TLabel
    Left = 352
    Top = 72
    Width = 39
    Height = 13
    Caption = '&Amount:'
  end
  object Label3: TLabel
    Left = 48
    Top = 16
    Width = 37
    Height = 13
    Caption = '&Families'
  end
  object Label4: TLabel
    Left = 352
    Top = 144
    Width = 88
    Height = 13
    Caption = 'Converted Amount'
  end
  object Label5: TLabel
    Left = 48
    Top = 72
    Width = 32
    Height = 13
    Caption = 'T&ypes:'
  end
  object Label6: TLabel
    Left = 224
    Top = 144
    Width = 80
    Height = 13
    Caption = '&Destination Type'
  end
  object Label7: TLabel
    Left = 352
    Top = 24
    Width = 112
    Height = 39
    Caption = 'Instructions: drag types from list to edit boxes, enter amout'
    WordWrap = True
  end
  object ComboFamilies: TComboBox
    Left = 48
    Top = 32
    Width = 145
    Height = 21
    Style = csDropDownList
    ItemHeight = 13
    TabOrder = 0
    OnChange = ChangeFamily
    OnSelect = ChangeFamily
  end
  object ListTypes: TListBox
    Left = 48
    Top = 88
    Width = 145
    Height = 161
    DragMode = dmAutomatic
    ItemHeight = 13
    TabOrder = 1
  end
  object EditType: TEdit
    Left = 224
    Top = 88
    Width = 121
    Height = 21
    TabOrder = 2
    OnChange = DoConvert
    OnDragDrop = EditTypeDragDrop
    OnDragOver = EditTypeDragOver
  end
  object EditAmount: TEdit
    Left = 352
    Top = 88
    Width = 121
    Height = 21
    TabOrder = 3
    Text = '100'
    OnChange = DoConvert
  end
  object EditConverted: TEdit
    Left = 352
    Top = 160
    Width = 121
    Height = 21
    Color = clInactiveCaptionText
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = []
    ParentFont = False
    ParentShowHint = False
    ReadOnly = True
    ShowHint = False
    TabOrder = 4
  end
  object BtnSimple: TButton
    Left = 232
    Top = 32
    Width = 75
    Height = 25
    Caption = '&Simple Test'
    TabOrder = 5
    OnClick = BtnSimpleClick
  end
  object EditDestination: TEdit
    Left = 224
    Top = 160
    Width = 121
    Height = 21
    TabOrder = 6
    OnChange = DoConvert
    OnDragDrop = EditTypeDragDrop
    OnDragOver = EditTypeDragOver
  end
  object BtnConvert: TButton
    Left = 296
    Top = 208
    Width = 113
    Height = 25
    Caption = '&Convert'
    TabOrder = 7
    OnClick = DoConvert
  end
end