diff options
-rw-r--r-- | docs/xml/corelib/gfxbase.xml | 13 | ||||
-rw-r--r-- | extras/tiopf/demos/Demo_06_CreateTable/demo_06.lpi | 69 | ||||
-rw-r--r-- | extras/tiopf/demos/Demo_06_CreateTable/demo_06.lpr | 39 | ||||
-rw-r--r-- | extras/tiopf/demos/Demo_06_CreateTable/frm_main.pas | 205 | ||||
-rw-r--r-- | extras/tiopf/demos/Demo_07_VisitorBasics/Client_BOM.pas | 81 | ||||
-rw-r--r-- | extras/tiopf/demos/Demo_07_VisitorBasics/demo_07.lpi | 74 | ||||
-rw-r--r-- | extras/tiopf/demos/Demo_07_VisitorBasics/demo_07.lpr | 39 | ||||
-rw-r--r-- | extras/tiopf/demos/Demo_07_VisitorBasics/frm_main.pas | 131 |
8 files changed, 645 insertions, 6 deletions
diff --git a/docs/xml/corelib/gfxbase.xml b/docs/xml/corelib/gfxbase.xml index 9d086890..9bc2848f 100644 --- a/docs/xml/corelib/gfxbase.xml +++ b/docs/xml/corelib/gfxbase.xml @@ -55,14 +55,15 @@ underlying type in the future. Example to floating points. <element name="TfpgColor"> <short>Represents a color in integer format.</short> <descr> -<p>TfpgColor is always in RRGGBB (Red, Green, Blue) format, no matter tho +<p>TfpgColor is always in RRGGBB (Red, Green, Blue) format, no matter the operating system. </p> -<p>The gfxbase unit also contains definitions of many useful color constants. It -defines the standard predefined Delphi colors (like clRed, clMagenta etc.), the - 140 websafe colors using the defacto standard names as used by Netscape and -Internet Explorer web browsers. As well as some internal color constants used -by many GUI components (like clText, clWindowBackground etc.). +<p>The <var>gfxbase</var> unit also contains definitions of many useful color +constants. It defines the standard predefined Delphi colors (like clRed, +clMagenta etc.), the 140 websafe colors using the defacto standard names as +used by Netscape and Internet Explorer web browsers. As well as some internal +color constants used by many GUI components (like clText, clWindowBackground +etc.). </p> </descr> <seealso> 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. + |