instantobjects-cvscommit

[Carlo B. <car...@us...>]

Update of /cvsroot/instantobjects/Demos/PrimerCross
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv19405/Demos/PrimerCross

Modified Files:
	CompanyBrowse.pas CompanyEdit.pas ContactBrowse.pas 
	ContactEdit.pas ContactFilterEdit.dfm ContactFilterEdit.pas 
	ContactSort.dfm ContactSort.pas ContactView.pas 
	CountryBrowse.pas DemoData.pas Main.pas MainData.pas 
	PerformanceView.pas PersonBrowse.pas PersonEdit.pas Primer.dpr 
Added Files:
	ModelExternal.pas PrimerExternal.cfg PrimerExternal.dpr 
	PrimerExternal.mdr 
Log Message:
External support added to Primer demo: new ModelExterna.pas and PrimerCrossExternal.dpr (must be compiled with EXTERNALSTORAGE directive)

Index: PerformanceView.pas
===================================================================
RCS file: /cvsroot/instantobjects/Demos/PrimerCross/PerformanceView.pas,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** PerformanceView.pas	23 Aug 2004 09:55:19 -0000	1.3
--- PerformanceView.pas	6 Dec 2004 08:49:15 -0000	1.4
***************
*** 171,175 ****
  
  uses
!   Model, DemoData, IniFiles, Utility;
  
  { TTestResult }
--- 171,176 ----
  
  uses
! {$IFDEF EXTERNALSTORAGE}ModelExternal,{$ELSE}Model,{$ENDIF}
!   DemoData, IniFiles, Utility;
  
  { TTestResult }
***************
*** 662,666 ****
  begin
    inherited;
!   TInstantSQLBroker(Connector.Broker).UsePreparedQuery := PreparedQueryCheckBox.Checked;
  end;
  
--- 663,668 ----
  begin
    inherited;
!   if Connector.Broker is TInstantSQLBroker then
!     TInstantSQLBroker(Connector.Broker).UsePreparedQuery := PreparedQueryCheckBox.Checked;
  end;
  

Index: ContactFilterEdit.pas
===================================================================
RCS file: /cvsroot/instantobjects/Demos/PrimerCross/ContactFilterEdit.pas,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** ContactFilterEdit.pas	20 Jul 2004 11:05:15 -0000	1.1
--- ContactFilterEdit.pas	6 Dec 2004 08:49:15 -0000	1.2
***************
*** 13,17 ****
    QStdCtrls, QGrids, QDBGrids, QMask, QDBCtrls, QExtCtrls, QComCtrls,
  {$ENDIF}
!   ContactEdit, DB, InstantPresentation, Model;
  
  type
--- 13,18 ----
    QStdCtrls, QGrids, QDBGrids, QMask, QDBCtrls, QExtCtrls, QComCtrls,
  {$ENDIF}
! {$IFDEF EXTERNALSTORAGE}ModelExternal,{$ELSE}Model,{$ENDIF}
!   ContactEdit, DB, InstantPresentation;
  
  type

Index: ContactSort.dfm
===================================================================
RCS file: /cvsroot/instantobjects/Demos/PrimerCross/ContactSort.dfm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** ContactSort.dfm	20 Jul 2004 11:05:15 -0000	1.1
--- ContactSort.dfm	6 Dec 2004 08:49:15 -0000	1.2
***************
*** 2,8 ****
    Left = 334
    Top = 264
    Caption = 'Sort'
-   ClientHeight = 233
-   ClientWidth = 353
    Color = clBtnFace
    Font.Charset = DEFAULT_CHARSET
--- 2,8 ----
    Left = 334
    Top = 264
+   Width = 378
+   Height = 267
    Caption = 'Sort'
    Color = clBtnFace
    Font.Charset = DEFAULT_CHARSET

Index: PersonBrowse.pas
===================================================================
RCS file: /cvsroot/instantobjects/Demos/PrimerCross/PersonBrowse.pas,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** PersonBrowse.pas	20 Jul 2004 11:05:15 -0000	1.1
--- PersonBrowse.pas	6 Dec 2004 08:49:16 -0000	1.2
***************
*** 13,17 ****
    QActnList, QGrids, QDBGrids, QExtCtrls, QComCtrls, QStdCtrls,
  {$ENDIF}
!   ContactBrowse, Db, InstantPresentation, Model;
  
  type
--- 13,18 ----
    QActnList, QGrids, QDBGrids, QExtCtrls, QComCtrls, QStdCtrls,
  {$ENDIF}
! {$IFDEF EXTERNALSTORAGE}ModelExternal,{$ELSE}Model,{$ENDIF}
!   ContactBrowse, Db, InstantPresentation;
  
  type

Index: ContactBrowse.pas
===================================================================
RCS file: /cvsroot/instantobjects/Demos/PrimerCross/ContactBrowse.pas,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** ContactBrowse.pas	20 Jul 2004 11:05:15 -0000	1.1
--- ContactBrowse.pas	6 Dec 2004 08:49:15 -0000	1.2
***************
*** 11,17 ****
  {$IFDEF LINUX}
    QGraphics, QControls, QForms, QDialogs, QStdCtrls,
