summaryrefslogtreecommitdiff
path: root/extras
diff options
context:
space:
mode:
authorgraemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf>2008-04-21 14:56:01 +0000
committergraemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf>2008-04-21 14:56:01 +0000
commitee37be5fea626af37513b85b517ee3b4b6ea2e1a (patch)
tree0e405580a68369040999ba5c0a6c116ff4922a30 /extras
parenta71e8ebcb42fcc874e97515e9fbe1681923056c1 (diff)
downloadfpGUI-ee37be5fea626af37513b85b517ee3b4b6ea2e1a.tar.xz
* Updated Demo 7 for tiOPF.
* Added Demo 8 for tiOPF (still incomplete).
Diffstat (limited to 'extras')
-rw-r--r--extras/tiopf/demos/Demo_06_CreateTable/demo_06.lpr9
-rw-r--r--extras/tiopf/demos/Demo_07_VisitorBasics/demo_07.lpi1
-rw-r--r--extras/tiopf/demos/Demo_08_Collection/Client_AutoMap_Svr.pas25
-rw-r--r--extras/tiopf/demos/Demo_08_Collection/Client_BOM.pas70
-rw-r--r--extras/tiopf/demos/Demo_08_Collection/Client_DBIndependentVisitors_Svr.pas146
-rw-r--r--extras/tiopf/demos/Demo_08_Collection/Client_HardCodedVisitors_Svr.pas171
-rw-r--r--extras/tiopf/demos/Demo_08_Collection/demo_08.lpi94
-rw-r--r--extras/tiopf/demos/Demo_08_Collection/demo_08.lpr53
-rw-r--r--extras/tiopf/demos/Demo_08_Collection/frm_main.pas310
-rw-r--r--extras/tiopf/demos/Demo_08_Collection/mediators.pas17
-rw-r--r--extras/tiopf/gui/tiCompositeMediators.pas10
11 files changed, 901 insertions, 5 deletions
diff --git a/extras/tiopf/demos/Demo_06_CreateTable/demo_06.lpr b/extras/tiopf/demos/Demo_06_CreateTable/demo_06.lpr
index 7664dadf..3e97bf30 100644
--- a/extras/tiopf/demos/Demo_06_CreateTable/demo_06.lpr
+++ b/extras/tiopf/demos/Demo_06_CreateTable/demo_06.lpr
@@ -6,7 +6,7 @@ uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
- Classes, fpgfx, frm_main, tiOPFManager;
+ Classes, SysUtils, fpgfx, frm_main, tiOPFManager, tiConstants;
procedure MainProc;
@@ -14,7 +14,12 @@ var
frm: TMainForm;
begin
fpgApplication.Initialize;
-
+
+ if GTIOPFManager.PersistenceLayers.FindByPersistenceLayerName(cTIPersistFBL) = nil then
+ raise Exception.Create('The system failed to find the <' + cTIPersistFBL + '> persistence layer')
+ else
+ GTIOPFManager.DefaultPersistenceLayerName := cTIPersistFBL;
+
// Change the connection string to suite your database location
// ** Remote connection
// gTIOPFManager.ConnectDatabase('192.168.0.54|/home/graemeg/programming/data/tiopf.fdb', 'sysdba', 'masterkey');
diff --git a/extras/tiopf/demos/Demo_07_VisitorBasics/demo_07.lpi b/extras/tiopf/demos/Demo_07_VisitorBasics/demo_07.lpi
index 2fcf4825..c07629aa 100644
--- a/extras/tiopf/demos/Demo_07_VisitorBasics/demo_07.lpi
+++ b/extras/tiopf/demos/Demo_07_VisitorBasics/demo_07.lpi
@@ -11,6 +11,7 @@
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
+ <IconPath Value="./"/>
<TargetFileExt Value=""/>
</General>
<VersionInfo>
diff --git a/extras/tiopf/demos/Demo_08_Collection/Client_AutoMap_Svr.pas b/extras/tiopf/demos/Demo_08_Collection/Client_AutoMap_Svr.pas
new file mode 100644
index 00000000..6ad1008e
--- /dev/null
+++ b/extras/tiopf/demos/Demo_08_Collection/Client_AutoMap_Svr.pas
@@ -0,0 +1,25 @@
+unit Client_AutoMap_Svr;
+
+{$mode objfpc}{$H+}
+
+interface
+
+procedure RegisterMappings;
+
+implementation
+uses
+ tiOPFManager
+ ,tiAutoMap
+ ,Client_BOM
+ ;
+
+procedure RegisterMappings;
+begin
+ // Class, Table, Property, Column, Special Info
+ gTIOPFManager.ClassDBMappingMgr.RegisterMapping(TClient, 'Client', 'OID', 'OID', [pktDB]);
+ gTIOPFManager.ClassDBMappingMgr.RegisterMapping(TClient, 'Client', 'ClientName', 'Client_Name' );
+ gTIOPFManager.ClassDBMappingMgr.RegisterMapping(TClient, 'Client', 'ClientID', 'Client_ID' );
+ gTIOPFManager.ClassDBMappingMgr.RegisterCollection(TClients, TClient);
+end;
+
+end.
diff --git a/extras/tiopf/demos/Demo_08_Collection/Client_BOM.pas b/extras/tiopf/demos/Demo_08_Collection/Client_BOM.pas
new file mode 100644
index 00000000..52775334
--- /dev/null
+++ b/extras/tiopf/demos/Demo_08_Collection/Client_BOM.pas
@@ -0,0 +1,70 @@
+unit Client_BOM;
+
+{$mode objfpc}{$H+}
+
+interface
+uses
+ tiObject
+ ;
+
+type
+
+ TClient = class;
+ TClients = class;
+
+ TClientName = String[200];
+ TClientID = String[9];
+
+
+ TClients = class(TtiObjectList)
+ public
+ procedure Read; override;
+ procedure Save; override;
+ end;
+
+
+ TClient = class(TtiObject)
+ private
+ FClientID: TClientID;
+ FClientName: TClientName;
+ public
+ constructor CreateNew(const ADatabaseName: string=''; const APersistenceLayerName: string=''); override;
+ published
+ property ClientName: TClientName read FClientName write FClientName;
+ property ClientID: TClientID read FClientID write FClientID;
+ end;
+
+
+implementation
+uses
+ tiOPFManager
+ ,SysUtils
+ ,tiUtils
+ ;
+
+{ TClient }
+
+constructor TClient.CreateNew(const ADatabaseName: string = ''; const APersistenceLayerName: string = '');
+begin
+ inherited;
+ // Set some default values for the demo
+ ClientName := 'TEST ' + DateTimeToStr(Now);
+ ClientID := IntToStr(tiGetTickCount);
+end;
+
+{ TClients }
+
+procedure TClients.Read;
+begin
+ inherited Read;
+ NotifyObservers;
+end;
+
+procedure TClients.Save;
+begin
+ inherited Save;
+ NotifyObservers;
+end;
+
+end.
+
diff --git a/extras/tiopf/demos/Demo_08_Collection/Client_DBIndependentVisitors_Svr.pas b/extras/tiopf/demos/Demo_08_Collection/Client_DBIndependentVisitors_Svr.pas
new file mode 100644
index 00000000..495191e6
--- /dev/null
+++ b/extras/tiopf/demos/Demo_08_Collection/Client_DBIndependentVisitors_Svr.pas
@@ -0,0 +1,146 @@
+unit Client_DBIndependentVisitors_Svr;
+
+{$mode objfpc}{$H+}
+
+interface
+uses
+ tiVisitorDBAutoGen
+ ;
+
+type
+
+ TVisClient_Read = class(TVisDBAutoGenRead)
+ protected
+ function AcceptVisitor: boolean; override;
+ procedure Init ; override;
+ procedure SetupParams ; override;
+ procedure MapRowToObject; override;
+ end;
+
+ TVisClient_Create = class(TVisDBAutoGenUpdate)
+ protected
+ function AcceptVisitor: boolean; override;
+ procedure SetupParams ; override;
+ end;
+
+ TVisClient_Update = class(TVisDBAutoGenUpdate)
+ protected
+ function AcceptVisitor: boolean; override;
+ procedure SetupParams ; override;
+ end;
+
+ TVisClient_Delete = class(TVisDBAutoGenDelete)
+ protected
+ function AcceptVisitor: boolean; override;
+ procedure SetupParams ; override;
+ end;
+
+procedure RegisterVisitors;
+
+implementation
+uses
+ Client_BOM
+ ,tiOPFManager
+ ,tiObject
+ ,tiLog
+ ,tiQuery
+ ;
+
+procedure RegisterVisitors;
+begin
+ gTIOPFManager.RegReadVisitor(TVisClient_Read);
+ gTIOPFManager.RegSaveVisitor(TVisClient_Create);
+ gTIOPFManager.RegSaveVisitor(TVisClient_Update);
+ gTIOPFManager.RegSaveVisitor(TVisClient_Delete);
+end;
+
+{ TVisClient_Read }
+
+function TVisClient_Read.AcceptVisitor: boolean;
+begin
+ result:= (Visited is TClients) and
+ (Visited.ObjectState = posEmpty);
+ Log([ClassName, Visited.ClassName, Visited.ObjectStateAsString, Result ]);
+end;
+
+procedure TVisClient_Read.Init;
+begin
+ TableName:= 'Client';
+end;
+
+procedure TVisClient_Read.MapRowToObject;
+var
+ LClient: TClient;
+begin
+ LClient:= TClient.Create;
+ LClient.OID.AssignFromTIQuery('OID',Query);
+ LClient.ClientName:= Query.FieldAsString['Client_Name'];
+ LClient.ClientID:= Query.FieldAsString['Client_ID'];
+ LClient.ObjectState:= posClean;
+ TClients(Visited).Add(LClient);
+end;
+
+procedure TVisClient_Read.SetupParams;
+begin
+ // Do nothing
+end;
+
+{ TVisClient_Create }
+
+function TVisClient_Create.AcceptVisitor: boolean;
+begin
+ result:= (Visited is TClient) and
+ (Visited.ObjectState = posCreate);
+ Log([ClassName, Visited.ClassName, Visited.ObjectStateAsString, Result ]);
+end;
+
+procedure TVisClient_Create.SetupParams;
+var
+ LData: TClient;
+begin
+ LData:= Visited as TClient;
+ TableName:= 'Client';
+ QueryType:= qtInsert;
+ QueryParams.SetValueAsString('OID', LData.OID.AsString);
+ QueryParams.SetValueAsString('Client_Name', LData.ClientName);
+ QueryParams.SetValueAsString('Client_ID', LData.ClientID);
+end;
+
+{ TVisClient_Update }
+
+function TVisClient_Update.AcceptVisitor: boolean;
+begin
+ result:= (Visited is TClient) and
+ (Visited.ObjectState = posUpdate);
+ Log([ClassName, Visited.ClassName, Visited.ObjectStateAsString, Result ]);
+end;
+
+procedure TVisClient_Update.SetupParams;
+var
+ LData: TClient;
+begin
+ LData:= Visited as TClient;
+ TableName:= 'Client';
+ QueryType:= qtUpdate;
+ QueryWhere.SetValueAsString('OID', LData.OID.AsString);
+ QueryParams.SetValueAsString('Client_Name', LData.ClientName);
+ QueryParams.SetValueAsString('Client_ID', LData.ClientID);
+end;
+
+{ TVisClient_Delete }
+
+function TVisClient_Delete.AcceptVisitor: boolean;
+begin
+ result:= (Visited is TClient) and
+ (Visited.ObjectState = posDelete);
+ Log([ClassName, Visited.ClassName, Visited.ObjectStateAsString, Result ]);
+end;
+
+procedure TVisClient_Delete.SetupParams;
+begin
+ inherited;
+ TableName:= 'Client';
+end;
+
+end.
+
diff --git a/extras/tiopf/demos/Demo_08_Collection/Client_HardCodedVisitors_Svr.pas b/extras/tiopf/demos/Demo_08_Collection/Client_HardCodedVisitors_Svr.pas
new file mode 100644
index 00000000..99a25573
--- /dev/null
+++ b/extras/tiopf/demos/Demo_08_Collection/Client_HardCodedVisitors_Svr.pas
@@ -0,0 +1,171 @@
+unit Client_HardCodedVisitors_Svr;
+
+{$mode objfpc}{$H+}
+
+interface
+uses
+ tiVisitorDB
+ ;
+
+type
+
+ TVisClient_Read = class(TVisOwnedQrySelect)
+ protected
+ function AcceptVisitor: boolean; override;
+ procedure Init ; override;
+ procedure SetupParams ; override;
+ procedure MapRowToObject; override;
+ end;
+
+ TVisClient_Create = class(TVisOwnedQryUpdate)
+ protected
+ function AcceptVisitor: boolean; override;
+ procedure Init ; override;
+ procedure SetupParams ; override;
+ end;
+
+ TVisClient_Update = class(TVisOwnedQryUpdate)
+ protected
+ function AcceptVisitor: boolean; override;
+ procedure Init ; override;
+ procedure SetupParams ; override;
+ end;
+
+ TVisClient_Delete = class(TVisOwnedQryUpdate)
+ protected
+ function AcceptVisitor: boolean; override;
+ procedure Init ; override;
+ procedure SetupParams ; override;
+ end;
+
+procedure RegisterVisitors;
+
+implementation
+uses
+ Client_BOM
+ ,tiOPFManager
+ ,tiObject
+ ,tiLog
+ ;
+
+procedure RegisterVisitors;
+begin
+ gTIOPFManager.RegReadVisitor(TVisClient_Read);
+ gTIOPFManager.RegSaveVisitor(TVisClient_Create);
+ gTIOPFManager.RegSaveVisitor(TVisClient_Update);
+ gTIOPFManager.RegSaveVisitor(TVisClient_Delete);
+end;
+
+{ TVisClient_Read }
+
+function TVisClient_Read.AcceptVisitor: boolean;
+begin
+ result:= (Visited is TClients) and
+ (Visited.ObjectState = posEmpty);
+ Log([ClassName, Visited.ClassName, Visited.ObjectStateAsString, Result ]);
+end;
+
+procedure TVisClient_Read.Init;
+begin
+ Query.SQLText:=
+ 'select OID, Client_Name, Client_ID from Client';
+end;
+
+procedure TVisClient_Read.MapRowToObject;
+var
+ lClient: TClient;
+begin
+ lClient:= TClient.Create;
+ lClient.OID.AssignFromTIQuery('OID',Query);
+ lClient.ClientName:= Query.FieldAsString['Client_Name'];
+ lClient.ClientID:= Query.FieldAsString['Client_ID'];
+ lClient.ObjectState:= posClean;
+ TClients(Visited).Add(lClient);
+end;
+
+procedure TVisClient_Read.SetupParams;
+begin
+ // Do nothing
+end;
+
+{ TVisClient_Create }
+
+function TVisClient_Create.AcceptVisitor: boolean;
+begin
+ result:= (Visited is TClient) and
+ (Visited.ObjectState = posCreate);
+ Log([ClassName, Visited.ClassName, Visited.ObjectStateAsString, Result ]);
+end;
+
+procedure TVisClient_Create.Init;
+begin
+ Query.SQLText:=
+ 'Insert into Client (OID, Client_Name, Client_ID) ' +
+ 'Values ' +
+ '(:OID,:Client_Name,:Client_ID)';
+end;
+
+procedure TVisClient_Create.SetupParams;
+var
+ lData: TClient;
+begin
+ lData:= Visited as TClient;
+ lData.OID.AssignToTIQuery('OID', Query);
+ Query.ParamAsString['Client_Name']:= lData.ClientName;
+ Query.ParamAsString['Client_ID']:= lData.ClientID;
+end;
+
+{ TVisClient_Update }
+
+function TVisClient_Update.AcceptVisitor: boolean;
+begin
+ result:= (Visited is TClient) and
+ (Visited.ObjectState = posUpdate);
+ Log([ClassName, Visited.ClassName, Visited.ObjectStateAsString, Result ]);
+end;
+
+procedure TVisClient_Update.Init;
+begin
+ Query.SQLText:=
+ 'Update Client Set ' +
+ ' Client_Name =:Client_Name ' +
+ ' ,Client_ID =:Client_ID ' +
+ 'where ' +
+ ' OID =:OID';
+end;
+
+procedure TVisClient_Update.SetupParams;
+var
+ lData: TClient;
+begin
+ lData:= Visited as TClient;
+ lData.OID.AssignToTIQuery('OID', Query);
+ Query.ParamAsString['Client_Name']:= lData.ClientName;
+ Query.ParamAsString['Client_ID']:= lData.ClientID;
+end;
+
+{ TVisClient_Delete }
+
+function TVisClient_Delete.AcceptVisitor: boolean;
+begin
+ result:= (Visited is TClient) and
+ (Visited.ObjectState = posDelete);
+ Log([ClassName, Visited.ClassName, Visited.ObjectStateAsString, Result ]);
+end;
+
+procedure TVisClient_Delete.Init;
+begin
+ Query.SQLText:=
+ 'delete from client where oid =:oid';
+end;
+
+procedure TVisClient_Delete.SetupParams;
+var
+ lData: TClient;
+begin
+ lData:= Visited as TClient;
+ lData.OID.AssignToTIQuery('OID', Query);
+end;
+
+end.
+
diff --git a/extras/tiopf/demos/Demo_08_Collection/demo_08.lpi b/extras/tiopf/demos/Demo_08_Collection/demo_08.lpi
new file mode 100644
index 00000000..9e6af029
--- /dev/null
+++ b/extras/tiopf/demos/Demo_08_Collection/demo_08.lpi
@@ -0,0 +1,94 @@
+<?xml version="1.0"?>
+<CONFIG>
+ <ProjectOptions>
+ <PathDelim Value="/"/>
+ <Version Value="6"/>
+ <General>
+ <Flags>
+ <SaveOnlyProjectUnits Value="True"/>
+ <MainUnitHasCreateFormStatements Value="False"/>
+ <MainUnitHasTitleStatement Value="False"/>
+ </Flags>
+ <SessionStorage Value="InProjectDir"/>
+ <MainUnit Value="0"/>
+ <IconPath Value="./"/>
+ <TargetFileExt Value=""/>
+ </General>
+ <VersionInfo>
+ <ProjectVersion Value=""/>
+ </VersionInfo>
+ <PublishOptions>
+ <Version Value="2"/>
+ <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+ <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+ </PublishOptions>
+ <RunParams>
+ <local>
+ <FormatVersion Value="1"/>
+ <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+ </local>
+ </RunParams>
+ <RequiredPackages Count="2">
+ <Item1>
+ <PackageName Value="fpgui_package"/>
+ </Item1>
+ <Item2>
+ <PackageName Value="tiOPFfpGUI"/>
+ </Item2>
+ </RequiredPackages>
+ <Units Count="7">
+ <Unit0>
+ <Filename Value="demo_08.lpr"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="demo_08"/>
+ </Unit0>
+ <Unit1>
+ <Filename Value="frm_main.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="frm_main"/>
+ </Unit1>
+ <Unit2>
+ <Filename Value="Client_HardCodedVisitors_Svr.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="Client_HardCodedVisitors_Svr"/>
+ </Unit2>
+ <Unit3>
+ <Filename Value="Client_AutoMap_Svr.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="Client_AutoMap_Svr"/>
+ </Unit3>
+ <Unit4>
+ <Filename Value="Client_BOM.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="Client_BOM"/>
+ </Unit4>
+ <Unit5>
+ <Filename Value="Client_DBIndependentVisitors_Svr.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="Client_DBIndependentVisitors_Svr"/>
+ </Unit5>
+ <Unit6>
+ <Filename Value="mediators.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="mediators"/>
+ </Unit6>
+ </Units>
+ </ProjectOptions>
+ <CompilerOptions>
+ <Version Value="5"/>
+ <Parsing>
+ <SyntaxOptions>
+ <AllowLabel Value="False"/>
+ <CPPInline Value="False"/>
+ </SyntaxOptions>
+ </Parsing>
+ <CodeGeneration>
+ <Generate Value="Faster"/>
+ </CodeGeneration>
+ <Other>
+ <CustomOptions Value="-FUunits
+-dUseCThreads"/>
+ <CompilerPath Value="$(CompPath)"/>
+ </Other>
+ </CompilerOptions>
+</CONFIG>
diff --git a/extras/tiopf/demos/Demo_08_Collection/demo_08.lpr b/extras/tiopf/demos/Demo_08_Collection/demo_08.lpr
new file mode 100644
index 00000000..de16545a
--- /dev/null
+++ b/extras/tiopf/demos/Demo_08_Collection/demo_08.lpr
@@ -0,0 +1,53 @@
+program demo_08;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}{$ENDIF}
+ Classes, SysUtils, fpgfx, frm_main,
+ Client_DBIndependentVisitors_Svr, Client_BOM,
+ Client_AutoMap_Svr, Client_HardCodedVisitors_Svr, tiOPFManager,
+ tiConstants, mediators;
+
+procedure MainProc;
+var
+ frm: TMainForm;
+begin
+ fpgApplication.Initialize;
+
+ if GTIOPFManager.PersistenceLayers.FindByPersistenceLayerName(cTIPersistFBL) = nil then
+ raise Exception.Create('The system failed to find the <' + cTIPersistFBL + '> persistence layer')
+ else
+ GTIOPFManager.DefaultPersistenceLayerName := cTIPersistFBL;
+
+ { Change the connection string to suite your database location }
+ // ** Remote connection
+ //gTIOPFManager.ConnectDatabase('192.168.0.54|/home/graemeg/programming/data/tiopf.fdb', 'sysdba', 'masterkey');
+ // ** Local connection
+ gTIOPFManager.ConnectDatabase('/home/graemeg/programming/data/tiopf.fdb', 'sysdba', 'masterkey');
+
+
+ { Which persistence mechanism do you want to use? Uncomment one. }
+ Client_AutoMap_Svr.RegisterMappings;
+ //Client_HardCodedVisitors_Svr.RegisterVisitors;
+ //Client_DBIndependentVisitors_Svr.RegisterVisitors;
+
+
+ frm := TMainForm.Create(nil);
+ try
+ frm.Show;
+ fpgApplication.Run;
+ finally
+ frm.Free;
+ gTIOPFManager.DisconnectDatabase;
+ gTIOPFManager.Terminate;
+ end;
+end;
+
+begin
+ MainProc;
+end.
+
+
diff --git a/extras/tiopf/demos/Demo_08_Collection/frm_main.pas b/extras/tiopf/demos/Demo_08_Collection/frm_main.pas
new file mode 100644
index 00000000..eabcf56c
--- /dev/null
+++ b/extras/tiopf/demos/Demo_08_Collection/frm_main.pas
@@ -0,0 +1,310 @@
+unit frm_main;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ SysUtils, Classes, gfxbase, fpgfx, gui_edit,
+ gfx_widget, gui_form, gui_label, gui_button,
+ gui_listbox, gui_memo, gui_combobox, gui_grid,
+ gui_dialogs, gui_checkbox, gui_tree, gui_trackbar,
+ gui_progressbar, gui_radiobutton, gui_tab, gui_menu,
+ gui_bevel, Client_BOM, mediators;
+
+type
+
+ TMainForm = class(TfpgForm)
+ private
+ FClients: TClients;
+ FmedClients: TClient_StringGrid_Mediator;
+ procedure MainFormShow(Sender: TObject);
+ procedure CreateTable;
+ procedure DropTable;
+ function TableExists: boolean;
+ procedure btnInsertRowClick(Sender: TObject);
+ procedure btnDeleteRowClick(Sender: TObject);
+ procedure btnSaveClick(Sender: TObject);
+ procedure btnReadClick(Sender: TObject);
+ procedure btnShowClick(Sender: TObject);
+ public
+ {@VFD_HEAD_BEGIN: MainForm}
+ lblName1: TfpgLabel;
+ lblName2: TfpgLabel;
+ lblName3: TfpgLabel;
+ edtOID: TfpgEdit;
+ edtClientName: TfpgEdit;
+ edtClientID: TfpgEdit;
+ btnInsertRow: TfpgButton;
+ btnDeleteRow: TfpgButton;
+ btnShow: TfpgButton;
+ btnSave: TfpgButton;
+ btnRead: TfpgButton;
+ grdCollection: TfpgStringGrid;
+ {@VFD_HEAD_END: MainForm}
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure AfterCreate; override;
+ end;
+
+{@VFD_NEWFORM_DECL}
+
+implementation
+
+uses
+ tiQuery
+ ,tiOIDGUID
+ ,tiOPFManager
+ ,tiDBConnectionPool
+ ,tiOID
+ ,tiDialogs
+ ,tiConstants
+ ;
+
+{@VFD_NEWFORM_IMPL}
+
+procedure TMainForm.MainFormShow(Sender: TObject);
+begin
+ // Drop and re-create to be sure we start with the correct structure
+ if TableExists then
+ begin
+ if TfpgMessageDialog.Question(ApplicationName, 'Must we delete existing data?', mbYesNo) = mbYes then
+ begin
+ DropTable;
+ CreateTable;
+ end;
+ end
+ else
+ CreateTable;
+end;
+
+procedure TMainForm.CreateTable;
+var
+ LTableMetaData: TtiDBMetaDataTable;
+begin
+ LTableMetaData := TtiDBMetaDataTable.Create;
+ try
+ LTableMetaData.Name:= 'Client';
+ LTableMetaData.AddField('OID', qfkString, 36); // Using GUID OIDs
+ LTableMetaData.AddField('Client_Name', qfkString, 200);
+ LTableMetaData.AddField('Client_ID', qfkString, 9);
+ gTIOPFManager.CreateTable(LTableMetaData);
+ finally
+ LTableMetaData.Free;
+ end;
+end;
+
+procedure TMainForm.DropTable;
+begin
+ gTIOPFManager.DropTable('Client');
+end;
+
+function TMainForm.TableExists: boolean;
+var
+ LDBMetaData: TtiDBMetaData;
+ LDatabase: TtiDatabase;
+begin
+ LDBMetaData := TtiDBMetaData.Create;
+ try
+ LDatabase := gTIOPFManager.DefaultDBConnectionPool.Lock;
+ try
+ LDatabase.ReadMetaDataTables(LDBMetaData);
+ result := LDBMetaData.FindByTableName('Client') <> nil;
+ finally
+ gTIOPFManager.DefaultDBConnectionPool.UnLock(LDatabase);
+ end;
+ finally
+ LDBMetaData.Free;
+ end;
+end;
+
+procedure TMainForm.btnInsertRowClick(Sender: TObject);
+var
+ LClient: TClient;
+begin
+ LClient:= TClient.CreateNew;
+ FClients.Add(LClient);
+ //LV.Refresh(LClient);
+end;
+
+procedure TMainForm.btnDeleteRowClick(Sender: TObject);
+begin
+ //if LV.SelectedData <> nil then
+ //LV.SelectedData.Deleted:= true;
+ //LV.Refresh;
+end;
+
+procedure TMainForm.btnSaveClick(Sender: TObject);
+begin
+ FClients.Save;
+end;
+
+procedure TMainForm.btnReadClick(Sender: TObject);
+begin
+ FClients.Clear;
+ FClients.Read;
+ //LV.Refresh;
+ FmedClients := TClient_StringGrid_Mediator.CreateCustom(FClients, grdCollection, 'ClientName(200,"Client name");ClientID(80,"Client ID")');
+ FClients.NotifyObservers;
+end;
+
+procedure TMainForm.btnShowClick(Sender: TObject);
+begin
+ tiShowString(FClients.AsDebugString);
+end;
+
+constructor TMainForm.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ WindowTitle := 'Connected to ' + gTIOPFManager.DefaultDBConnectionName;
+ FClients := TClients.Create;
+ OnShow := @MainFormShow;
+
+ //FmedClients := TClient_StringGrid_Mediator.CreateCustom(FClients, grdCollection, 'ClientName(200,"Client name");ClientID(80,"Client ID")');
+ //FClients.NotifyObservers;
+
+ //LV.AddColumn(LVDeriveOID, 'OID', 270);
+ //LV.AddColumn('ClientName', vttkString, 'Client name', 200);
+ //LV.AddColumn('ClientID', vttkString, 'Client ID', 80);
+ //LV.Data:= FClients;
+end;
+
+destructor TMainForm.Destroy;
+begin
+ FmedClients.Free;
+ FClients.Free;
+ inherited Destroy;
+end;
+
+procedure TMainForm.AfterCreate;
+begin
+ {@VFD_BODY_BEGIN: MainForm}
+ Name := 'MainForm';
+ SetPosition(304, 254, 565, 250);
+ WindowTitle := 'Collection demo';
+ WindowPosition := wpScreenCenter;
+ Sizeable := False;
+
+ lblName1 := TfpgLabel.Create(self);
+ with lblName1 do
+ begin
+ Name := 'lblName1';
+ SetPosition(8, 12, 80, 16);
+ Text := 'OID:';
+ FontDesc := '#Label1';
+ end;
+
+ lblName2 := TfpgLabel.Create(self);
+ with lblName2 do
+ begin
+ Name := 'lblName2';
+ SetPosition(8, 36, 80, 16);
+ Text := 'Client Name:';
+ FontDesc := '#Label1';
+ end;
+
+ lblName3 := TfpgLabel.Create(self);
+ with lblName3 do
+ begin
+ Name := 'lblName3';
+ SetPosition(8, 60, 80, 16);
+ Text := 'Client ID:';
+ FontDesc := '#Label1';
+ end;
+
+ edtOID := TfpgEdit.Create(self);
+ with edtOID do
+ begin
+ Name := 'edtOID';
+ SetPosition(88, 8, 172, 22);
+ Text := '';
+ FontDesc := '#Edit1';
+ end;
+
+ edtClientName := TfpgEdit.Create(self);
+ with edtClientName do
+ begin
+ Name := 'edtClientName';
+ SetPosition(88, 32, 172, 22);
+ Text := '';
+ FontDesc := '#Edit1';
+ end;
+
+ edtClientID := TfpgEdit.Create(self);
+ with edtClientID do
+ begin
+ Name := 'edtClientID';
+ SetPosition(88, 56, 172, 22);
+ Text := '';
+ FontDesc := '#Edit1';
+ end;
+
+ btnInsertRow := TfpgButton.Create(self);
+ with btnInsertRow do
+ begin
+ Name := 'btnInsertRow';
+ SetPosition(268, 8, 143, 24);
+ Text := 'Insert object into list';
+ FontDesc := '#Label1';
+ ImageName := '';
+ OnClick := @btnInsertRowClick;
+ end;
+
+ btnDeleteRow := TfpgButton.Create(self);
+ with btnDeleteRow do
+ begin
+ Name := 'btnDeleteRow';
+ SetPosition(268, 36, 143, 24);
+ Text := 'Delete object in list';
+ FontDesc := '#Label1';
+ ImageName := '';
+ OnClick := @btnDeleteRowClick;
+ end;
+
+ btnShow := TfpgButton.Create(self);
+ with btnShow do
+ begin
+ Name := 'btnShow';
+ SetPosition(416, 8, 143, 24);
+ Text := 'Show Objects in list';
+ FontDesc := '#Label1';
+ ImageName := '';
+ OnClick := @btnShowClick;
+ end;
+
+ btnSave := TfpgButton.Create(self);
+ with btnSave do
+ begin
+ Name := 'btnSave';
+ SetPosition(416, 36, 143, 24);
+ Text := 'Save';
+ FontDesc := '#Label1';
+ ImageName := '';
+ OnClick := @btnSaveClick;
+ end;
+
+ btnRead := TfpgButton.Create(self);
+ with btnRead do
+ begin
+ Name := 'btnRead';
+ SetPosition(416, 64, 143, 24);
+ Text := 'Read list from DB';
+ FontDesc := '#Label1';
+ ImageName := '';
+ OnClick := @btnReadClick;
+ end;
+
+ grdCollection := TfpgStringGrid.Create(self);
+ with grdCollection do
+ begin
+ Name := 'grdCollection';
+ SetPosition(8, 96, 552, 148);
+ FontDesc := '#Grid';
+ HeaderFontDesc := '#GridHeader';
+ end;
+
+ {@VFD_BODY_END: MainForm}
+end;
+
+
+end.
diff --git a/extras/tiopf/demos/Demo_08_Collection/mediators.pas b/extras/tiopf/demos/Demo_08_Collection/mediators.pas
new file mode 100644
index 00000000..a316f32f
--- /dev/null
+++ b/extras/tiopf/demos/Demo_08_Collection/mediators.pas
@@ -0,0 +1,17 @@
+unit mediators;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ tiCompositeMediators;
+
+type
+ TClient_StringGrid_Mediator = class(TCompositeStringGridMediator)
+ end;
+
+implementation
+
+end.
+
diff --git a/extras/tiopf/gui/tiCompositeMediators.pas b/extras/tiopf/gui/tiCompositeMediators.pas
index 34417aa8..cd8d3547 100644
--- a/extras/tiopf/gui/tiCompositeMediators.pas
+++ b/extras/tiopf/gui/tiCompositeMediators.pas
@@ -608,15 +608,19 @@ begin
end;
procedure TCompositeStringGridMediator.RebuildStringGrid;
+var
+ i: integer;
begin
+ writeln('RebuildStringGrid');
{ This rebuilds the whole list. Not very efficient. }
-// View.BeginUpdate;
+ View.BeginUpdate;
try
FMediatorList.Clear;
-// View.Columns.Clear;
+ for i := View.ColumnCount to 1 do
+ View.DeleteColumn(i);
CreateSubMediators;
finally
-// View.EndUpdate;
+ View.EndUpdate;
end;
// { Do nothing. Can be implement as you see fit. A simple example is given