Menu
▾
▴
[Instantobjects-cvscommit] Demos/PrimerCross ModelExternal.pas,NONE,1.1 PrimerExternal.cfg,NONE,1.1 PrimerExternal.dpr,NONE,1.1 PrimerExternal.mdr,NONE,1.1 CompanyBrowse.pas,1.1,1.2 CompanyEdit.pas,1.3,1.4 ContactBrowse.pas,1.1,1.2 ContactEdit.pas,1.1,1.2 ContactFilterEdit.dfm,1.1,1.2 ContactFilterEdit.pas,1.1,1.2 ContactSort.dfm,1.1,1.2 ContactSort.pas,1.1,1.2 ContactView.pas,1.3,1.4 CountryBrowse.pas,1.1,1.2 DemoData.pas,1.2,1.3 Main.pas,1.4,1.5 MainData.pas,1.1,1.2 PerformanceView.pas,1.3,1.4 PersonBrowse.pas,1.1,1.2 PersonEdit.pas,1.4,1.5 Primer.dpr,1.2,1.3
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. |