!   QMenus, QImgList, QActnList, QGrids, QDBGrids, QExtCtrls, QComCtrls,
  {$ENDIF}
!   BasicBrowse, DB, InstantPresentation, Model, QTypes;
    
  type
--- 11,18 ----
  {$IFDEF LINUX}
    QGraphics, QControls, QForms, QDialogs, QStdCtrls,
!   QMenus, QImgList, QActnList, QGrids, QDBGrids, QExtCtrls, QComCtrls, QTypes,
  {$ENDIF}
! {$IFDEF EXTERNALSTORAGE}ModelExternal,{$ELSE}Model,{$ENDIF}
!   BasicBrowse, DB, InstantPresentation;
    
  type

Index: CompanyEdit.pas
===================================================================
RCS file: /cvsroot/instantobjects/Demos/PrimerCross/CompanyEdit.pas,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** CompanyEdit.pas	4 Aug 2004 22:43:38 -0000	1.3
--- CompanyEdit.pas	6 Dec 2004 08:49:15 -0000	1.4
***************
*** 14,18 ****
    QMask, QDBCtrls, QComCtrls, QMenus, QImgList, QActnList, QButtons,
  {$ENDIF}
!   ContactEdit, DB, InstantPresentation, Model;
  
  type
--- 14,19 ----
    QMask, QDBCtrls, QComCtrls, QMenus, QImgList, QActnList, QButtons,
  {$ENDIF}
! {$IFDEF EXTERNALSTORAGE}ModelExternal,{$ELSE}Model,{$ENDIF}
!   ContactEdit, DB, InstantPresentation;
  
  type

Index: ContactEdit.pas
===================================================================
RCS file: /cvsroot/instantobjects/Demos/PrimerCross/ContactEdit.pas,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** ContactEdit.pas	20 Jul 2004 11:05:15 -0000	1.1
--- ContactEdit.pas	6 Dec 2004 08:49:15 -0000	1.2
***************
*** 13,17 ****
    QStdCtrls, QExtCtrls, QMask, QDBCtrls, QGrids, QDBGrids, QComCtrls,
  {$ENDIF}
!   BasicEdit, Db, InstantPresentation, Model;
  
  type
--- 13,18 ----
    QStdCtrls, QExtCtrls, QMask, QDBCtrls, QGrids, QDBGrids, QComCtrls,
  {$ENDIF}
! {$IFDEF EXTERNALSTORAGE}ModelExternal,{$ELSE}Model,{$ENDIF}
!   BasicEdit, Db, InstantPresentation;
  
  type

Index: ContactView.pas
===================================================================
RCS file: /cvsroot/instantobjects/Demos/PrimerCross/ContactView.pas,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** ContactView.pas	4 Aug 2004 22:43:38 -0000	1.3
--- ContactView.pas	6 Dec 2004 08:49:15 -0000	1.4
***************
*** 21,25 ****
    QStdCtrls, QActnList, QImgList, QMenus,
  {$ENDIF}
!   BasicView, Model, InstantPresentation, InstantExplorer;
  
  type
--- 21,26 ----
    QStdCtrls, QActnList, QImgList, QMenus,
  {$ENDIF}
! {$IFDEF EXTERNALSTORAGE}ModelExternal,{$ELSE}Model,{$ENDIF}
!   BasicView, InstantPresentation, InstantExplorer;
  
  type

Index: CountryBrowse.pas
===================================================================
RCS file: /cvsroot/instantobjects/Demos/PrimerCross/CountryBrowse.pas,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** CountryBrowse.pas	20 Jul 2004 11:05:15 -0000	1.1
--- CountryBrowse.pas	6 Dec 2004 08:49:15 -0000	1.2
***************
*** 15,19 ****
    QComCtrls, QStdCtrls,
  {$ENDIF}
!   InstantPresentation, Model;
  
  type
--- 15,20 ----
    QComCtrls, QStdCtrls,
  {$ENDIF}
! {$IFDEF EXTERNALSTORAGE}ModelExternal,{$ELSE}Model,{$ENDIF}
!   InstantPresentation;
  
  type

Index: Primer.dpr
===================================================================
RCS file: /cvsroot/instantobjects/Demos/PrimerCross/Primer.dpr,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** Primer.dpr	29 Jul 2004 20:43:09 -0000	1.2
--- Primer.dpr	6 Dec 2004 08:49:16 -0000	1.3
***************
*** 1,5 ****
  (*
   *   InstantObjects
!  *   Primer Demo
   *
   *)
--- 1,5 ----
  (*
   *   InstantObjects
!  *   Primer Demo - with "internal storage" of Part and Parts
   *
   *)

Index: MainData.pas
===================================================================
RCS file: /cvsroot/instantobjects/Demos/PrimerCross/MainData.pas,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** MainData.pas	20 Jul 2004 11:05:15 -0000	1.1
--- MainData.pas	6 Dec 2004 08:49:15 -0000	1.2
***************
*** 34,38 ****
  
  uses
