Marco Web Center

[an error occurred while processing this directive]

Home: Code Repository: Delphi 2009 Handbook

Project: CustomerDictionary.dproj

Project Structure

CustomerDictionary.dpr
program CustomerDictionary;

uses
  Forms,
  CustomerDictionary_MainForm in 'CustomerDictionary_MainForm.pas' {FormCustomerDictionary},
  CustomerClasses in 'CustomerClasses.pas',
  CustomerDataModule in 'CustomerDataModule.pas' {DataModule1: TDataModule};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TFormCustomerDictionary, FormCustomerDictionary);
  Application.CreateForm(TDataModule1, DataModule1);
  Application.Run;
end.
CustomerDictionary_MainForm.pas
unit CustomerDictionary_MainForm;

interface

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

type
  TFormCustomerDictionary = class(TForm)
    btnPopulate: TButton;
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
    procedure btnPopulateClick(Sender: TObject);
    procedure ListView1SelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
  private
    CustDict: TCustomerDictionary;
  public
    { Public declarations }
  end;

var
  FormCustomerDictionary: TFormCustomerDictionary;

implementation

uses
  CustomerDataModule, strUtils;

{$R *.dfm}

procedure TFormCustomerDictionary.btnPopulateClick(Sender: TObject);
var
  custkey: TCustomerKey;
  listItem: TListItem;
begin
  DataModule1.ClientDataSet1.Active := True;
  CustDict.LoadFromDataSet(DataModule1.ClientDataSet1);

  for custkey in CustDict.Keys do
  begin
    listItem := ListView1.Items.Add;
    listItem.Caption := custkey.Company;
    listItem.SubItems.Add(FloatTOStr (custkey.CustNo));
    listItem.Data := custkey;
  end;
end;

procedure TFormCustomerDictionary.FormCreate(Sender: TObject);
begin
  CustDict := TCustomerDictionary.Create;
end;

procedure TFormCustomerDictionary.ListView1SelectItem(Sender: TObject;
  Item: TListItem; Selected: Boolean);
var
  aCustomer: TCustomer;
begin
  aCustomer := CustDict.Items [Item.data];
  Item.SubItems.Add(IfThen (aCustomer.State <> '',
    aCustomer.State + ', ' + aCustomer.Country, aCustomer.Country));
end;

end.
CustomerDictionary_MainForm.pas.dfm
object FormCustomerDictionary: TFormCustomerDictionary
  Left = 0
  Top = 0
  Caption = 'CustomerDictionary'
  ClientHeight = 322
  ClientWidth = 604
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object btnPopulate: TButton
    Left = 16
    Top = 8
    Width = 75
    Height = 25
    Caption = 'btnPopulate'
    TabOrder = 0
    OnClick = btnPopulateClick
  end
  object ListView1: TListView
    Left = 16
    Top = 39
    Width = 569
    Height = 266
    Columns = <
      item
        AutoSize = True
        Caption = 'Name'
      end
      item
        AutoSize = True
        Caption = 'ID'
      end
      item
        AutoSize = True
        Caption = 'Country'
      end>
    TabOrder = 1
    ViewStyle = vsReport
    OnSelectItem = ListView1SelectItem
  end
end
CustomerClasses.pas
unit CustomerClasses;

interface

uses
  Classes, Generics.Collections, DB;

{$M+}

