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ù |