!   Model;
  
  {$R *.dfm}
--- 34,38 ----
  
  uses
! {$IFDEF EXTERNALSTORAGE}ModelExternal;{$ELSE}Model;{$ENDIF}
  
  {$R *.dfm}

--- NEW FILE: PrimerExternal.dpr ---
(*
 *   InstantObjects
 *   Primer Demo - with "external storage" of Part and Parts
 *
 *)

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is: Seleqt InstantObjects
 *
 * The Initial Developer of the Original Code is: Seleqt
 *
 * Portions created by the Initial Developer are Copyright (C) 2001-2003
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 * Carlo Barazzetta:
 * - cross-platform porting for Delphi & Kilix
 * - PerformanceView form changed to make tests with UsePreparedQuery
 * Salary attribute of type Currency added to Person
 * PersonEdit form and random data form changed to test Graphic support
 * ***** END LICENSE BLOCK ***** *)

program PrimerExternal;

uses
  Forms,
  Main in 'Main.pas' {MainForm},
  ModelExternal in 'ModelExternal.pas',
  ContactView in 'ContactView.pas' {ContactViewForm: TFrame},
  BasicView in 'BasicView.pas' {BasicViewForm: TFrame},
  BasicEdit in 'BasicEdit.pas' {BasicEditForm},
  ContactEdit in 'ContactEdit.pas' {ContactEditForm},
  PersonEdit in 'PersonEdit.pas' {PersonEditForm},
  CompanyEdit in 'CompanyEdit.pas' {CompanyEditForm},
  DemoData in 'DemoData.pas',
  ContactFilterEdit in 'ContactFilterEdit.pas' {ContactFilterEditForm},
  MainData in 'MainData.pas' {MainDataModule: TDataModule},
  ContactBrowse in 'ContactBrowse.pas' {ContactBrowseForm},
  CompanyBrowse in 'CompanyBrowse.pas' {CompanyBrowseForm},
  PerformanceView in 'PerformanceView.pas' {PerformanceViewForm: TFrame},
  Welcome in 'Welcome.pas' {WelcomeForm},
  PersonBrowse in 'PersonBrowse.pas' {PersonBrowseForm},
  BasicBrowse in 'BasicBrowse.pas' {BasicBrowseForm},
  CountryBrowse in 'CountryBrowse.pas' {CountryBrowseForm},
  DemoDataRequest in 'DemoDataRequest.pas' {DemoDataRequestForm},
  ContactSort in 'ContactSort.pas' {ContactSortForm},
  CategoryBrowse in 'CategoryBrowse.pas' {CategoryBrowseForm},
  HelpView in 'HelpView.pas' {HelpViewForm: TFrame},
  QueryView in 'QueryView.pas' {QueryViewForm: TFrame},
  RandomData in 'RandomData.pas',
  Stopwatch in 'Stopwatch.pas',
  Utility in 'Utility.pas';

{$R *.res}
{$R *.mdr} {ModelExternal}

begin
  Application.Initialize;
  Application.Title := 'InstantObjects Primer (Delphi/Kylix cross platform version)';
  Application.CreateForm(TMainForm, MainForm);
  Application.CreateForm(TMainDataModule, MainDataModule);
  Application.Run;
end.

Index: Main.pas
===================================================================
RCS file: /cvsroot/instantobjects/Demos/PrimerCross/Main.pas,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** Main.pas	17 Nov 2004 20:59:47 -0000	1.4
--- Main.pas	6 Dec 2004 08:49:15 -0000	1.5
***************
*** 122,126 ****
  
  uses
!   Contnrs, Model, Welcome, MainData, RandomData, DemoData, Utility, ContactView, PerformanceView,
  {$IFDEF MSWINDOWS}
    HelpView, JPeg,
--- 122,128 ----
  
  uses
!   Contnrs,
! {$IFDEF EXTERNALSTORAGE}ModelExternal,{$ELSE}Model,{$ENDIF}
!   Welcome, MainData, RandomData, DemoData, Utility, ContactView, PerformanceView,
  {$IFDEF MSWINDOWS}
    HelpView, JPeg,
***************
*** 137,151 ****
    installed all brokers, please remove the missing broker unit(s) from
    the list. }
- 
  {$IFDEF MSWINDOWS}
    {$IFNDEF VER130}
    InstantDBX,
    {$ENDIF}
!   InstantADO,
!   InstantBDE,
!   InstantIBX,
  {$ENDIF}
  {$IFDEF LINUX}
!   InstantDBX,
  {$ENDIF}
    InstantXML;
--- 139,150 ----
    installed all brokers, please remove the missing broker unit(s) from
    the list. }
  {$IFDEF MSWINDOWS}
    {$IFNDEF VER130}
    InstantDBX,
    {$ENDIF}
!   InstantADO, InstantBDE, InstantIBX, InstantUIB,
  {$ENDIF}
  {$IFDEF LINUX}
!   InstantDBX, InstantUIB,
  {$ENDIF}
    InstantXML;

