summaryrefslogtreecommitdiff
path: root/extras
diff options
context:
space:
mode:
Diffstat (limited to 'extras')
-rw-r--r--extras/tiopf/demos/Demo_06_CreateTable/demo_06.lpi69
-rw-r--r--extras/tiopf/demos/Demo_06_CreateTable/demo_06.lpr39
-rw-r--r--extras/tiopf/demos/Demo_06_CreateTable/frm_main.pas205
-rw-r--r--extras/tiopf/demos/Demo_07_VisitorBasics/Client_BOM.pas81
-rw-r--r--extras/tiopf/demos/Demo_07_VisitorBasics/demo_07.lpi74
-rw-r--r--extras/tiopf/demos/Demo_07_VisitorBasics/demo_07.lpr39
-rw-r--r--extras/tiopf/demos/Demo_07_VisitorBasics/frm_main.pas131
7 files changed, 638 insertions, 0 deletions
diff --git a/extras/tiopf/demos/Demo_06_CreateTable/demo_06.lpi b/extras/tiopf/demos/Demo_06_CreateTable/demo_06.lpi
new file mode 100644
index 00000000..29fe7b8d
--- /dev/null
+++ b/extras/tiopf/demos/Demo_06_CreateTable/demo_06.lpi
@@ -0,0 +1,69 @@
+<?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="2">
+ <Unit0>
+ <Filename Value="demo_06.lpr"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="demo_06"/>
+ </Unit0>
+ <Unit1>
+ <Filename Value="frm_main.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="frm_main"/>
+ </Unit1>
+ </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_06_CreateTable/demo_06.lpr b/extras/tiopf/demos/Demo_06_CreateTable/demo_06.lpr
new file mode 100644
index 00000000..7664dadf
--- /dev/null
+++ b/extras/tiopf/demos/Demo_06_CreateTable/demo_06.lpr
@@ -0,0 +1,39 @@
+program demo_06;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}{$ENDIF}
+ Classes, fpgfx, frm_main, tiOPFManager;
+
+
+procedure MainProc;
+var
+ frm: TMainForm;
+begin
+ fpgApplication.Initialize;
+
+ // 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');
+
+ 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_06_CreateTable/frm_main.pas b/extras/tiopf/demos/Demo_06_CreateTable/frm_main.pas
new file mode 100644
index 00000000..7173bea4
--- /dev/null
+++ b/extras/tiopf/demos/Demo_06_CreateTable/frm_main.pas
@@ -0,0 +1,205 @@
+unit frm_main;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ SysUtils, Classes, fpgfx,
+ gfx_widget, gui_form, gui_label, gui_button,
+ gui_memo, gui_dialogs;
+
+type
+
+ TMainForm = class(TfpgForm)
+ private
+ procedure btnCreateTableClick(Sender: TObject);
+ procedure btnDropTableClick(Sender: TObject);
+ procedure btnShowMetaDataClick(Sender: TObject);
+ procedure btnTableExistsClick(Sender: TObject);
+ public
+ {@VFD_HEAD_BEGIN: MainForm}
+ lblConnectedTo: TfpgLabel;
+ btnCreateTable: TfpgButton;
+ btnDropTable: TfpgButton;
+ btnShowMetaData: TfpgButton;
+ btnTableExists: TfpgButton;
+ memName1: TfpgMemo;
+ {@VFD_HEAD_END: MainForm}
+ constructor Create(AOwner: TComponent); override;
+ procedure AfterCreate; override;
+ end;
+
+{@VFD_NEWFORM_DECL}
+
+implementation
+
+uses
+ tiQuery
+ ,tiOPFManager
+ ,tiOIDGUID
+ ,tiDialogs
+ ;
+
+{@VFD_NEWFORM_IMPL}
+
+procedure TMainForm.btnCreateTableClick(Sender: TObject);
+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('ACN', qfkString, 9);
+ gTIOPFManager.CreateTable(LTableMetaData);
+ finally
+ LTableMetaData.Free;
+ end;
+ ShowMessage('Table ''Client'' created');
+end;
+
+procedure TMainForm.btnDropTableClick(Sender: TObject);
+begin
+ gTIOPFManager.DropTable('Client');
+ ShowMessage('Table ''Client'' dropped');
+end;
+
+procedure TMainForm.btnShowMetaDataClick(Sender: TObject);
+var
+ LTableMetaData: TtiDBMetaDataTable;
+ LDatabase : TtiDatabase;
+begin
+ LTableMetaData:= TtiDBMetaDataTable.Create;
+ try
+ LTableMetaData.Name:= 'Client';
+ LDatabase:= gTIOPFManager.DefaultDBConnectionPool.Lock;
+ try
+ LDatabase.ReadMetaDataFields(LTableMetaData);
+ tiShowMessage(LTableMetaData.AsDebugString);
+ finally
+ gTIOPFManager.DefaultDBConnectionPool.UnLock(LDatabase);
+ end;
+ finally
+ LTableMetaData.Free;
+ end;
+end;
+
+procedure TMainForm.btnTableExistsClick(Sender: TObject);
+var
+ LDBMetaData: TtiDBMetaData;
+ LDatabase : TtiDatabase;
+begin
+ LDBMetaData:= TtiDBMetaData.Create;
+ try
+ LDatabase:= gTIOPFManager.DefaultDBConnectionPool.Lock;
+ try
+ LDatabase.ReadMetaDataTables(LDBMetaData);
+ if LDBMetaData.FindByTableName('Client') <> nil then
+ ShowMessage('Table <Client> exists')
+ else
+ ShowMessage('Table <Client> does not exist');
+ finally
+ gTIOPFManager.DefaultDBConnectionPool.UnLock(LDatabase);
+ end;
+ finally
+ LDBMetaData.Free;
+ end;
+end;
+
+constructor TMainForm.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ lblConnectedTo.Text := 'Connected to: ' + gTIOPFManager.DefaultDBConnectionName;
+end;
+
+procedure TMainForm.AfterCreate;
+begin
+ {@VFD_BODY_BEGIN: MainForm}
+ Name := 'MainForm';
+ SetPosition(738, 153, 389, 250);
+ WindowTitle := 'Create table demo';
+ WindowPosition := wpScreenCenter;
+ Sizeable := False;
+
+ lblConnectedTo := TfpgLabel.Create(self);
+ with lblConnectedTo do
+ begin
+ Name := 'lblConnectedTo';
+ SetPosition(4, 4, 380, 16);
+ Text := 'Connected To:';
+ FontDesc := '#Label1';
+ end;
+
+ btnCreateTable := TfpgButton.Create(self);
+ with btnCreateTable do
+ begin
+ Name := 'btnCreateTable';
+ SetPosition(280, 24, 103, 24);
+ Text := 'Create Table';
+ FontDesc := '#Label1';
+ ImageName := '';
+ OnClick := @btnCreateTableClick;
+ end;
+
+ btnDropTable := TfpgButton.Create(self);
+ with btnDropTable do
+ begin
+ Name := 'btnDropTable';
+ SetPosition(280, 52, 103, 24);
+ Text := 'Drop Table';
+ FontDesc := '#Label1';
+ ImageName := '';
+ OnClick := @btnDropTableClick;
+ end;
+
+ btnShowMetaData := TfpgButton.Create(self);
+ with btnShowMetaData do
+ begin
+ Name := 'btnShowMetaData';
+ SetPosition(280, 80, 103, 24);
+ Text := 'Show metadata';
+ FontDesc := '#Label1';
+ ImageName := '';
+ OnClick := @btnShowMetaDataClick;
+ end;
+
+ btnTableExists := TfpgButton.Create(self);
+ with btnTableExists do
+ begin
+ Name := 'btnTableExists';
+ SetPosition(280, 108, 103, 24);
+ Text := 'Table exists?';
+ FontDesc := '#Label1';
+ ImageName := '';
+ OnClick := @btnTableExistsClick;
+ end;
+
+ memName1 := TfpgMemo.Create(self);
+ with memName1 do
+ begin
+ Name := 'memName1';
+ SetPosition(4, 24, 264, 220);
+ Lines.Add('This demo will:');
+ Lines.Add('');
+ Lines.Add('a) Create a table called Client with the');
+ Lines.Add(' following structure:');
+ Lines.Add(' OID String(36)');
+ Lines.Add(' Client_Name String(200)');
+ Lines.Add(' Client_ID String(9)');
+ Lines.Add('');
+ Lines.Add('b) Test if a table called Client exists');
+ Lines.Add('');
+ Lines.Add('c) Show metadata for the Client table');
+ Lines.Add('');
+ Lines.Add('d) Drop the client table');
+ FontDesc := '#Edit1';
+ Enabled := False;
+ end;
+
+ {@VFD_BODY_END: MainForm}
+end;
+
+
+end.
diff --git a/extras/tiopf/demos/Demo_07_VisitorBasics/Client_BOM.pas b/extras/tiopf/demos/Demo_07_VisitorBasics/Client_BOM.pas
new file mode 100644
index 00000000..49195b48
--- /dev/null
+++ b/extras/tiopf/demos/Demo_07_VisitorBasics/Client_BOM.pas
@@ -0,0 +1,81 @@
+unit Client_BOM;
+
+interface
+uses
+ tiObject
+ ,tiOID
+ ,tiOIDGUID
+ ,tiVisitor
+ ;
+
+type
+
+ TClient = class;
+ TClientList = class;
+
+ TClientName = String[200];
+ TClientID = String[9];
+
+ TClientList = class(TtiObjectList);
+
+
+ TClient = class(TtiObject)
+ private
+ FClientID: TClientID;
+ FClientName: TClientName;
+ published
+ property ClientName: TClientName read FClientName write FClientName;
+ property ClientID : TClientID read FClientID write FClientID;
+ end;
+
+
+ TClientVisitor = class(TtiVisitor)
+ protected
+ function AcceptVisitor: boolean; override;
+ public
+ procedure Execute(const AVisited: TtiVisited); override;
+ end;
+
+
+procedure RegisterMappings;
+
+
+implementation
+uses
+ tiOPFManager
+ ,tiAutoMap
+ ,tiConstants
+ ,tiDialogs
+ ;
+
+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(TClientList, TClient);
+end;
+
+{ TClientVisitor }
+
+function TClientVisitor.AcceptVisitor: boolean;
+begin
+ // Put the code to check if this visitor should act on this object in here.
+ Result:= Visited is TClient;
+ // Remove this line and the visitor will touch the TClientList object
+ // as well as it's owned TClient objects.
+end;
+
+procedure TClientVisitor.Execute(const AVisited: TtiVisited);
+begin
+ inherited;
+ if not AcceptVisitor then
+ Exit;
+ tiShowMessage((Visited as TtiObject).AsDebugString);
+end;
+
+end.
+
+
+
diff --git a/extras/tiopf/demos/Demo_07_VisitorBasics/demo_07.lpi b/extras/tiopf/demos/Demo_07_VisitorBasics/demo_07.lpi
new file mode 100644
index 00000000..2fcf4825
--- /dev/null
+++ b/extras/tiopf/demos/Demo_07_VisitorBasics/demo_07.lpi
@@ -0,0 +1,74 @@
+<?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"/>
+ <TargetFileExt Value=""/>
+ </General>
+ <VersionInfo>
+ <ProjectVersion Value=""/>
+ </VersionInfo>
+ <PublishOptions>
+ <Version Value="2"/>
+ <IgnoreBinaries Value="False"/>
+ <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="tiOPFfpGUI"/>
+ </Item1>
+ <Item2>
+ <PackageName Value="fpgui_package"/>
+ </Item2>
+ </RequiredPackages>
+ <Units Count="3">
+ <Unit0>
+ <Filename Value="demo_07.lpr"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="demo_07"/>
+ </Unit0>
+ <Unit1>
+ <Filename Value="frm_main.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="frm_main"/>
+ </Unit1>
+ <Unit2>
+ <Filename Value="Client_BOM.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="Client_BOM"/>
+ </Unit2>
+ </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_07_VisitorBasics/demo_07.lpr b/extras/tiopf/demos/Demo_07_VisitorBasics/demo_07.lpr
new file mode 100644
index 00000000..9a7ccd15
--- /dev/null
+++ b/extras/tiopf/demos/Demo_07_VisitorBasics/demo_07.lpr
@@ -0,0 +1,39 @@
+program demo_07;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}{$ENDIF}
+ Classes, fpgfx, frm_main, tiOIDGUID, tiOPFManager, Client_BOM;
+
+
+procedure MainProc;
+var
+ frm: TMainForm;
+begin
+ fpgApplication.Initialize;
+
+ // 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');
+
+ 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_07_VisitorBasics/frm_main.pas b/extras/tiopf/demos/Demo_07_VisitorBasics/frm_main.pas
new file mode 100644
index 00000000..526823ee
--- /dev/null
+++ b/extras/tiopf/demos/Demo_07_VisitorBasics/frm_main.pas
@@ -0,0 +1,131 @@
+unit frm_main;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ SysUtils, Classes,
+ fpgfx, gui_form, gui_button,
+ Client_BOM;
+
+type
+
+ TMainForm = class(TfpgForm)
+ private
+ FClientList: TClientList;
+ procedure btnAddClientClick(Sender: TObject);
+ procedure btnShowListClick(Sender: TObject);
+ procedure btnRunClientVisitorClick(Sender: TObject);
+ public
+ {@VFD_HEAD_BEGIN: MainForm}
+ btnAddClient: TfpgButton;
+ btnShowList: TfpgButton;
+ btnRunClientVisitor: TfpgButton;
+ {@VFD_HEAD_END: MainForm}
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure AfterCreate; override;
+ end;
+
+{@VFD_NEWFORM_DECL}
+
+implementation
+
+uses
+ tiUtils
+ ,tiDialogs
+ ,tiOPFManager
+ ;
+
+{@VFD_NEWFORM_IMPL}
+
+procedure TMainForm.btnAddClientClick(Sender: TObject);
+var
+ lClient: TClient;
+begin
+ lClient := TClient.Create;
+ lClient.OID.AsString := IntToStr(tiGetTickCount); // Not how you do it in real life!
+ lClient.ClientName := 'Test ' + DateTimeToStr(Now);
+ lClient.ClientID := IntToStr(tiGetTickCount);
+ FClientList.Add(lClient);
+end;
+
+procedure TMainForm.btnShowListClick(Sender: TObject);
+begin
+ tiShowString(FClientList.AsDebugString);
+end;
+
+procedure TMainForm.btnRunClientVisitorClick(Sender: TObject);
+var
+ lVis: TClientVisitor;
+begin
+ lVis := TClientVisitor.Create;
+ try
+ FClientList.Iterate(lVis);
+ finally
+ lVis.Free;
+ end;
+end;
+
+constructor TMainForm.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FClientList := TClientList.Create;
+end;
+
+destructor TMainForm.Destroy;
+begin
+// FClientList.Save;
+ FClientList.Free;
+ inherited Destroy;
+end;
+
+procedure TMainForm.AfterCreate;
+begin
+ {@VFD_BODY_BEGIN: MainForm}
+ Name := 'MainForm';
+ SetPosition(854, 117, 244, 166);
+ WindowTitle := 'Visitor Basics';
+ WindowPosition := wpScreenCenter;
+ Sizeable := False;
+
+ btnAddClient := TfpgButton.Create(self);
+ with btnAddClient do
+ begin
+ Name := 'btnAddClient';
+ SetPosition(68, 24, 107, 24);
+ Text := 'Add client';
+ FontDesc := '#Label1';
+ ImageName := '';
+ OnClick := @btnAddClientClick;
+ end;
+
+ btnShowList := TfpgButton.Create(self);
+ with btnShowList do
+ begin
+ Name := 'btnShowList';
+ SetPosition(68, 56, 107, 24);
+ Text := 'Show list';
+ FontDesc := '#Label1';
+ ImageName := '';
+ OnClick := @btnShowListClick;
+ end;
+
+ btnRunClientVisitor := TfpgButton.Create(self);
+ with btnRunClientVisitor do
+ begin
+ Name := 'btnRunClientVisitor';
+ SetPosition(68, 88, 107, 24);
+ Text := 'Run client visitor';
+ FontDesc := '#Label1';
+ ImageName := '';
+ OnClick := @btnRunClientVisitorClick;
+ end;
+
+ {@VFD_BODY_END: MainForm}
+end;
+
+
+end.
+
generated by cgit v1.2.3-70-g09d2 (git 2.47.1) at 2024-12-27 13:31:47 +0000