type
  TCustomerKey = class
  private
    FCustNo: Double;
    FCompany: string;
    procedure SetCompany(const Value: string);
    procedure SetCustNo(const Value: Double);
  published
    property CustNo: Double read FCustNo write SetCustNo;
    property Company: string read FCompany write SetCompany;
  end;

  TCustomer = class
  private
    FCustNo: Double;
    FFAX: string;
    FZip: string;
    FState: string;
    FCompany: string;
    FPhone: string;
    FCountry: string;
    FAddr1: string;
    FCity: string;
    FContact: string;
    fInitDone: Boolean;
    FCustKey: TCustomerKey;
    procedure SetAddr1(const Value: string);
    procedure SetCity(const Value: string);
    procedure SetCompany(const Value: string);
    procedure SetContact(const Value: string);
    procedure SetCountry(const Value: string);
    procedure SetCustNo(const Value: Double);
    procedure SetFAX(const Value: string);
    procedure SetPhone(const Value: string);
    procedure SetState(const Value: string);
    procedure SetZip(const Value: string);
    procedure SetCustKey(const Value: TCustomerKey);
    function GetAddr1: string;
    function GetCity: string;
    function GetCompany: string;
    function GetContact: string;
    function GetCountry: string;
    function GetCustNo: Double;
    function GetFAX: string;
    function GetPhone: string;
    function GetState: string;
    function GetZip: string;
    procedure Init;
    procedure EnforceInit;
  public
    constructor Create (aCustKey: TCustomerKey);
    property CustKey: TCustomerKey read FCustKey write SetCustKey;
  published
    property CustNo: Double read GetCustNo write SetCustNo;
    property Company: string read GetCompany write SetCompany;
    property Addr1: string read GetAddr1 write SetAddr1;
    property City: string read GetCity write SetCity;
    property State: string read GetState write SetState;
    property Zip: string read GetZip write SetZip;
    property Country: string read GetCountry write SetCountry;
    property Phone: string read GetPhone write SetPhone;
    property FAX: string read GetFAX write SetFAX;
    property Contact: string read GetContact write SetContact;
  class var
    RefDataSet: TDataSet;
  end;

  TCustomerDictionary = class (TObjectDictionary <TCustomerKey, TCustomer>)
  public
    procedure LoadFromDataSet (dataset: TDataSet);
  end;

{$M-}


implementation

{ TCustomer }

constructor TCustomer.Create(aCustKey: TCustomerKey);
begin
  FCustKey := aCustKey;
end;

procedure TCustomer.EnforceInit;
begin
  if not fInitDone then
    Init;
end;

function TCustomer.GetAddr1: string;
begin
  EnforceInit;
  Result := FAddr1;
end;

function TCustomer.GetCity: string;
begin
  EnforceInit;
  Result := FCity;
end;

function TCustomer.GetCompany: string;
begin
  EnforceInit;
  Result := FCompany;
end;

function TCustomer.GetContact: string;
begin
  EnforceInit;
  Result := FContact;
end;

function TCustomer.GetCountry: string;
begin
  EnforceInit;
  Result := FCountry;
end;

function TCustomer.GetCustNo: Double;
begin
  EnforceInit;
  Result := FCustNo;
end;

function TCustomer.GetFAX: string;
begin
  EnforceInit;
  Result := FFAX;
end;

function TCustomer.GetPhone: string;
begin
  EnforceInit;
  Result := FPhone;
end;

function TCustomer.GetState: string;
begin
  EnforceInit;
  Result := FState;
end;

function TCustomer.GetZip: string;
begin
  EnforceInit;
  Result := FZip;
end;

procedure TCustomer.Init;
begin
  RefDataSet.Locate('custno', CustKey.CustNo, []);
  // could also load each published field via RTTI
  FCustNo := RefDataSet.FieldByName ('CustNo').AsFloat;
  FFAX := RefDataSet.FieldByName ('FAX').AsString;
  FZip := RefDataSet.FieldByName ('Zip').AsString;
  FState := RefDataSet.FieldByName ('State').AsString;
  FCompany := RefDataSet.FieldByName ('Company').AsString;
  FPhone := RefDataSet.FieldByName ('Phone').AsString;
  FCountry := RefDataSet.FieldByName ('Country').AsString;
  FAddr1 := RefDataSet.FieldByName ('Addr1').AsString;
  FCity := RefDataSet.FieldByName ('City').AsString;
  FContact := RefDataSet.FieldByName ('Contact').AsString;
  fInitDone := True;
end;

procedure TCustomer.SetAddr1(const Value: string);
begin
  FAddr1 := Value;
end;

procedure TCustomer.SetCity(const Value: string);
begin
  FCity := Value;
end;

procedure TCustomer.SetCompany(const Value: string);
begin
  FCompany := Value;
end;

procedure TCustomer.SetContact(const Value: string);
begin
  FContact := Value;
end;

procedure TCustomer.SetCountry(const Value: string);
begin
  FCountry := Value;