Index: DemoData.pas
===================================================================
RCS file: /cvsroot/instantobjects/Demos/PrimerCross/DemoData.pas,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** DemoData.pas	29 Jul 2004 20:43:09 -0000	1.2
--- DemoData.pas	6 Dec 2004 08:49:15 -0000	1.3
***************
*** 4,8 ****
  
  uses
!   Classes, Model, InstantPersistence, RandomData;
  
  procedure CreateCategories;
--- 4,9 ----
  
  uses
! {$IFDEF EXTERNALSTORAGE}ModelExternal,{$ELSE}Model,{$ENDIF}
!   Classes, InstantPersistence, RandomData;
  
  procedure CreateCategories;

Index: PersonEdit.pas
===================================================================
RCS file: /cvsroot/instantobjects/Demos/PrimerCross/PersonEdit.pas,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** PersonEdit.pas	17 Nov 2004 20:59:47 -0000	1.4
--- PersonEdit.pas	6 Dec 2004 08:49:16 -0000	1.5
***************
*** 13,17 ****
    QGrids, QDBGrids, QMask, QDBCtrls, QComCtrls, QButtons, QImgList,
  {$ENDIF}
!   ContactEdit, DB, InstantPresentation, Model;
  
  type
--- 13,18 ----
    QGrids, QDBGrids, QMask, QDBCtrls, QComCtrls, QButtons, QImgList,
  {$ENDIF}
! {$IFDEF EXTERNALSTORAGE}ModelExternal,{$ELSE}Model,{$ENDIF}
!   ContactEdit, DB, InstantPresentation;
  
  type

Index: ContactSort.pas
===================================================================
RCS file: /cvsroot/instantobjects/Demos/PrimerCross/ContactSort.pas,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** ContactSort.pas	20 Jul 2004 11:05:15 -0000	1.1
--- ContactSort.pas	6 Dec 2004 08:49:15 -0000	1.2
***************
*** 41,45 ****
  
  uses
!   Model, TypInfo, InstantRtti, InstantPresentation;
  
  {$R *.dfm}
--- 41,46 ----
  
  uses
! {$IFDEF EXTERNALSTORAGE}ModelExternal,{$ELSE}Model,{$ENDIF}
!   TypInfo, InstantRtti, InstantPresentation;
  
  {$R *.dfm}

Index: ContactFilterEdit.dfm
===================================================================
RCS file: /cvsroot/instantobjects/Demos/PrimerCross/ContactFilterEdit.dfm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** ContactFilterEdit.dfm	20 Jul 2004 11:05:15 -0000	1.1
--- ContactFilterEdit.dfm	6 Dec 2004 08:49:15 -0000	1.2
***************
*** 14,24 ****
    PixelsPerInch = 96
    TextHeight = 13
-   inherited ButtonPanel: TPanel
-     Top = 247
-   end
    inherited ClientPanel: TPanel
-     Height = 247
      inherited PageControl: TPageControl
-       Height = 243
        inherited DetailsSheet: TTabSheet
          inherited PhonesLabel: TLabel
--- 14,19 ----
***************
*** 55,59 ****
              Height = 80
              AutoSize = False
!             Caption =
                'Use the fields to the left to specify values or part of values t' +
                'hat must be matched for objects to be included in the view.'
--- 50,54 ----
              Height = 80
              AutoSize = False
!             Caption = 
                'Use the fields to the left to specify values or part of values t' +
                'hat must be matched for objects to be included in the view.'
***************
*** 66,70 ****
              Height = 70
              AutoSize = False
!             Caption =
                'Uncheck Dynamic to apply the filter on all objects at once inste' +
                'ad of dynamically when browsing.'
--- 61,65 ----
              Height = 70
              AutoSize = False
!             Caption = 
                'Uncheck Dynamic to apply the filter on all objects at once inste' +
                'ad of dynamically when browsing.'

--- NEW FILE: PrimerExternal.mdr ---
(This appears to be a binary file; contents omitted.)

Index: CompanyBrowse.pas
===================================================================
RCS file: /cvsroot/instantobjects/Demos/PrimerCross/CompanyBrowse.pas,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** CompanyBrowse.pas	20 Jul 2004 11:05:15 -0000	1.1
--- CompanyBrowse.pas	6 Dec 2004 08:49:15 -0000	1.2
***************
*** 13,17 ****
    QMenus, QImgList, QActnList, QGrids, QDBGrids, QExtCtrls, QComCtrls,
  {$ENDIF}
!   ContactBrowse, DB, InstantPresentation, Model;
  
  type
--- 13,18 ----
    QMenus, QImgList, QActnList, QGrids, QDBGrids, QExtCtrls, QComCtrls,
  {$ENDIF}
! {$IFDEF EXTERNALSTORAGE}ModelExternal,{$ELSE}Model,{$ENDIF}
!   ContactBrowse, DB, InstantPresentation;
  
  type

--- NEW FILE: PrimerExternal.cfg ---
-$A8
-$B-
-$C+
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J+
-$K-
-$L+
-$M-
-$N+
-$O-
-$P+
-$Q-
-$R-
-$S-
-$T-
-$U-
-$V+
-$W+
-$X+
-$YD
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+
-W+
-M
-$M16384,1048576
-K$00400000
-LE"c:\programmi\borland\delphi7\Projects\Bpl"
-LN"c:\programmi\borland\delphi7\Projects\Bpl"
-U"c:\programmi\borland\delphi7\Lib\Debug;..\..\Source\Brokers\DBX;..\..\Source\Brokers\ADO;..\..\Source\Brokers\BDE;..\..\Source\Brokers\IBX;..\..\Source\Brokers\XML"
-O"c:\programmi\borland\delphi7\Lib\Debug;..\..\Source\Brokers\DBX;..\..\Source\Brokers\ADO;..\..\Source\Brokers\BDE;..\..\Source\Brokers\IBX;..\..\Source\Brokers\XML"
-I"c:\programmi\borland\delphi7\Lib\Debug;..\..\Source\Brokers\DBX;..\..\Source\Brokers\ADO;..\..\Source\Brokers\BDE;..\..\Source\Brokers\IBX;..\..\Source\Brokers\XML"
-R"c:\programmi\borland\delphi7\Lib\Debug;..\..\Source\Brokers\DBX;..\..\Source\Brokers\ADO;..\..\Source\Brokers\BDE;..\..\Source\Brokers\IBX;..\..\Source\Brokers\XML"
-DEXTERNALSTORAGE
-w-UNIT_PLATFORM
-w-UNSAFE_TYPE
-w-UNSAFE_CODE
-w-UNSAFE_CAST

--- NEW FILE: ModelExternal.pas ---
unit ModelExternal;

interface

uses
  InstantPersistence;