end;

procedure TCustomer.SetCustKey(const Value: TCustomerKey);
begin
  FCustKey := Value;
end;

procedure TCustomer.SetCustNo(const Value: Double);
begin
  FCustNo := Value;
end;

procedure TCustomer.SetFAX(const Value: string);
begin
  FFAX := Value;
end;

procedure TCustomer.SetPhone(const Value: string);
begin
  FPhone := Value;
end;

procedure TCustomer.SetState(const Value: string);
begin
  FState := Value;
end;

procedure TCustomer.SetZip(const Value: string);
begin
  FZip := Value;
end;

{ TCustomerKey }

procedure TCustomerKey.SetCompany(const Value: string);
begin
  FCompany := Value;
end;

procedure TCustomerKey.SetCustNo(const Value: Double);
begin
  FCustNo := Value;
end;

{ TCustomerDictionary }

procedure TCustomerDictionary.LoadFromDataSet(dataset: TDataSet);
var
  custKey: TCustomerKey;
begin
  TCustomer.RefDataSet := dataset;

  dataset.First;
  while not dataset.EOF do
  begin
    custKey := TCustomerKey.Create;
    custKey.CustNo := dataset ['CustNo'];
    custKey.Company := dataset ['Company'];
    self.Add(custKey, TCustomer.Create (custKey));
    dataset.Next;
  end;
end;

end.
CustomerDataModule.pas
unit CustomerDataModule;

interface

uses
  SysUtils, Classes, DB, DBClient;

type
  TDataModule1 = class(TDataModule)
    ClientDataSet1: TClientDataSet;
    ClientDataSet1CustNo: TFloatField;
    ClientDataSet1Company: TStringField;
    ClientDataSet1Addr1: TStringField;
    ClientDataSet1Addr2: TStringField;
    ClientDataSet1City: TStringField;
    ClientDataSet1State: TStringField;
    ClientDataSet1Zip: TStringField;
    ClientDataSet1Country: TStringField;
    ClientDataSet1Phone: TStringField;
    ClientDataSet1FAX: TStringField;
    ClientDataSet1TaxRate: TFloatField;
    ClientDataSet1Contact: TStringField;
    ClientDataSet1LastInvoiceDate: TDateTimeField;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  DataModule1: TDataModule1;

implementation

{$R *.dfm}

end.
CustomerDataModule.pas.dfm
object DataModule1: TDataModule1
  OldCreateOrder = False
  Height = 234
  Width = 281
  object ClientDataSet1: TClientDataSet
    Aggregates = <>
    FileName = 'C:\Program Files\Common Files\CodeGear Shared\Data\customer.cds'
    Params = <>
    Left = 104
    Top = 72
    object ClientDataSet1CustNo: TFloatField
      FieldName = 'CustNo'
    end
    object ClientDataSet1Company: TStringField
      FieldName = 'Company'
      Size = 30
    end
    object ClientDataSet1Addr1: TStringField
      FieldName = 'Addr1'
      Size = 30
    end
    object ClientDataSet1Addr2: TStringField
      FieldName = 'Addr2'
      Size = 30
    end
    object ClientDataSet1City: TStringField
      FieldName = 'City'
      Size = 15
    end
    object ClientDataSet1State: TStringField
      FieldName = 'State'
    end
    object ClientDataSet1Zip: TStringField
      FieldName = 'Zip'
      Size = 10
    end
    object ClientDataSet1Country: TStringField
      FieldName = 'Country'
    end
    object ClientDataSet1Phone: TStringField
      FieldName = 'Phone'
      Size = 15
    end
    object ClientDataSet1FAX: TStringField
      FieldName = 'FAX'
      Size = 15
    end
    object ClientDataSet1TaxRate: TFloatField
      FieldName = 'TaxRate'
    end
    object ClientDataSet1Contact: TStringField
      FieldName = 'Contact'
    end
    object ClientDataSet1LastInvoiceDate: TDateTimeField
      FieldName = 'LastInvoiceDate'
    end
  end
end
HTML file generated by PasToWeb, a tool by Marco Cantù
Copyright 2008 Marco Cantù