type
  TAddress = class;
  TCategory = class;
  TCompany = class;
  TContact = class;
  TContactFilter = class;
  TCountry = class;
  TEmail = class;
  TPerson = class;
  TPhone = class;

  TAddress = class(TInstantObject)
  { IOMETADATA City: String(30) index;
    Country: Reference(TCountry);
    State: String(4);
    Street: Memo;
    Zip: String(10); }
    _City: TInstantString;
    _Country: TInstantReference;
    _State: TInstantString;
    _Street: TInstantMemo;
    _Zip: TInstantString;
  private
    function GetCity: string;
    function GetCountry: TCountry;
    function GetState: string;
    function GetStreet: string;
    function GetZip: string;
    procedure SetCity(const Value: string);
    procedure SetCountry(Value: TCountry);
    procedure SetState(const Value: string);
    procedure SetStreet(const Value: string);
    procedure SetZip(const Value: string);
  published
    property City: string read GetCity write SetCity;
    property Country: TCountry read GetCountry write SetCountry;
    property State: string read GetState write SetState;
    property Street: string read GetStreet write SetStreet;
    property Zip: string read GetZip write SetZip;
  end;

  TCountry = class(TInstantObject)
  { IOMETADATA stored;
    Name: String(30); }
    _Name: TInstantString;
  private
    function GetName: string;
    procedure SetName(const Value: string);
  protected
    procedure BeforeStore; override;
    function GetCaption: string; override;
  published
    property Id;
    property Name: string read GetName write SetName;
  end;

  TPhone = class(TInstantObject)
  { IOMETADATA Name: String(20);
    Number: String(20) mask '(000) 000-0000;0;_'; }
    _Name: TInstantString;
    _Number: TInstantString;
  private
    function GetName: string;
    function GetNumber: string;
    procedure SetName(const Value: string);
    procedure SetNumber(const Value: string);
  published
    property Name: string read GetName write SetName;
    property Number: string read GetNumber write SetNumber;
  end;

  TEmail = class(TInstantObject)
  { IOMETADATA Address: String(100); }
    _Address: TInstantString;
  private
    function GetAddress: string;
    procedure SetAddress(const Value: string);
  published
    property Address: string read GetAddress write SetAddress;
  end;

  TCategory = class(TInstantObject)
  { IOMETADATA stored;
    Name: String(30); }
    _Name: TInstantString;
  private
    function GetName: string;
    procedure SetName(const Value: string);
  protected
    function GetCaption: string; override;
  published
    property Name: string read GetName write SetName;
  end;

  TContact = class(TInstantObject)
  { IOMETADATA stored;
    Address: Part(TAddress) externalstored 'Contact_Address';
    Category: Reference(TCategory);
    City: String(30) index;
    Name: String(50) index;
    Phones: Parts(TPhone) externalstored 'Contact_Phone'; }
    _Address: TInstantPart;
    _Category: TInstantReference;
    _City: TInstantString;
    _Name: TInstantString;
    _Phones: TInstantParts;
  private
    function GetAddress: TAddress;
    function GetCategory: TCategory;
    function GetCity: string;
    function GetMainPhoneNumber: string;
    function GetName: string;
    function GetPhoneCount: Integer;
    function GetPhones(Index: Integer): TPhone;
    procedure SetAddress(Value: TAddress);
    procedure SetCategory(Value: TCategory);
    procedure SetCity(const Value: string);
    procedure SetMainPhoneNumber(const Value: string);
    procedure SetName(const Value: string);
    procedure SetPhones(Index: Integer; Value: TPhone);
  protected
    procedure AfterCreate; override;
    procedure BeforeStore; override;
    function GetCaption: string; override;
  public
    function AddPhone(Phone: TPhone): Integer;
    procedure ClearPhones;
    procedure DeletePhone(Index: Integer);
    function IndexOfPhone(Phone: TPhone): Integer;
    procedure InsertPhone(Index: Integer; Phone: TPhone);
    function RemovePhone(Phone: TPhone): Integer;
    property PhoneCount: Integer read GetPhoneCount;
    property Phones[Index: Integer]: TPhone read GetPhones write SetPhones;
  published
    property Address: TAddress read GetAddress write SetAddress;
    property Category: TCategory read GetCategory write SetCategory;
    property City: string read GetCity write SetCity;
    property MainPhoneNumber: string read GetMainPhoneNumber write SetMainPhoneNumber;
    property Name: string read GetName write SetName;
  end;

  TContactFilter = class(TContact)
  private
    FIsDynamic: Boolean;
    function GetIsEmpty: Boolean;
  public
    function Matches(Contact: TContact): Boolean;
  published
    property IsDynamic: Boolean read FIsDynamic write FIsDynamic;
    property IsEmpty: Boolean read GetIsEmpty;
  end;

  TPerson = class(TContact)
  { IOMETADATA stored;
    BirthDate: DateTime;
    Emails: Parts(TEmail);
    Employer: Reference(TCompany);
    Picture: Blob;
    Salary: Currency; }
    _BirthDate: TInstantDateTime;
    _Emails: TInstantParts;
    _Employer: TInstantReference;
    _Picture: TInstantGraphic;
    _Salary: TInstantCurrency;
  private
    function GetBirthDate: TDateTime;
    function GetEmailCount: Integer;
    function GetEmails(Index: Integer): TEmail;
    function GetEmployer: TCompany;
    function GetMainEmailAddress: string;
    function GetPicture: string;
    function GetSalary: Currency;
    procedure SetBirthDate(Value: TDateTime);
    procedure SetEmails(Index: Integer; Value: TEmail);
    procedure SetMainEmailAddress(const Value: string);
    procedure SetPicture(const Value: string);
    procedure SetSalary(Value: Currency);
  protected
    procedure BeforeDispose; override;
  public
    function AddEmail(Email: TEmail): Integer;
    procedure ClearEmails;
    procedure DeleteEmail(Index: Integer);
    procedure EmployBy(NewEmployer: TCompany);
    function IndexOfEmail(Email: TEmail): Integer;
    procedure InsertEmail(Index: Integer; Email: TEmail);
    function RemoveEmail(Email: TEmail): Integer;
    property EmailCount: Integer read GetEmailCount;
    property Emails[Index: Integer]: TEmail read GetEmails write SetEmails;
  published
    property BirthDate: TDateTime read GetBirthDate write SetBirthDate;
    property Employer: TCompany read GetEmployer;
    property MainEmailAddress: string read GetMainEmailAddress write SetMainEmailAddress;
    property Picture: string read GetPicture write SetPicture;
    property Salary: Currency read GetSalary write SetSalary;
  end;

  TCompany = class(TContact)
  { IOMETADATA stored;
    Employees: References(TPerson) externalstored 'Company_Employee'; }
    _Employees: TInstantReferences;
  private
    function GetEmployeeCount: Integer;
    function GetEmployees(Index: Integer): TPerson;
  public
    function AddEmployee(Employee: TPerson): Integer;
    procedure ClearEmployees;
    procedure DeleteEmployee(Index: Integer);
    function IndexOfEmployee(Employee: TPerson): Integer;
    procedure InsertEmployee(Index: Integer; Employee: TPerson);
    function RemoveEmployee(Employee: TPerson): Integer;
    property EmployeeCount: Integer read GetEmployeeCount;
    property Employees[Index: Integer]: TPerson read GetEmployees;
  end;

implementation

uses
  SysUtils, InstantUtils;

{ TAddress }

function TAddress.GetCity: string;
begin
  Result := _City.Value;
end;

function TAddress.GetCountry: TCountry;
begin
  Result := _Country.Value as TCountry;
end;

function TAddress.GetState: string;
begin
  Result := _State.Value;
end;

function TAddress.GetStreet: string;
begin
  Result := _Street.Value;
end;

function TAddress.GetZip: string;
begin
  Result := _Zip.Value;
end;

procedure TAddress.SetCity(const Value: string);
begin
  _City.Value := Value;
end;

procedure TAddress.SetCountry(Value: TCountry);
begin
  _Country.Value := Value;
end;

procedure TAddress.SetState(const Value: string);
begin
  _State.Value := Value;
end;

procedure TAddress.SetStreet(const Value: string);
begin
  _Street.Value := Value;
end;

procedure TAddress.SetZip(const Value: string);
begin
  _Zip.Value := Value;
end;

{ TCountry }

procedure TCountry.BeforeStore;
begin
  if Id = '' then
    raise Exception.Create('Country ID missing');
  inherited;
end;

function TCountry.GetCaption: string;
begin
  Result := Name;
end;

function TCountry.GetName: string;
begin
  Result := _Name.Value;
end;

procedure TCountry.SetName(const Value: string);
begin
  _Name.Value := Value;
end;

{ TPerson }

function TPerson.AddEmail(Email: TEmail): Integer;
begin
  Result := _Emails.Add(Email);
end;

procedure TPerson.BeforeDispose;
begin
  inherited;
  EmployBy(nil);
end;

procedure TPerson.ClearEmails;
begin
  _Emails.Clear;
end;

procedure TPerson.DeleteEmail(Index: Integer);
begin
  _Emails.Delete(Index);
end;

procedure TPerson.EmployBy(NewEmployer: TCompany);

  procedure AddToEmployer(AEmployer: TCompany);
  begin
    if Assigned(AEmployer) then
      AEmployer.AddEmployee(Self);
  end;

  procedure RemoveFromEmployer(AEmployer: TCompany);
  begin
    if Assigned(AEmployer) then
      AEmployer.RemoveEmployee(Self);
  end;

  procedure StoreEmployer(AEmployer: TCompany);
  begin
    if Assigned(AEmployer) then
      AEmployer.Store;
  end;

var
  OldEmployer: TCompany;
begin
  OldEmployer := Employer;
  AddRef;
  try
    Connector.StartTransaction;
    try
      AddToEmployer(NewEmployer);
      try
        StoreEmployer(NewEmployer);
        RemoveFromEmployer(OldEmployer);
        try
          StoreEmployer(OldEmployer);
          _Employer.Value := NewEmployer;
          try
            Store;
            Connector.CommitTransaction;
          except
            _Employer.Value := OldEmployer;
            raise;
          end;
        except
          AddToEmployer(OldEmployer);
          raise;
        end;
      except
        RemoveFromEmployer(NewEmployer);
        raise;
      end;
    except
      Connector.RollbackTransaction;
      raise;
    end;
  finally
    Free;
  end;
end;

function TPerson.GetBirthDate: TDateTime;
begin
  Result := _BirthDate.Value;
end;

function TPerson.GetEmailCount: Integer;
begin
  Result := _Emails.Count
end;

function TPerson.GetEmails(Index: Integer): TEmail;
begin
  Result := _Emails[Index] as TEmail;
end;

function TPerson.GetEmployer: TCompany;
begin
  Result := _Employer.Value as TCompany;
end;

function TPerson.GetMainEmailAddress: string;
begin
  if EmailCount > 0 then
    Result := Emails[0].Address
  else
    Result := '';
end;

function TPerson.GetPicture: string;
begin
  Result := _Picture.Value;
end;

function TPerson.GetSalary: Currency;
begin
  Result := _Salary.Value;
end;

function TPerson.IndexOfEmail(Email: TEmail): Integer;
begin
  Result := _Emails.IndexOf(Email);
end;

procedure TPerson.InsertEmail(Index: Integer; Email: TEmail);
begin
  _Emails.Insert(Index, Email);
end;

function TPerson.RemoveEmail(Email: TEmail): Integer;
begin
  Result := _Emails.Remove(Email);
end;

procedure TPerson.SetBirthDate(Value: TDateTime);
begin
  _BirthDate.Value := Value;
end;

procedure TPerson.SetEmails(Index: Integer; Value: TEmail);
begin
  _Emails[Index] := Value;
end;

procedure TPerson.SetMainEmailAddress(const Value: string);
var
  Email: TEmail;
begin
  if Value <> MainEmailAddress then
  begin
    if EmailCount = 0 then
    begin
      Email := TEmail.Create;
      AddEmail(Email);
    end else
      Email := Emails[0];
    Email.Address := Value;
  end;
end;

procedure TPerson.SetPicture(const Value: string);
begin
  _Picture.Value := Value;
end;

{ TPhone }

procedure TPerson.SetSalary(Value: Currency);
begin
  _Salary.Value := Value;
end;

function TPhone.GetName: string;
begin
  Result := _Name.Value;
end;

function TPhone.GetNumber: string;
begin
  Result := _Number.Value;
end;

procedure TPhone.SetName(const Value: string);
begin
  _Name.Value := Value;
end;

procedure TPhone.SetNumber(const Value: string);
begin
  _Number.Value := Value;
end;

{ TEmail }

function TEmail.GetAddress: string;
begin
  Result := _Address.Value;
end;

procedure TEmail.SetAddress(const Value: string);
begin
  _Address.Value := Value;
end;

{ TCategory }

function TCategory.GetCaption: string;
begin
  Result := Name;
end;

function TCategory.GetName: string;
begin
  Result := _Name.Value;
end;

procedure TCategory.SetName(const Value: string);
begin
  _Name.Value := Value;
end;

{ TContact }

function TContact.AddPhone(Phone: TPhone): Integer;
begin
  Result := _Phones.Add(Phone);
end;

procedure TContact.AfterCreate;
begin
  inherited;
  Id := InstantGenerateId;
  _Category.ReferenceObject(TCategory, 'CAT000');
end;

procedure TContact.BeforeStore;
begin
  if Name = '' then
    raise Exception.Create('Contact name required');
  inherited;
  City := Address.City;
end;

procedure TContact.ClearPhones;
begin
  _Phones.Clear;
end;

procedure TContact.DeletePhone(Index: Integer);
begin
  _Phones.Delete(Index);
end;

function TContact.GetAddress: TAddress;
begin
  Result := _Address.Value as TAddress;
end;

function TContact.GetCaption: string;
begin
  Result := Name;
end;

function TContact.GetCategory: TCategory;
begin
  Result := _Category.Value as TCategory;
end;

function TContact.GetCity: string;
begin
  Result := _City.Value;
end;

function TContact.GetMainPhoneNumber: string;
begin
  if PhoneCount > 0 then
    Result := Phones[0].Number
  else
    Result := '';
end;

function TContact.GetName: string;
begin
  Result := _Name.Value;
end;

function TContact.GetPhoneCount: Integer;
begin
  Result := _Phones.Count
end;

function TContact.GetPhones(Index: Integer): TPhone;
begin
  Result := _Phones[Index] as TPhone;
end;

function TContact.IndexOfPhone(Phone: TPhone): Integer;
begin
  Result := _Phones.IndexOf(Phone);
end;

procedure TContact.InsertPhone(Index: Integer; Phone: TPhone);
begin
  _Phones.Insert(Index, Phone);
end;

function TContact.RemovePhone(Phone: TPhone): Integer;
begin
  Result := _Phones.Remove(Phone);
end;

procedure TContact.SetAddress(Value: TAddress);
begin
  _Address.Value := Value;
end;

procedure TContact.SetCategory(Value: TCategory);
begin
  _Category.Value := Value;
end;

procedure TContact.SetCity(const Value: string);
begin
  _City.Value := Value;
end;

procedure TContact.SetMainPhoneNumber(const Value: string);
var
  Phone: TPhone;
begin
  if Value <> MainPhoneNumber then
  begin
    if PhoneCount = 0 then
    begin
      Phone := TPhone.Create;
      AddPhone(Phone);
      Phone.Name := 'Main';
    end else
      Phone := Phones[0];
    Phone.Number := Value;
  end;
end;

procedure TContact.SetName(const Value: string);
begin
  _Name.Value := Value;
end;

procedure TContact.SetPhones(Index: Integer; Value: TPhone);
begin
  _Phones[Index] := Value;
end;

{ TContactFilter }

function TContactFilter.GetIsEmpty: Boolean;
begin
  Result :=
    (Name = '') and
    (Address.Street = '') and
    (Address.City = '') and
    (Address.Zip = '') and
    (Address.State = '') and
    (Address.Country = nil) and
    (Category = nil);
end;

function TContactFilter.Matches(Contact: TContact): Boolean;

  function MatchStr(const Str1, Str2: string): Boolean;
  begin
    Result := (Str1 = '') or (Pos(UpperCase(Str1), UpperCase(Str2)) > 0);
  end;

  function MatchObj(Obj1, Obj2: TObject): Boolean;
  begin
    Result := not Assigned(Obj1) or (Obj1 = Obj2);
  end;

begin
  Result := Assigned(Contact) and
    MatchStr(Name, Contact.Name) and
    MatchStr(Address.Street, Contact.Address.Street) and
    MatchStr(Address.City, Contact.Address.City) and
    MatchStr(Address.Zip, Contact.Address.Zip) and
    MatchStr(Address.State, Contact.Address.State) and
    MatchObj(Address.Country, Contact.Address.Country) and
    MatchObj(Category, Contact.Category);
end;

{ TCompany }

function TCompany.AddEmployee(Employee: TPerson): Integer;
begin
  Result := _Employees.Add(Employee)
end;

procedure TCompany.ClearEmployees;
begin
  _Employees.Clear;
end;

procedure TCompany.DeleteEmployee(Index: Integer);
begin
  _Employees.Delete(Index);
end;

function TCompany.GetEmployeeCount: Integer;
begin
  Result := _Employees.Count
end;

function TCompany.GetEmployees(Index: Integer): TPerson;
begin
  Result := _Employees[Index] as TPerson;
end;

function TCompany.IndexOfEmployee(Employee: TPerson): Integer;
begin
  Result := _Employees.IndexOf(Employee);
end;

procedure TCompany.InsertEmployee(Index: Integer; Employee: TPerson);
begin
  _Employees.Insert(Index, Employee);
end;

function TCompany.RemoveEmployee(Employee: TPerson): Integer;
begin
  Result := _Employees.Remove(Employee);
end;

initialization
  InstantRegisterClasses([
    TAddress,
    TCategory,
    TCompany,
    TContact,
    TContactFilter,
    TCountry,
    TEmail,
    TPerson,
    TPhone
  ]);

end.