diff options
author | Graeme Geldenhuys <graeme@mastermaths.co.za> | 2010-10-14 12:29:19 +0200 |
---|---|---|
committer | Graeme Geldenhuys <graeme@mastermaths.co.za> | 2010-10-14 12:29:19 +0200 |
commit | ff7f64d95ca92b644e0d66e2195a69344895b2ce (patch) | |
tree | d822b50e87cb21b6820e31c4e07a520d3113b89e /extras | |
parent | ce211febcabb02606c0d5b45b4c8502a76d6ae58 (diff) | |
download | fpGUI-ff7f64d95ca92b644e0d66e2195a69344895b2ce.tar.xz |
Moved tiOPF related units into the tiOPF repository.
It makes more sense to have the tiOPF related units with the
rest of the tiOPF. It's easier to keep changes in sync, and have
atomic commits across the various GUI toolkits supported by tiOPF.
Diffstat (limited to 'extras')
71 files changed, 0 insertions, 18140 deletions
diff --git a/extras/tiopf/demos/Common/Constants.pas b/extras/tiopf/demos/Common/Constants.pas deleted file mode 100644 index 9820ae5e..00000000 --- a/extras/tiopf/demos/Common/Constants.pas +++ /dev/null @@ -1,14 +0,0 @@ -unit Constants; - -{$mode objfpc}{$H+} - -interface - -const - cNameMissing = 'Please enter a name'; - cAgeOutofRange = 'Please enter a valid age between 1 - 100'; - - -implementation - -end. diff --git a/extras/tiopf/demos/Common/Model.pas b/extras/tiopf/demos/Common/Model.pas deleted file mode 100644 index 8fe815cb..00000000 --- a/extras/tiopf/demos/Common/Model.pas +++ /dev/null @@ -1,263 +0,0 @@ -unit Model; - -{$mode objfpc}{$H+} - -interface -uses - tiObject - ; - -type - TGender = (genMale, genFemale); - -const - cGender: array[TGender] of string = ('Male', 'Female'); - -type - TPerson = class; - TPersonList = class; - - - { Undo feature for TPerson } - TPersonMemento = class(TObject) - private - FOID: string; - FObjectState: TPerObjectState; - FName: string; - FAge: integer; - FGender: TGender; - end; - - - { TPerson - The subject being observed } - TPerson = class(TtiObject) - private - FGender: TGender; - FName: string; - FAge: integer; - function GetGenderGUI: string; - function GetMemento: TPersonMemento; - procedure SetGender(const AValue: TGender); - procedure SetGenderGUI(const AValue: string); - procedure SetName(const Value: string); - procedure SetAge(const Value: integer); - procedure SetMemento(const AValue: TPersonMemento); - protected - function GetCaption: string; override; - procedure DoGetFieldBounds(const AFieldName: String; var MinValue, MaxValue: Integer; var HasBounds: Boolean); override; - public - constructor Create; override; - function IsValid(const pErrors: TtiObjectErrors): Boolean; override; - procedure NotifyObservers; override; - property Memento: TPersonMemento read GetMemento write SetMemento; - property Gender: TGender read FGender write SetGender; - published - property Name: string read FName write SetName; - property Age: integer read FAge write SetAge; - property GenderGUI: string read GetGenderGUI write SetGenderGUI; - end; - - - { TPersonList } - TPersonList = class(TtiObjectList) - private - protected - function GetItems(i: integer): TPerson; reintroduce; - procedure SetItems(i: integer; const Value: TPerson); reintroduce; - public - property Items[i: integer]: TPerson read GetItems write SetItems; - procedure Add(const pObject: TPerson); reintroduce; - end; - - -function GeneratePersonList: TPersonList; - - -implementation -uses - Constants - ; - - -function GeneratePersonList: TPersonList; -var - lData: TPerson; -begin - Result := TPersonList.Create; - - lData := TPerson.Create; - lData.Name := 'Graeme Geldenhuys'; - lData.Age := 23; - Result.Add(lData); - - lData := TPerson.Create; - lData.Name := 'Peter Hinrichsen'; - lData.Age := 34; - Result.Add(lData); - - //lData := TPerson.Create; - //lData.Name := 'Ian Krigsman'; - //lData.Age := 45; - //lData.Deleted := True; - //Result.Add(lData); - - lData := TPerson.Create; - lData.Name := 'John Guthrie'; - lData.Age := 56; - Result.Add(lData); -end; - - -{ TPerson } - -function TPerson.IsValid(const pErrors: TtiObjectErrors): Boolean; -begin - inherited IsValid(pErrors); - - if Name = '' then - pErrors.AddError('Name', cNameMissing); - - if (Age < 1) or (Age > 100) then - pErrors.AddError('Age', cAgeOutofRange); - - Result := pErrors.Count = 0; -end; - -{ This was used for debugging, so you can see when NotifiObservers get called } -procedure TPerson.NotifyObservers; -begin -// writeln('NotifyObservers'); - inherited NotifyObservers; -end; - -procedure TPerson.SetAge(const Value: integer); -begin - { BeginUpdate and EndUpdate are optional. They allow the observers to only - get updated once, and not continuous for small updates. It doesn't really - make a difference for this simple example though. } - BeginUpdate; - FAge := Value; - EndUpdate; - { If you don't use BeginUpdate and EndUpdate, you need to call NotifyObserver - to they can be updated. } -// NotifyObservers; -end; - -procedure TPerson.SetMemento(const AValue: TPersonMemento); -begin - // Update the Person state from the memento. Only if their OID's match. - if (OID.AsString = AValue.FOID) then - begin - FName := AValue.FName; - FAge := AValue.FAge; - FGender := AValue.FGender; - ObjectState := AValue.FObjectState; - end; -end; - -function TPerson.GetCaption: string; -begin - Result := Name; - if Deleted then - Result := Result + ' (deleted)'; -end; - -procedure TPerson.DoGetFieldBounds(const AFieldName: String; var MinValue, - MaxValue: Integer; var HasBounds: Boolean); -begin - if AFieldName = 'Name' then - begin -// writeln(' Name - DoGetFieldBounds'); - HasBounds := True; - MinValue := 1; - MaxValue := 25; - end - else if AFieldName = 'Age' then - begin -// writeln(' Age - DoGetFieldBounds'); - HasBounds := True; - MinValue := 1; - MaxValue := 100; - end - else - begin -// writeln(' unknown property <', AFieldName, '> - DoGetFieldBounds'); - inherited DoGetFieldBounds(AFieldName, MinValue, MaxValue, HasBounds); - end; -end; - -constructor TPerson.Create; -begin - inherited Create; - FGender := genMale; -end; - -procedure TPerson.SetName(const Value: string); -begin - BeginUpdate; - FName := Value; - EndUpdate; -end; - -procedure TPerson.SetGender(const AValue: TGender); -begin - if FGender = AValue then exit; - BeginUpdate; - FGender := AValue; - EndUpdate; -end; - -function TPerson.GetGenderGUI: string; -begin - result := cGender[FGender]; -end; - -function TPerson.GetMemento: TPersonMemento; -begin - // Create a new memento, store the Centre state and return it. - Result := TPersonMemento.Create; - Result.FOID := OID.AsString; - Result.FObjectState := ObjectState; - Result.FName := FName; - Result.FAge := FAge; - Result.FGender := FGender; -end; - -procedure TPerson.SetGenderGUI(const AValue: string); -var - i: TGender; -begin - for i := Low(TGender) to High(TGender) do - begin - if cGender[i] = AValue then - begin - Gender := i; - Exit; //==> - end; - end; - Gender := genMale; -end; - - -{ TPersonList } - -function TPersonList.GetItems(i: integer): TPerson; -begin - result := TPerson(inherited GetItems(i)); -end; - -procedure TPersonList.SetItems(i: integer; const Value: TPerson); -begin - inherited SetItems(i, Value); -end; - -procedure TPersonList.Add(const pObject: TPerson); -begin - BeginUpdate; - inherited Add(pObject); - EndUpdate; -end; - - -end. - diff --git a/extras/tiopf/demos/Common/Model_View.pas b/extras/tiopf/demos/Common/Model_View.pas deleted file mode 100644 index ceac389f..00000000 --- a/extras/tiopf/demos/Common/Model_View.pas +++ /dev/null @@ -1,52 +0,0 @@ -unit Model_View; - -{$IFDEF FPC} - {$mode objfpc}{$H+} -{$ENDIF} - -interface - -uses - Classes - ,tiMediators - ; - -type - { TMemo - Name } - TPerson_Name_Memo_Mediator = class(TtiMemoMediatorView) - protected - procedure SetupGUIandObject; override; - end; - - -implementation - -uses - Model, tiBaseMediator; - - -procedure RegisterMediators; -begin - // Fallbacks (generic) - RegisterFallBackMediators; - - // Specific - gMediatorManager.RegisterMediator(TPerson_Name_Memo_Mediator, TPerson, 'Name'); -end; - - -{ TPerson_Name_Memo_Mediator } - -procedure TPerson_Name_Memo_Mediator.SetupGUIandObject; -begin - inherited SetupGUIandObject; - View.Enabled := False; // fpGUI doesn't have a ReadOnly property yet -end; - - -initialization - { Register all your Mediator Views here } - RegisterMediators; - -end. - diff --git a/extras/tiopf/demos/Common/frm_pickdatabase.pas b/extras/tiopf/demos/Common/frm_pickdatabase.pas deleted file mode 100644 index 7dcee309..00000000 --- a/extras/tiopf/demos/Common/frm_pickdatabase.pas +++ /dev/null @@ -1,361 +0,0 @@ -unit frm_pickdatabase; - -{$mode objfpc}{$H+} - -interface - -uses - SysUtils - ,Classes - ,contnrs - // fpGUI - ,fpg_base - ,fpg_main - ,fpg_form - ,fpg_button - ,fpg_edit - ,fpg_combobox - ,fpg_tab - ,fpg_label - // tiOPF - ,tiPersistenceLayers - ; - - -const - cINIIdentLastPerLayer = 'LastPerLayer'; - -type - - TPickDatabaseForm = class(TfpgForm) - private - {@VFD_HEAD_BEGIN: PickDatabaseForm} - PageControl1: TfpgPageControl; - tsDatabase: TfpgTabSheet; - btnReset: TfpgButton; - Label1: TfpgLabel; - cbPersistenceLayer: TfpgComboBox; - Label2: TfpgLabel; - edtDatabaseName: TfpgEdit; - Label3: TfpgLabel; - edtUsername: TfpgEdit; - Label4: TfpgLabel; - edtPassword: TfpgEdit; - btnDone: TfpgButton; - {@VFD_HEAD_END: PickDatabaseForm} - FSingleUserPersistenceLayers: TObjectList; - function GetDatabaseName: string; - function GetPassword: string; - function GetPersistenceLayerName: string; - function GetUserName: string; - procedure SetPersistenceLayer(const APersistenceLayerName: string); - procedure RegisterPersistenceLayersAsTests; - procedure RegisterPersistenceLayerAsTest(const APersistenceLayer: TtiPersistenceLayer); - procedure FormShow(Sender: TObject); - procedure PersistenceLayerChanged(Sender: TObject); - procedure DefaultToPresetValuesClick(Sender: TObject); - protected - function GetDataDir: string; virtual; - public - constructor Create(AOwner: TComponent); override; - procedure AfterCreate; override; - property SingleUserPersistenceLayers: TObjectList read FSingleUserPersistenceLayers; - property PersistenceLayerName: string read GetPersistenceLayerName; - property DatabaseName : string read GetDatabaseName; - property UserName : string read GetUserName; - property Password : string read GetPassword; - end; - -{@VFD_NEWFORM_DECL} - -implementation - -uses - tiConstants - ,tiUtils - ,tiOPFManager - ,tiINI - ; - -{@VFD_NEWFORM_IMPL} - -function TPickDatabaseForm.GetDatabaseName: string; -begin - Result := edtDatabaseName.Text; -end; - -function TPickDatabaseForm.GetPassword: string; -begin - Result := edtPassword.Text; -end; - -function TPickDatabaseForm.GetPersistenceLayerName: string; -begin - Result := cbPersistenceLayer.Text; -end; - -function TPickDatabaseForm.GetUserName: string; -begin - Result := edtUsername.Text; -end; - -procedure TPickDatabaseForm.SetPersistenceLayer(const APersistenceLayerName: string); -var - LPL: TtiPersistenceLayer; - LDefaults: TtiPersistenceLayerDefaults; -begin - LPL:= GTIOPFManager.PersistenceLayers.FindByPersistenceLayerName(APersistenceLayerName); - if LPL<>nil then - begin - LDefaults:= TtiPersistenceLayerDefaults.Create; - try - LPL.AssignPersistenceLayerDefaults(LDefaults); - cbPersistenceLayer.Text := LDefaults.PersistenceLayerName; - edtDatabaseName.Text := ExpandFileName(GetDataDir + LDefaults.DatabaseName); - edtUserName.Text := LDefaults.UserName; - edtPassword.Text := LDefaults.Password; - gINI.WriteString(Name, cINIIdentLastPerLayer, LDefaults.PersistenceLayerName); - finally - LDefaults.Free; - end; - end else - begin - cbPersistenceLayer.FocusItem := -1; - edtDatabaseName.Text := ''; - edtUserName.Text := ''; - edtPassword.Text := ''; - end; -end; - -procedure TPickDatabaseForm.RegisterPersistenceLayersAsTests; -var - i: integer; -begin - for i := 0 to GTIOPFManager.PersistenceLayers.Count - 1 do - RegisterPersistenceLayerAsTest(GTIOPFManager.PersistenceLayers.Items[i]); -end; - -procedure TPickDatabaseForm.RegisterPersistenceLayerAsTest(const APersistenceLayer: TtiPersistenceLayer); -var - LDefaults: TtiPersistenceLayerDefaults; -begin - Assert(APersistenceLayer.TestValid, CTIErrorInvalidObject); - LDefaults:= TtiPersistenceLayerDefaults.Create; - try - APersistenceLayer.AssignPersistenceLayerDefaults(LDefaults); - cbPersistenceLayer.Items.Add(LDefaults.PersistenceLayerName); - finally - LDefaults.Free; - end; -end; - -procedure TPickDatabaseForm.FormShow(Sender: TObject); -var - lLastPerLayer: string; -begin - PageControl1.ActivePageIndex := 0; - RegisterPersistenceLayersAsTests; - lLastPerLayer := gINI.ReadString(Name, 'LastPerLayer', ''); - SetPersistenceLayer(lLastPerLayer); -end; - -procedure TPickDatabaseForm.PersistenceLayerChanged(Sender: TObject); -begin - SetPersistenceLayer(cbPersistenceLayer.Text); -end; - -procedure TPickDatabaseForm.DefaultToPresetValuesClick(Sender: TObject); -begin - SetPersistenceLayer(cbPersistenceLayer.Text); -end; - -function TPickDatabaseForm.GetDataDir: string; -var - dir: string; -begin - dir := tiAddTrailingSlash(tiGetAppDataDirPrivate) + '_Data\'; - result := ExpandFileName(tiFixPathDelim(dir)); -end; - -constructor TPickDatabaseForm.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - OnShow := @FormShow; - FSingleUserPersistenceLayers := TObjectList.Create(False); -end; - -procedure TPickDatabaseForm.AfterCreate; -begin - {@VFD_BODY_BEGIN: PickDatabaseForm} - Name := 'PickDatabaseForm'; - SetPosition(301, 186, 464, 248); - WindowTitle := 'Pick Database'; - - PageControl1 := TfpgPageControl.Create(self); - with PageControl1 do - begin - Name := 'PageControl1'; - SetPosition(8, 12, 446, 224); - Anchors := [anLeft,anRight,anTop,anBottom]; - ActivePageIndex := 0; - ParentShowHint := True; - TabOrder := 0; - end; - - tsDatabase := TfpgTabSheet.Create(PageControl1); - with tsDatabase do - begin - Name := 'tsDatabase'; - SetPosition(3, 24, 440, 197); - Text := 'Database'; - end; - - btnReset := TfpgButton.Create(tsDatabase); - with btnReset do - begin - Name := 'btnReset'; - SetPosition(296, 24, 132, 24); - Text := 'Reset to Defaults'; - AllowAllUp := False; - Embedded := False; - Flat := False; - FontDesc := '#Label1'; - GroupIndex := 0; - Hint := ''; - ImageLayout := ilImageLeft; - ImageMargin := 3; - ImageName := ''; - ImageSpacing := -1; - ParentShowHint := True; - ShowImage := True; - TabOrder := 0; - OnClick := @DefaultToPresetValuesClick; - end; - - Label1 := TfpgLabel.Create(tsDatabase); - with Label1 do - begin - Name := 'Label1'; - SetPosition(8, 4, 220, 18); - Alignment := taLeftJustify; - FontDesc := '#Label1'; - Hint := ''; - Layout := tlTop; - ParentShowHint := True; - Text := 'Persistence Layer'; - WrapText := False; - end; - - cbPersistenceLayer := TfpgComboBox.Create(tsDatabase); - with cbPersistenceLayer do - begin - Name := 'cbPersistenceLayer'; - SetPosition(8, 24, 268, 24); - FontDesc := '#List'; - ParentShowHint := True; - TabOrder := 2; - OnChange :=@PersistenceLayerChanged; - end; - - Label2 := TfpgLabel.Create(tsDatabase); - with Label2 do - begin - Name := 'Label2'; - SetPosition(8, 50, 232, 18); - Alignment := taLeftJustify; - FontDesc := '#Label1'; - Hint := ''; - Layout := tlTop; - ParentShowHint := True; - Text := 'Database Name'; - WrapText := False; - end; - - edtDatabaseName := TfpgEdit.Create(tsDatabase); - with edtDatabaseName do - begin - Name := 'edtDatabaseName'; - SetPosition(8, 68, 268, 24); - TabOrder := 4; - Text := ''; - FontDesc := '#Edit1'; - ParentShowHint := True; - end; - - Label3 := TfpgLabel.Create(tsDatabase); - with Label3 do - begin - Name := 'Label3'; - SetPosition(8, 94, 232, 18); - Alignment := taLeftJustify; - FontDesc := '#Label1'; - Hint := ''; - Layout := tlTop; - ParentShowHint := True; - Text := 'Username'; - WrapText := False; - end; - - edtUsername := TfpgEdit.Create(tsDatabase); - with edtUsername do - begin - Name := 'edtUsername'; - SetPosition(8, 112, 268, 24); - TabOrder := 6; - Text := ''; - FontDesc := '#Edit1'; - ParentShowHint := True; - end; - - Label4 := TfpgLabel.Create(tsDatabase); - with Label4 do - begin - Name := 'Label4'; - SetPosition(8, 138, 232, 18); - Alignment := taLeftJustify; - FontDesc := '#Label1'; - Hint := ''; - Layout := tlTop; - ParentShowHint := True; - Text := 'Password'; - WrapText := False; - end; - - edtPassword := TfpgEdit.Create(tsDatabase); - with edtPassword do - begin - Name := 'edtPassword'; - SetPosition(8, 156, 268, 24); - TabOrder := 8; - Text := ''; - FontDesc := '#Edit1'; - ParentShowHint := True; - end; - - btnDone := TfpgButton.Create(tsDatabase); - with btnDone do - begin - Name := 'btnDone'; - SetPosition(296, 156, 132, 24); - Text := 'DONE'; - AllowAllUp := False; - Embedded := False; - Flat := False; - FontDesc := '#Label1'; - GroupIndex := 0; - Hint := ''; - ImageLayout := ilImageLeft; - ImageMargin := 3; - ImageName := ''; - ImageSpacing := -1; - ParentShowHint := True; - ShowImage := True; - TabOrder := 11; - ModalResult := mrOK; - end; - - {@VFD_BODY_END: PickDatabaseForm} -end; - - -end. diff --git a/extras/tiopf/demos/Demo_04_CreateDatabase/demo_04.lpi b/extras/tiopf/demos/Demo_04_CreateDatabase/demo_04.lpi deleted file mode 100644 index 34df30b5..00000000 --- a/extras/tiopf/demos/Demo_04_CreateDatabase/demo_04.lpi +++ /dev/null @@ -1,70 +0,0 @@ -<?xml version="1.0"?> -<CONFIG> - <ProjectOptions> - <Version Value="7"/> - <General> - <Flags> - <SaveOnlyProjectUnits Value="True"/> - <LRSInOutputDirectory 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_toolkit"/> - </Item2> - </RequiredPackages> - <Units Count="3"> - <Unit0> - <Filename Value="demo_04.lpr"/> - <IsPartOfProject Value="True"/> - <UnitName Value="demo_04"/> - </Unit0> - <Unit1> - <Filename Value="../Common/frm_pickdatabase.pas"/> - <IsPartOfProject Value="True"/> - <UnitName Value="frm_pickdatabase"/> - </Unit1> - <Unit2> - <Filename Value="frm_main.pas"/> - <IsPartOfProject Value="True"/> - <UnitName Value="frm_main"/> - </Unit2> - </Units> - </ProjectOptions> - <CompilerOptions> - <Version Value="8"/> - <SearchPaths> - <OtherUnitFiles Value="../Common/"/> - <UnitOutputDirectory Value="units/$(TargetCPU)-$(TargetOS)"/> - </SearchPaths> - <Parsing> - <SyntaxOptions> - <CStyleOperator Value="False"/> - </SyntaxOptions> - </Parsing> - <Other> - <CompilerPath Value="$(CompPath)"/> - </Other> - </CompilerOptions> -</CONFIG> diff --git a/extras/tiopf/demos/Demo_04_CreateDatabase/demo_04.lpr b/extras/tiopf/demos/Demo_04_CreateDatabase/demo_04.lpr deleted file mode 100644 index d7ff4605..00000000 --- a/extras/tiopf/demos/Demo_04_CreateDatabase/demo_04.lpr +++ /dev/null @@ -1,39 +0,0 @@ -program demo_04; - -{$mode objfpc}{$H+} - -uses - {$IFDEF UNIX}{$IFDEF UseCThreads} - cthreads, - {$ENDIF}{$ENDIF} - Classes - ,SysUtils - ,fpg_main - ,tiOPFManager - ,tiConstants - ,frm_main - ; - - - -procedure MainProc; -var - frm: TMainForm; -begin - fpgApplication.Initialize; - frm := TMainForm.Create(nil); - try - frm.Show; - fpgApplication.Run; - finally - frm.Free; - gTIOPFManager.Terminate; - end; -end; - -begin - MainProc; -end. - - - diff --git a/extras/tiopf/demos/Demo_04_CreateDatabase/frm_main.pas b/extras/tiopf/demos/Demo_04_CreateDatabase/frm_main.pas deleted file mode 100644 index cee11cd0..00000000 --- a/extras/tiopf/demos/Demo_04_CreateDatabase/frm_main.pas +++ /dev/null @@ -1,176 +0,0 @@ -unit frm_main; - -{$mode objfpc}{$H+} - -interface - -uses - SysUtils, Classes, fpg_base, fpg_main, fpg_form, fpg_button, fpg_panel; - -type - - TMainForm = class(TfpgForm) - private - {@VFD_HEAD_BEGIN: MainForm} - btnPickDB: TfpgButton; - btnCreateDB: TfpgButton; - btnDBExists: TfpgButton; - pnlDBName: TfpgPanel; - {@VFD_HEAD_END: MainForm} - FPersistenceLayerName: string; - FDatabaseName: string; - FUsername: string; - FPassword: string; - procedure PickDBClicked(Sender: TObject); - procedure DatabaseExistsClicked(Sender: TObject); - procedure CreateDatabaseClicked(Sender: TObject); - public - procedure AfterCreate; override; - end; - -{@VFD_NEWFORM_DECL} - -implementation - -uses - frm_pickdatabase - ,fpg_dialogs - ,tiOPFManager - ,tiPersistenceLayers - ,tiDialogs - ; - -{@VFD_NEWFORM_IMPL} - -procedure TMainForm.PickDBClicked(Sender: TObject); -var - frm: TPickDatabaseForm; -begin - frm := TPickDatabaseForm.Create(nil); - try - if frm.ShowModal = mrOK then - begin - FPersistenceLayerName := frm.PersistenceLayerName; - FDatabaseName := frm.DatabaseName; - FUsername := frm.UserName; - FPassword := frm.Password; - pnlDBName.Text := frm.DatabaseName; - end; - finally - frm.Free; - end; -end; - -procedure TMainForm.DatabaseExistsClicked(Sender: TObject); -var - LPerLayer: TtiPersistenceLayer; -begin - LPerLayer:= GTIOPFManager.PersistenceLayers.FindByPersistenceLayerName(FPersistenceLayerName); - Assert(LPerLayer<>nil, '"' + FPersistenceLayerName + '" not registered'); - if LPerLayer.DatabaseExists(FDatabaseName, FUserName, FPassword) - then - tiAppMessage('Database <' + FDatabaseName + '> exists.') - else - tiAppWarning('Database <' + FDatabaseName + '> does not exist.'); -end; - -procedure TMainForm.CreateDatabaseClicked(Sender: TObject); -var - LPerLayer: TtiPersistenceLayer; -begin - LPerLayer:= GTIOPFManager.PersistenceLayers.FindByPersistenceLayerName(FPersistenceLayerName); - Assert(LPerLayer<>nil, '"' + FPersistenceLayerName + '" not registered'); - LPerLayer.CreateDatabase(FDatabaseName, FUserName, FPassword); - tiAppMessage('Database "' + FDatabaseName + '" has been created.'); -end; - -procedure TMainForm.AfterCreate; -begin - {@VFD_BODY_BEGIN: MainForm} - Name := 'MainForm'; - SetPosition(312, 189, 359, 182); - WindowTitle := 'Demo 04 - Create Database'; - WindowPosition := wpScreenCenter; - - btnPickDB := TfpgButton.Create(self); - with btnPickDB do - begin - Name := 'btnPickDB'; - SetPosition(108, 20, 144, 24); - Text := 'Pick Database'; - AllowAllUp := False; - Embedded := False; - Flat := False; - FontDesc := '#Label1'; - GroupIndex := 0; - Hint := ''; - ImageLayout := ilImageLeft; - ImageMargin := 3; - ImageName := ''; - ImageSpacing := -1; - ParentShowHint := True; - ShowImage := True; - TabOrder := 0; - OnClick := @PickDBClicked; - end; - - btnCreateDB := TfpgButton.Create(self); - with btnCreateDB do - begin - Name := 'btnCreateDB'; - SetPosition(108, 96, 136, 24); - Text := 'Create Database'; - AllowAllUp := False; - Embedded := False; - Flat := False; - FontDesc := '#Label1'; - GroupIndex := 0; - Hint := ''; - ImageLayout := ilImageLeft; - ImageMargin := 3; - ImageName := ''; - ImageSpacing := -1; - ParentShowHint := True; - ShowImage := True; - TabOrder := 1; - OnClick := @CreateDatabaseClicked; - end; - - btnDBExists := TfpgButton.Create(self); - with btnDBExists do - begin - Name := 'btnDBExists'; - SetPosition(108, 128, 136, 24); - Text := 'Database Exists'; - AllowAllUp := False; - Embedded := False; - Flat := False; - FontDesc := '#Label1'; - GroupIndex := 0; - Hint := ''; - ImageLayout := ilImageLeft; - ImageMargin := 3; - ImageName := ''; - ImageSpacing := -1; - ParentShowHint := True; - ShowImage := True; - TabOrder := 2; - OnClick := @DatabaseExistsClicked; - end; - - pnlDBName := TfpgPanel.Create(self); - with pnlDBName do - begin - Name := 'pnlDBName'; - SetPosition(12, 56, 336, 32); - Anchors := [anLeft,anRight,anTop]; - ParentShowHint := True; - Style := bsLowered; - Text := '---'; - end; - - {@VFD_BODY_END: MainForm} -end; - - -end. diff --git a/extras/tiopf/demos/Demo_06_CreateTable/demo_06.lpi b/extras/tiopf/demos/Demo_06_CreateTable/demo_06.lpi deleted file mode 100644 index 4a8402a2..00000000 --- a/extras/tiopf/demos/Demo_06_CreateTable/demo_06.lpi +++ /dev/null @@ -1,64 +0,0 @@ -<?xml version="1.0"?> -<CONFIG> - <ProjectOptions> - <Version Value="7"/> - <General> - <Flags> - <SaveOnlyProjectUnits Value="True"/> - <MainUnitHasCreateFormStatements Value="False"/> - <MainUnitHasTitleStatement Value="False"/> - <LRSInOutputDirectory Value="False"/> - </Flags> - <SessionStorage Value="InProjectDir"/> - <MainUnit Value="0"/> - <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="1"> - <Item1> - <PackageName Value="tiOPFfpGUI"/> - </Item1> - </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="8"/> - <SearchPaths> - <UnitOutputDirectory Value="units/$(TargetCPU)-$(TargetOS)"/> - </SearchPaths> - <Parsing> - <SyntaxOptions> - <AllowLabel Value="False"/> - <CPPInline Value="False"/> - </SyntaxOptions> - </Parsing> - <Other> - <CustomOptions Value="-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 deleted file mode 100644 index 8e966dc7..00000000 --- a/extras/tiopf/demos/Demo_06_CreateTable/demo_06.lpr +++ /dev/null @@ -1,45 +0,0 @@ -program demo_06; - -{$mode objfpc}{$H+} - -uses - {$IFDEF UNIX}{$IFDEF UseCThreads} - cthreads, - {$ENDIF}{$ENDIF} - Classes, SysUtils, - fpg_main, frm_main, tiOPFManager, tiConstants; - - -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'); - - 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 deleted file mode 100644 index f413aa38..00000000 --- a/extras/tiopf/demos/Demo_06_CreateTable/frm_main.pas +++ /dev/null @@ -1,205 +0,0 @@ -unit frm_main; - -{$mode objfpc}{$H+} - -interface - -uses - SysUtils, Classes, - fpg_main, fpg_widget, fpg_form, fpg_label, fpg_button, - fpg_memo, fpg_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('Client_ID', 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 deleted file mode 100644 index 49195b48..00000000 --- a/extras/tiopf/demos/Demo_07_VisitorBasics/Client_BOM.pas +++ /dev/null @@ -1,81 +0,0 @@ -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 deleted file mode 100644 index 10179042..00000000 --- a/extras/tiopf/demos/Demo_07_VisitorBasics/demo_07.lpi +++ /dev/null @@ -1,70 +0,0 @@ -<?xml version="1.0"?> -<CONFIG> - <ProjectOptions> - <Version Value="7"/> - <General> - <Flags> - <SaveOnlyProjectUnits Value="True"/> - <MainUnitHasCreateFormStatements Value="False"/> - <MainUnitHasTitleStatement Value="False"/> - <LRSInOutputDirectory 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="1"> - <Item1> - <PackageName Value="tiOPFfpGUI"/> - </Item1> - </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="8"/> - <SearchPaths> - <UnitOutputDirectory Value="units/$(TargetCPU)-$(TargetOS)"/> - </SearchPaths> - <Parsing> - <SyntaxOptions> - <AllowLabel Value="False"/> - <CPPInline Value="False"/> - </SyntaxOptions> - </Parsing> - <Other> - <CustomOptions Value="-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 deleted file mode 100644 index 125dd248..00000000 --- a/extras/tiopf/demos/Demo_07_VisitorBasics/demo_07.lpr +++ /dev/null @@ -1,39 +0,0 @@ -program demo_07; - -{$mode objfpc}{$H+} - -uses - {$IFDEF UNIX}{$IFDEF UseCThreads} - cthreads, - {$ENDIF}{$ENDIF} - Classes, fpg_main, 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 deleted file mode 100644 index 8a10f2df..00000000 --- a/extras/tiopf/demos/Demo_07_VisitorBasics/frm_main.pas +++ /dev/null @@ -1,131 +0,0 @@ -unit frm_main; - -{$mode objfpc}{$H+} - -interface - -uses - SysUtils, Classes, - fpg_main, fpg_form, fpg_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. - diff --git a/extras/tiopf/demos/Demo_08_Collection/Client_AutoMap_Svr.pas b/extras/tiopf/demos/Demo_08_Collection/Client_AutoMap_Svr.pas deleted file mode 100644 index 6ad1008e..00000000 --- a/extras/tiopf/demos/Demo_08_Collection/Client_AutoMap_Svr.pas +++ /dev/null @@ -1,25 +0,0 @@ -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 deleted file mode 100644 index 52775334..00000000 --- a/extras/tiopf/demos/Demo_08_Collection/Client_BOM.pas +++ /dev/null @@ -1,70 +0,0 @@ -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 deleted file mode 100644 index 495191e6..00000000 --- a/extras/tiopf/demos/Demo_08_Collection/Client_DBIndependentVisitors_Svr.pas +++ /dev/null @@ -1,146 +0,0 @@ -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 deleted file mode 100644 index 99a25573..00000000 --- a/extras/tiopf/demos/Demo_08_Collection/Client_HardCodedVisitors_Svr.pas +++ /dev/null @@ -1,171 +0,0 @@ -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 deleted file mode 100644 index 04d2b379..00000000 --- a/extras/tiopf/demos/Demo_08_Collection/demo_08.lpi +++ /dev/null @@ -1,84 +0,0 @@ -<?xml version="1.0"?> -<CONFIG> - <ProjectOptions> - <Version Value="7"/> - <General> - <Flags> - <SaveOnlyProjectUnits Value="True"/> - <MainUnitHasCreateFormStatements Value="False"/> - <MainUnitHasTitleStatement Value="False"/> - <LRSInOutputDirectory Value="False"/> - </Flags> - <SessionStorage Value="InProjectDir"/> - <MainUnit Value="0"/> - <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="1"> - <Item1> - <PackageName Value="tiOPFfpGUI"/> - </Item1> - </RequiredPackages> - <Units Count="6"> - <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> - </Units> - </ProjectOptions> - <CompilerOptions> - <Version Value="8"/> - <SearchPaths> - <UnitOutputDirectory Value="units/$(TargetCPU)-$(TargetOS)"/> - </SearchPaths> - <Parsing> - <SyntaxOptions> - <AllowLabel Value="False"/> - <CPPInline Value="False"/> - </SyntaxOptions> - </Parsing> - <Other> - <CustomOptions Value="-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 deleted file mode 100644 index c1d14863..00000000 --- a/extras/tiopf/demos/Demo_08_Collection/demo_08.lpr +++ /dev/null @@ -1,65 +0,0 @@ -program demo_08; - -{$mode objfpc}{$H+} - -// Which persistence layer to activate. (Un)Comment the one you want to use -{.$define UseFBL} -{$define UseSqldbIB} - -uses - {$IFDEF UNIX}{$IFDEF UseCThreads} - cthreads, - {$ENDIF}{$ENDIF} - Classes, SysUtils, fpg_main, frm_main, - Client_DBIndependentVisitors_Svr, Client_BOM, - Client_AutoMap_Svr, Client_HardCodedVisitors_Svr, tiOPFManager, - tiConstants{, tiLog, tiLogToConsole}; - -procedure MainProc; -var - frm: TMainForm; -begin - fpgApplication.Initialize; - - {$IFDEF UseFBL} - if GTIOPFManager.PersistenceLayers.FindByPersistenceLayerName(cTIPersistFBL) = nil then - raise Exception.Create('The system failed to find the <' + cTIPersistFBL + '> persistence layer') - else - GTIOPFManager.DefaultPersistenceLayerName := cTIPersistFBL; - {$ENDIF} - {$IFDEF UseSqldbIB} - if GTIOPFManager.PersistenceLayers.FindByPersistenceLayerName(cTIPersistSqldbIB) = nil then - raise Exception.Create('The system failed to find the <' + cTIPersistSqldbIB + '> persistence layer') - else - GTIOPFManager.DefaultPersistenceLayerName := cTIPersistSqldbIB; - {$ENDIF} - - { 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 deleted file mode 100644 index 34241b17..00000000 --- a/extras/tiopf/demos/Demo_08_Collection/frm_main.pas +++ /dev/null @@ -1,332 +0,0 @@ -unit frm_main; - -{$mode objfpc}{$H+} - -interface - -uses - SysUtils, Classes, fpg_base, fpg_main, fpg_edit, - fpg_widget, fpg_form, fpg_label, fpg_button, - fpg_listbox, fpg_memo, fpg_combobox, fpg_grid, - fpg_dialogs, fpg_checkbox, fpg_tree, fpg_trackbar, - fpg_progressbar, fpg_radiobutton, fpg_tab, fpg_menu, - fpg_panel, Client_BOM, tiModelMediator; - -type - - TMainForm = class(TfpgForm) - private - {@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} - FClients: TClients; - FMediator: TtiModelMediator; - procedure MainFormShow(Sender: TObject); - procedure CreateTable; - procedure DropTable; - procedure CreateMediators; - function TableExists: boolean; - procedure btnInsertRowClick(Sender: TObject); - procedure btnDeleteRowClick(Sender: TObject); - procedure btnSaveClick(Sender: TObject); - procedure btnReadClick(Sender: TObject); - procedure btnShowClick(Sender: TObject); - public - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - procedure AfterCreate; override; - end; - -{@VFD_NEWFORM_DECL} - -implementation - -uses - tiQuery - ,tiOIDGUID - ,tiOPFManager - ,tiDBConnectionPool - ,tiOID - ,tiDialogs - ,tiConstants - ,tiBaseMediator - ,tiListMediators - ,tiLog - ; - -{@VFD_NEWFORM_IMPL} - -procedure TMainForm.MainFormShow(Sender: TObject); -begin - Log('Creating mediators'); - CreateMediators; - - // Drop and re-create to be sure we start with the correct structure - Log('Testing if table exists'); - if TableExists then - begin - Log(' Should we drop and recreate the tables'); - 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; - -procedure TMainForm.CreateMediators; -begin - if not Assigned(FMediator) then - begin - FMediator := TtiModelMediator.Create(self); - FMediator.AddComposite('ClientName(200,"Client name");ClientID(80,"Client ID")', grdCollection); - end; - FMediator.Subject := FClients; - FMediator.Active := True; - - //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; - -function TMainForm.TableExists: boolean; -var - LDBMetaData: TtiDBMetaData; - LDatabase: TtiDatabase; -begin - LDBMetaData := TtiDBMetaData.Create; - try - LDatabase := gTIOPFManager.DefaultDBConnectionPool.Lock; - try -// Log(' Reading meta data of tables'); - LDatabase.ReadMetaDataTables(LDBMetaData); -// log(' Finding the table <Client>'); - 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); -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 - FMediator.Active := False; - FClients.Clear; - FClients.Read; - FMediator.Active := True; -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; -end; - -destructor TMainForm.Destroy; -begin - FMediator.Active := False; - 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; - -initialization - gMediatorManager.RegisterMediator(TtiStringGridMediatorView, TClients); - -end. diff --git a/extras/tiopf/demos/Demo_20_ListMediators/demo_listmediators.lpi b/extras/tiopf/demos/Demo_20_ListMediators/demo_listmediators.lpi deleted file mode 100644 index ece8df27..00000000 --- a/extras/tiopf/demos/Demo_20_ListMediators/demo_listmediators.lpi +++ /dev/null @@ -1,83 +0,0 @@ -<?xml version="1.0"?> -<CONFIG> - <ProjectOptions> - <Version Value="7"/> - <General> - <Flags> - <SaveOnlyProjectUnits Value="True"/> - <LRSInOutputDirectory 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="1"> - <Item1> - <PackageName Value="tiOPFfpGUI"/> - </Item1> - </RequiredPackages> - <Units Count="5"> - <Unit0> - <Filename Value="demo_listmediators.lpr"/> - <IsPartOfProject Value="True"/> - <UnitName Value="demo_listmediators"/> - </Unit0> - <Unit1> - <Filename Value="frmMain.pas"/> - <IsPartOfProject Value="True"/> - <UnitName Value="frmMain"/> - </Unit1> - <Unit2> - <Filename Value="../Common/Model.pas"/> - <IsPartOfProject Value="True"/> - <UnitName Value="Model"/> - </Unit2> - <Unit3> - <Filename Value="../Common/Model_View.pas"/> - <IsPartOfProject Value="True"/> - <UnitName Value="Model_View"/> - </Unit3> - <Unit4> - <Filename Value="../Common/Constants.pas"/> - <IsPartOfProject Value="True"/> - <UnitName Value="Constants"/> - </Unit4> - </Units> - </ProjectOptions> - <CompilerOptions> - <Version Value="8"/> - <SearchPaths> - <OtherUnitFiles Value="../Common/"/> - <UnitOutputDirectory Value="units/$(TargetCPU)-$(TargetOS)"/> - </SearchPaths> - <Parsing> - <SyntaxOptions> - <CStyleOperator Value="False"/> - </SyntaxOptions> - </Parsing> - <CodeGeneration> - <SmartLinkUnit Value="True"/> - </CodeGeneration> - <Linking> - <LinkSmart Value="True"/> - </Linking> - <Other> - <CompilerPath Value="$(CompPath)"/> - </Other> - </CompilerOptions> -</CONFIG> diff --git a/extras/tiopf/demos/Demo_20_ListMediators/demo_listmediators.lpr b/extras/tiopf/demos/Demo_20_ListMediators/demo_listmediators.lpr deleted file mode 100644 index 5db2a346..00000000 --- a/extras/tiopf/demos/Demo_20_ListMediators/demo_listmediators.lpr +++ /dev/null @@ -1,29 +0,0 @@ -program demo_listmediators; - -{$mode objfpc}{$H+} - -uses - {$IFDEF UNIX}{$IFDEF UseCThreads} - cthreads, - {$ENDIF}{$ENDIF} - Classes, fpg_main, frmMain, Model, Constants, Model_View; - - -procedure MainProc; -var - frm: TMainForm; -begin - fpgApplication.Initialize; - frm := TMainForm.Create(nil); - try - frm.Show; - fpgApplication.Run; - finally - frm.Free; - end; -end; - -begin - MainProc; -end. - diff --git a/extras/tiopf/demos/Demo_20_ListMediators/frmMain.pas b/extras/tiopf/demos/Demo_20_ListMediators/frmMain.pas deleted file mode 100644 index f186340b..00000000 --- a/extras/tiopf/demos/Demo_20_ListMediators/frmMain.pas +++ /dev/null @@ -1,277 +0,0 @@ -unit frmMain; - -{$mode objfpc}{$H+} - -interface - -uses - SysUtils, Classes, fpg_base, fpg_main, fpg_widget, fpg_form, fpg_button, - fpg_grid, fpg_checkbox, fpg_panel, fpg_listview, fpg_listbox, fpg_combobox, - Model, tiModelMediator, tiMediators; - -type - - TMainForm = class(TfpgForm) - private - { The object we will be working with. } - FPersonList: TPersonList; - FMediator: TtiModelMediator; - medCombo: TtiComboBoxMediatorView; - procedure btnViaCodeChangeClick(Sender: TObject); - procedure btnQuitClicked(Sender: TObject); - procedure btnViaCodeAddClick(Sender: TObject); - procedure btnShowModelClick(Sender: TObject); - procedure btnShowDeletedClick(Sender: TObject); - procedure SetupMediators; - public - {@VFD_HEAD_BEGIN: MainForm} - lvName1: TfpgListView; - grdName1: TfpgStringGrid; - pnlName1: TfpgPanel; - btnName1: TfpgButton; - btnName2: TfpgButton; - btnName3: TfpgButton; - btnName4: TfpgButton; - btnQuit: TfpgButton; - cbName1: TfpgCheckBox; - lstName1: TfpgListBox; - cbName2: TfpgComboBox; - {@VFD_HEAD_END: MainForm} - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - procedure AfterConstruction; override; - procedure AfterCreate; override; - end; - -{@VFD_NEWFORM_DECL} - -implementation - -uses - tiBaseMediator, tiListMediators, tiObject, tiDialogs; - -{@VFD_NEWFORM_IMPL} - -procedure TMainForm.btnViaCodeChangeClick(Sender: TObject); -begin - { The BeginUpdate/EndUpdate will let the Item notify its observers - only once, even though two change where made. - Note: - This is for observers to the Item, not the List that the Item belongs to! } - FPersonList.Items[1].BeginUpdate; - FPersonList.Items[1].Name := 'I have changed via code'; - FPersonList.Items[1].Age := 99; - FPersonList.Items[1].EndUpdate; - { This notifies observers of the List, that something has changed. } - FPersonList.NotifyObservers; -end; - -procedure TMainForm.btnQuitClicked(Sender: TObject); -begin - Close; -end; - -procedure TMainForm.btnViaCodeAddClick(Sender: TObject); -var - lData: TPerson; -begin - lData := TPerson.Create; - lData.Name := 'I am new'; - lData.Age := 44; - FPersonList.Add(lData); -end; - -procedure TMainForm.btnShowModelClick(Sender: TObject); -begin - tiShowString(FPersonList.AsDebugString); -end; - -procedure TMainForm.btnShowDeletedClick(Sender: TObject); -var - med: TtiMediatorView; -begin - med := FMediator.FindByComponent(grdName1).Mediator; - tiShowString(TtiStringGridMediatorView(med).SelectedObject.AsDebugString); -end; - -procedure TMainForm.SetupMediators; -begin - if not Assigned(FMediator) then - begin - FMediator := TtiModelMediator.Create(self); - FMediator.Name := 'DemoFormMediator'; - FMediator.AddComposite('Name(150,"Name",<);Age(50,"Age",>);GenderGUI(80,"Gender",|)', grdName1); -// FMediator.AddComposite('Name(150,"Name",<);Age(75,"Age",>);GenderGUI(50,"Gender",|)', lvName1); - FMediator.AddProperty('Name', lstName1); - end; - FMediator.Subject := FPersonList; - FMediator.Active := True; - -// medCombo := TMediatorComboBoxView.CreateCustom(cbName1, FPerson); -end; - -constructor TMainForm.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - FPersonList := GeneratePersonList; -end; - -destructor TMainForm.Destroy; -begin - FMediator.Active := False; - FPersonList.Free; - inherited Destroy; -end; - -procedure TMainForm.AfterConstruction; -begin - inherited AfterConstruction; - SetupMediators; - FPersonList.NotifyObservers; -end; - -procedure TMainForm.AfterCreate; -begin - {@VFD_BODY_BEGIN: MainForm} - Name := 'MainForm'; - SetPosition(298, 184, 617, 358); - WindowTitle := 'Demo 20: ListMediators'; - Sizeable := False; - - lvName1 := TfpgListView.Create(self); - with lvName1 do - begin - Name := 'lvName1'; - SetPosition(8, 52, 292, 112); - ShowHeaders := True; - end; - - grdName1 := TfpgStringGrid.Create(self); - with grdName1 do - begin - Name := 'grdName1'; - SetPosition(316, 52, 292, 220); - FontDesc := '#Grid'; - HeaderFontDesc := '#GridHeader'; - TabOrder := 1; - Tag := 99; - end; - - pnlName1 := TfpgPanel.Create(self); - with pnlName1 do - begin - Name := 'pnlName1'; - SetPosition(8, 12, 600, 28); - Anchors := [anLeft,anRight,anTop]; - Alignment := taLeftJustify; - Margin := 8; - Text := 'ListMediator Demo'; - FontDesc := '#Label2'; - TextColor := clWhite; - BackGroundColor := clDarkBlue; - end; - - btnName1 := TfpgButton.Create(self); - with btnName1 do - begin - Name := 'btnName1'; - SetPosition(8, 296, 120, 24); - Text := 'Add via Code'; - FontDesc := '#Label1'; - Hint := ''; - ImageName := ''; - TabOrder := 3; - OnClick := @btnViaCodeAddClick; - end; - - btnName2 := TfpgButton.Create(self); - with btnName2 do - begin - Name := 'btnName2'; - SetPosition(8, 324, 120, 24); - Text := 'Change via Code'; - FontDesc := '#Label1'; - Hint := ''; - ImageName := ''; - TabOrder := 4; - OnClick := @btnViaCodeChangeClick; - end; - - btnName3 := TfpgButton.Create(self); - with btnName3 do - begin - Name := 'btnName3'; - SetPosition(132, 324, 96, 24); - Text := 'Show Model'; - FontDesc := '#Label1'; - Hint := ''; - ImageName := ''; - TabOrder := 5; - OnClick := @btnShowModelClick; - end; - - btnName4 := TfpgButton.Create(self); - with btnName4 do - begin - Name := 'btnName4'; - SetPosition(232, 324, 80, 24); - Text := 'Delete'; - FontDesc := '#Label1'; - Hint := ''; - ImageName := ''; - TabOrder := 6; - OnClick := @btnShowDeletedClick; - end; - - btnQuit := TfpgButton.Create(self); - with btnQuit do - begin - Name := 'btnQuit'; - SetPosition(528, 324, 80, 24); - Text := 'Quit'; - FontDesc := '#Label1'; - Hint := ''; - ImageName := ''; - TabOrder := 7; - OnClick := @btnQuitClicked; - end; - - cbName1 := TfpgCheckBox.Create(self); - with cbName1 do - begin - Name := 'cbName1'; - SetPosition(148, 296, 120, 20); - FontDesc := '#Label1'; - TabOrder := 8; - Text := 'Show Deleted'; - OnClick := @btnShowDeletedClick; - end; - - lstName1 := TfpgListBox.Create(self); - with lstName1 do - begin - Name := 'lstName1'; - SetPosition(8, 168, 228, 120); - FontDesc := '#List'; - TabOrder := 9; - end; - - cbName2 := TfpgComboBox.Create(self); - with cbName2 do - begin - Name := 'cbName2'; - SetPosition(320, 276, 204, 22); - FontDesc := '#List'; - TabOrder := 10; - end; - - {@VFD_BODY_END: MainForm} -end; - - -initialization - gMediatorManager.RegisterMediator(TtiStringGridMediatorView, TtiObjectList); -// gMediatorManager.RegisterMediator(TListBoxMediator, TPersonList); -// gMediatorManager.RegisterMediator(TListViewMediator, TtiObjectList); - -end. diff --git a/extras/tiopf/demos/Demo_21_AdrsBook_MGM/_readme.txt b/extras/tiopf/demos/Demo_21_AdrsBook_MGM/_readme.txt deleted file mode 100644 index 51897ba0..00000000 --- a/extras/tiopf/demos/Demo_21_AdrsBook_MGM/_readme.txt +++ /dev/null @@ -1,14 +0,0 @@ -ToDo: - This demo must be modified for the latest structure in Adrs_bom.pas - - This demo implements a Address Book. It uses standard components - and the Model-GUI-Mediator pattern to make those components - object-aware. - - This demo is still work in progress... Not complete! - - - Graeme Geldenhuys - - - diff --git a/extras/tiopf/demos/Demo_21_AdrsBook_MGM/contactmanager.pas b/extras/tiopf/demos/Demo_21_AdrsBook_MGM/contactmanager.pas deleted file mode 100644 index c8518f30..00000000 --- a/extras/tiopf/demos/Demo_21_AdrsBook_MGM/contactmanager.pas +++ /dev/null @@ -1,260 +0,0 @@ -unit contactmanager; - -{$IFDEF FPC} - {$mode objfpc}{$H+} -{$ENDIF} - -interface - -uses - model; - -type - - { TContactManager } - - TContactManager = class(TMarkObject) - private - FAddressTypeList: TAddressTypeList; - FCityList: TCityList; - FContactList: TContactList; - FCountryList: TCountryList; - procedure PopulateCountries; - procedure PopulateCities; - procedure PopulateAddressTypes; - function GenPhone: string; - public - constructor Create; override; - destructor Destroy; override; - procedure PopulateContacts; - published - property AddressTypeList: TAddressTypeList read FAddressTypeList; - property CountryList: TCountryList read FCountryList; - property CityList: TCityList read FCityList; - property ContactList: TContactList read FContactList; - end; - - -// Global singleton -function gContactManager: TContactManager; - - -implementation - -uses - SysUtils, tiObject; - -var - uContactManager: TContactManager; - -const - LastNames: array[1..10] of string = ('Geldenhuys', 'Botha', 'Johnson', 'Fourie', - 'Louw', 'Bougas', 'van der Mescht', 'Waskanski', 'Welgens', 'Viljoen'); - - FirstNames: array[1..10] of string = ('Graeme', 'Johan', 'Debbie', 'Freda', - 'Jack', 'Ryno', 'Dirkus', 'Angela', 'Denise', 'Daniel'); - - StreetNames: array[1..11] of string = ('Stellenberg Rd', 'Stellendal Rd', - 'Abelia', 'Main Rd', 'Links Drive', 'Short Street', - 'Long Street', 'Loop Street', 'Hillside Rd', 'Mountain Rd', 'Beach Drive'); - -function gContactManager: TContactManager; -begin - if not Assigned(uContactManager) then - uContactManager:= TContactManager.Create; - result:= uContactManager; -end; - -{ TContactManager } - -procedure TContactManager.PopulateCountries; -var - i: integer; -begin - FCountryList.Add(TCountry.CreateNew('za', 'South Africa')); - FCountryList.Add(TCountry.CreateNew('gb', 'Great Britain')); - FCountryList.Add(TCountry.CreateNew('uk', 'Ukrain')); - FCountryList.Add(TCountry.CreateNew('fr', 'France')); - FCountryList.Add(TCountry.CreateNew('us', 'United States')); - FCountryList.Add(TCountry.CreateNew('gr', 'Germany')); - - { reset ObjectState property } - for i := 0 to FCountryList.Count - 1 do - FCountryList[i].ObjectState := posClean; -end; - -procedure TContactManager.PopulateCities; -var - c: TCity; - i: integer; -begin - c:= TCity.CreateNew; - c.Name:= 'Somerset West'; - c.ZIP := '7130'; - c.Country:= TCountry(FCountryList.FindByProps(['ISO'], ['za'], True)); - FCityList.Add(c); - - c:= TCity.CreateNew; - c.Name:= 'Cape Town'; - c.ZIP := '8000'; - c.Country:= TCountry(FCountryList.FindByProps(['ISO'], ['za'], True)); - FCityList.Add(c); - - c:= TCity.CreateNew; - c.Name:= 'Pretoria'; - c.ZIP := '0001'; - c.Country:= TCountry(FCountryList.FindByProps(['ISO'], ['za'], True)); - FCityList.Add(c); - - c:= TCity.CreateNew; - c.Name:= 'Durban'; - c.ZIP := '2000'; - c.Country:= TCountry(FCountryList.FindByProps(['ISO'], ['za'], True)); - FCityList.Add(c); - - c:= TCity.CreateNew; - c.Name:= 'London'; - c.ZIP := 'EC9 5NW'; - c.Country:= TCountry(FCountryList.FindByProps(['ISO'], ['gb'], True)); - - FCityList.Add(c); - c:= TCity.CreateNew; - c.Name:= 'Watford'; - c.ZIP := 'NW9 7BJ'; - c.Country:= TCountry(FCountryList.FindByProps(['ISO'], ['gb'], True)); - FCityList.Add(c); - - c:= TCity.CreateNew; - c.Name:= 'Frankfurt'; - c.ZIP := 'FK2000'; - c.Country:= TCountry(FCountryList.FindByProps(['ISO'], ['gr'], True)); - FCityList.Add(c); - - c:= TCity.CreateNew; - c.Name:= 'New York'; - c.ZIP := 'NY2008'; - c.Country:= TCountry(FCountryList.FindByProps(['ISO'], ['us'], True)); - FCityList.Add(c); - - c:= TCity.CreateNew; - c.Name:= 'San Fransisco'; - c.ZIP := 'SF2500'; - c.Country:= TCountry(FCountryList.FindByProps(['ISO'], ['us'], True)); - FCityList.Add(c); - - c:= TCity.CreateNew; - c.Name:= 'Paris'; - c.ZIP := 'PRS007'; - c.Country:= TCountry(FCountryList.FindByProps(['ISO'], ['fr'], True)); - FCityList.Add(c); - - c:= TCity.CreateNew; - c.Name:= 'Big City'; - c.ZIP := 'BC5 7WN'; - c.Country:= TCountry(FCountryList.FindByProps(['ISO'], ['uk'], True)); - FCityList.Add(c); - - { reset ObjectState property } - for i := 0 to FCityList.Count - 1 do - FCityList[i].ObjectState := posClean; -end; - -procedure TContactManager.PopulateAddressTypes; -var - a: TAddressType; - i: integer; -begin - a := TAddressType.CreateNew; - a.Name := 'Home'; - FAddressTypeList.Add(a); - - a := TAddressType.CreateNew; - a.Name := 'Work'; - FAddressTypeList.Add(a); - - a := TAddressType.CreateNew; - a.Name := 'Postal'; - FAddressTypeList.Add(a); - - { reset ObjectState property } - for i := 0 to FAddressTypeList.Count - 1 do - FAddressTypeList[i].ObjectState := posClean; -end; - -function TContactManager.GenPhone: string; -begin - result:= '+27 ' + IntToStr(Random(9)) + IntToStr(Random(9)) + ' ' - + IntToStr(Random(9)) + IntToStr(Random(9)) + IntToStr(Random(9)) + '-' - + IntToStr(Random(9)) + IntToStr(Random(9)) + IntToStr(Random(9)) + IntToStr(Random(9)); -end; - -constructor TContactManager.Create; -begin - inherited Create; - FAddressTypeList := TAddressTypeList.Create; - FAddressTypeList.Owner := self; - - FCountryList := TCountryList.Create; - FCountryList.Owner := self; - - FCityList := TCityList.Create; - FCityList.Owner := self; - - FContactList := TContactList.Create; - FContactList.Owner := self; -end; - -destructor TContactManager.Destroy; -begin - FContactList.Free; - FCityList.Free; - FCountryList.Free; - FAddressTypeList.Free; - inherited Destroy; -end; - -procedure TContactManager.PopulateContacts; -var - C: TContact; - I,J: Integer; - A: TAddress; -begin - PopulateCountries; - PopulateCities; - PopulateAddressTypes; - for I := 1 to 10 do - begin - C:= TContact.CreateNew; - C.FirstName:= FirstNames[I]; - C.LastName := LastNames[I]; - C.Mobile := GenPhone; - C.Email := LowerCase(FirstNames[i])+ '@freepascal.org'; - for J:= 1 to 1+Random(2) do - begin - A:= TAddress.CreateNew; - A.AddressType := FAddressTypeList[Random(3)]; - A.Street := StreetNames[1+Random(10)]; - A.Nr := Random(100)+1; - A.City := FCityList[Random(10)]; - A.Fax := GenPhone; - A.Telephone1:= GenPhone; - If Random(2)>0 then - A.Telephone2:= GenPhone; - A.Dirty := False; - C.AddressList.Add(A); - end; - C.Comments := 'My name is ' + C.FirstName + '.'; - C.ObjectState := posClean; - FContactList.Add(C); - end; -end; - - -initialization - uContactManager:= nil; - -finalization - uContactManager.Free; - -end. - diff --git a/extras/tiopf/demos/Demo_21_AdrsBook_MGM/demo_adrsbook_mgm.lpi b/extras/tiopf/demos/Demo_21_AdrsBook_MGM/demo_adrsbook_mgm.lpi deleted file mode 100644 index ce40db74..00000000 --- a/extras/tiopf/demos/Demo_21_AdrsBook_MGM/demo_adrsbook_mgm.lpi +++ /dev/null @@ -1,100 +0,0 @@ -<?xml version="1.0"?> -<CONFIG> - <ProjectOptions> - <Version Value="9"/> - <General> - <Flags> - <SaveOnlyProjectUnits Value="True"/> - <LRSInOutputDirectory Value="False"/> - </Flags> - <SessionStorage Value="InProjectDir"/> - <MainUnit Value="0"/> - </General> - <VersionInfo> - <StringTable ProductVersion=""/> - </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="1"> - <Item1> - <PackageName Value="tiOPFfpGUI"/> - </Item1> - </RequiredPackages> - <Units Count="9"> - <Unit0> - <Filename Value="demo_adrsbook_mgm.lpr"/> - <IsPartOfProject Value="True"/> - <UnitName Value="demo_adrsbook_mgm"/> - </Unit0> - <Unit1> - <Filename Value="contactmanager.pas"/> - <IsPartOfProject Value="True"/> - <UnitName Value="contactmanager"/> - </Unit1> - <Unit2> - <Filename Value="model.pas"/> - <IsPartOfProject Value="True"/> - <UnitName Value="model"/> - </Unit2> - <Unit3> - <Filename Value="frmmain.pas"/> - <IsPartOfProject Value="True"/> - <UnitName Value="frmmain"/> - </Unit3> - <Unit4> - <Filename Value="frmcontactmaint.pas"/> - <IsPartOfProject Value="True"/> - <UnitName Value="frmContactMaint"/> - </Unit4> - <Unit5> - <Filename Value="frmcitylist.pas"/> - <IsPartOfProject Value="True"/> - <UnitName Value="frmCityList"/> - </Unit5> - <Unit6> - <Filename Value="frmcitymaint.pas"/> - <IsPartOfProject Value="True"/> - <UnitName Value="frmCityMaint"/> - </Unit6> - <Unit7> - <Filename Value="frmcountrylist.pas"/> - <IsPartOfProject Value="True"/> - <UnitName Value="frmCountryList"/> - </Unit7> - <Unit8> - <Filename Value="frmaddressmaint.pas"/> - <IsPartOfProject Value="True"/> - <UnitName Value="frmAddressMaint"/> - </Unit8> - </Units> - </ProjectOptions> - <CompilerOptions> - <Version Value="9"/> - <SearchPaths> - <UnitOutputDirectory Value="units/$(TargetCPU)-$(TargetOS)"/> - </SearchPaths> - <Parsing> - <SyntaxOptions> - <CStyleOperator Value="False"/> - <AllowLabel Value="False"/> - <CPPInline Value="False"/> - <UseAnsiStrings Value="False"/> - </SyntaxOptions> - </Parsing> - <Other> - <CustomOptions Value=" -"/> - <CompilerPath Value="$(CompPath)"/> - </Other> - </CompilerOptions> -</CONFIG> diff --git a/extras/tiopf/demos/Demo_21_AdrsBook_MGM/demo_adrsbook_mgm.lpr b/extras/tiopf/demos/Demo_21_AdrsBook_MGM/demo_adrsbook_mgm.lpr deleted file mode 100644 index d5e48414..00000000 --- a/extras/tiopf/demos/Demo_21_AdrsBook_MGM/demo_adrsbook_mgm.lpr +++ /dev/null @@ -1,33 +0,0 @@ -program demo_adrsbook_mgm; - -{$mode objfpc}{$H+} - -uses - {$IFDEF UNIX}{$IFDEF UseCThreads} - cthreads, - {$ENDIF}{$ENDIF} - Classes, fpg_main, frmmain, frmcontactmaint, frmCityList, frmcitymaint, - frmcountrylist, frmaddressmaint; - - - -procedure MainProc; -var - frm: TMainForm; -begin - fpgApplication.Initialize; - frm := TMainForm.Create(nil); - try - frm.Show; - fpgApplication.Run; - finally - frm.Free; - end; -end; - -begin - Randomize; - MainProc; -end. - - diff --git a/extras/tiopf/demos/Demo_21_AdrsBook_MGM/frmaddressmaint.pas b/extras/tiopf/demos/Demo_21_AdrsBook_MGM/frmaddressmaint.pas deleted file mode 100644 index 931b36c5..00000000 --- a/extras/tiopf/demos/Demo_21_AdrsBook_MGM/frmaddressmaint.pas +++ /dev/null @@ -1,266 +0,0 @@ -unit frmAddressMaint; - -{$mode objfpc}{$H+} - -interface - -uses - SysUtils, Classes, fpg_base, fpg_main, fpg_edit, - fpg_widget, fpg_form, fpg_label, fpg_button, fpg_combobox, - fpg_dialogs, fpg_menu, - model, tiModelMediator; - -type - TAddressEditForm = class(TfpgForm) - private - {@VFD_HEAD_BEGIN: AddressEditForm} - cbType: TfpgComboBox; - edNo: TfpgEdit; - edStreet: TfpgEdit; - cbCity: TfpgComboBox; - edPhone1: TfpgEdit; - edPhone2: TfpgEdit; - edFax: TfpgEdit; - lblName1: TfpgLabel; - lblName2: TfpgLabel; - lblName3: TfpgLabel; - lblName4: TfpgLabel; - lblName5: TfpgLabel; - lblName6: TfpgLabel; - lblName7: TfpgLabel; - btnSave: TfpgButton; - btnCancel: TfpgButton; - {@VFD_HEAD_END: AddressEditForm} - FData: TAddress; - FMediator: TtiModelMediator; - procedure SetData(const AValue: TAddress); - procedure SetupMediators; - public - procedure AfterCreate; override; - property Data: TAddress read FData write SetData; - end; - -{@VFD_NEWFORM_DECL} - -function EditAddress(AData: TAddress): Boolean; - -implementation - -uses - contactmanager; - - -function EditAddress(AData: TAddress): Boolean; -var - frm: TAddressEditForm; -begin - frm:= TAddressEditForm.Create(nil); - try - frm.SetData(AData); - result:= frm.ShowModal = mrOK; - finally - frm.Free; - end; -end; - -{@VFD_NEWFORM_IMPL} - -procedure TAddressEditForm.SetData(const AValue: TAddress); -begin - if FData=AValue then exit; - FData:=AValue; - SetupMediators; -end; - -procedure TAddressEditForm.SetupMediators; -begin - if not Assigned(FMediator) then - begin - FMediator := TtiModelMediator.Create(self); - FMediator.AddProperty('AddressType', cbType).ValueList := gContactManager.AddressTypeList; - FMediator.AddProperty('Nr', edNo); - FMediator.AddProperty('Street', edStreet); - FMediator.AddProperty('City', cbCity).ValueList := gContactManager.CityList; - FMediator.AddProperty('Telephone1', edPhone1); - FMediator.AddProperty('Telephone2', edPhone2); - FMediator.AddProperty('Fax', edFax); - end; - FMediator.Subject := FData; - FMediator.Active := True; -end; - -procedure TAddressEditForm.AfterCreate; -begin - {@VFD_BODY_BEGIN: AddressEditForm} - Name := 'AddressEditForm'; - SetPosition(300, 231, 296, 282); - WindowTitle := 'Address Edit Form'; - - cbType := TfpgComboBox.Create(self); - with cbType do - begin - Name := 'cbType'; - SetPosition(8, 24, 272, 22); - FontDesc := '#List'; - end; - - edNo := TfpgEdit.Create(self); - with edNo do - begin - Name := 'edNo'; - SetPosition(8, 68, 56, 22); - TabOrder := 1; - Text := ''; - FontDesc := '#Edit1'; - end; - - edStreet := TfpgEdit.Create(self); - with edStreet do - begin - Name := 'edStreet'; - SetPosition(76, 68, 204, 22); - TabOrder := 2; - Text := ''; - FontDesc := '#Edit1'; - end; - - cbCity := TfpgComboBox.Create(self); - with cbCity do - begin - Name := 'cbCity'; - SetPosition(8, 112, 272, 22); - FontDesc := '#List'; - TabOrder := 3; - end; - - edPhone1 := TfpgEdit.Create(self); - with edPhone1 do - begin - Name := 'edPhone1'; - SetPosition(8, 160, 120, 22); - TabOrder := 4; - Text := ''; - FontDesc := '#Edit1'; - end; - - edPhone2 := TfpgEdit.Create(self); - with edPhone2 do - begin - Name := 'edPhone2'; - SetPosition(160, 160, 120, 22); - TabOrder := 5; - Text := ''; - FontDesc := '#Edit1'; - end; - - edFax := TfpgEdit.Create(self); - with edFax do - begin - Name := 'edFax'; - SetPosition(8, 204, 120, 22); - TabOrder := 6; - Text := ''; - FontDesc := '#Edit1'; - end; - - lblName1 := TfpgLabel.Create(self); - with lblName1 do - begin - Name := 'lblName1'; - SetPosition(76, 52, 120, 16); - FontDesc := '#Label1'; - Hint := ''; - Text := 'Street:'; - end; - - lblName2 := TfpgLabel.Create(self); - with lblName2 do - begin - Name := 'lblName2'; - SetPosition(8, 52, 60, 16); - FontDesc := '#Label1'; - Hint := ''; - Text := 'Number:'; - end; - - lblName3 := TfpgLabel.Create(self); - with lblName3 do - begin - Name := 'lblName3'; - SetPosition(8, 144, 120, 16); - FontDesc := '#Label1'; - Hint := ''; - Text := 'Telephone #1:'; - end; - - lblName4 := TfpgLabel.Create(self); - with lblName4 do - begin - Name := 'lblName4'; - SetPosition(160, 144, 112, 16); - FontDesc := '#Label1'; - Hint := ''; - Text := 'Telephone #2:'; - end; - - lblName5 := TfpgLabel.Create(self); - with lblName5 do - begin - Name := 'lblName5'; - SetPosition(8, 188, 80, 16); - FontDesc := '#Label1'; - Hint := ''; - Text := 'Fax:'; - end; - - lblName6 := TfpgLabel.Create(self); - with lblName6 do - begin - Name := 'lblName6'; - SetPosition(8, 8, 80, 16); - FontDesc := '#Label1'; - Hint := ''; - Text := 'Type:'; - end; - - lblName7 := TfpgLabel.Create(self); - with lblName7 do - begin - Name := 'lblName7'; - SetPosition(8, 96, 80, 16); - FontDesc := '#Label1'; - Hint := ''; - Text := 'City:'; - end; - - btnSave := TfpgButton.Create(self); - with btnSave do - begin - Name := 'btnSave'; - SetPosition(124, 248, 80, 24); - Text := 'Save'; - FontDesc := '#Label1'; - Hint := ''; - ImageName := ''; - TabOrder := 7; - ModalResult := mrOK; - end; - - btnCancel := TfpgButton.Create(self); - with btnCancel do - begin - Name := 'btnCancel'; - SetPosition(208, 248, 80, 24); - Text := 'Cancel'; - FontDesc := '#Label1'; - Hint := ''; - ImageName := ''; - TabOrder := 8; - ModalResult := mrCancel; - end; - - {@VFD_BODY_END: AddressEditForm} -end; - - -end. diff --git a/extras/tiopf/demos/Demo_21_AdrsBook_MGM/frmcitylist.pas b/extras/tiopf/demos/Demo_21_AdrsBook_MGM/frmcitylist.pas deleted file mode 100644 index 522362d1..00000000 --- a/extras/tiopf/demos/Demo_21_AdrsBook_MGM/frmcitylist.pas +++ /dev/null @@ -1,173 +0,0 @@ -unit frmCityList; - -{$mode objfpc}{$H+} - -interface - -uses - SysUtils, Classes, fpg_base, fpg_main, - fpg_widget, fpg_form, fpg_button, - fpg_grid, fpg_dialogs, fpg_menu, - fpg_panel, - tiModelMediator, model; - -type - - TCityListForm = class(TfpgForm) - private - {@VFD_HEAD_BEGIN: CityListForm} - bvlName1: TfpgBevel; - btnAdd: TfpgButton; - btnEdit: TfpgButton; - btnDelete: TfpgButton; - grdName1: TfpgStringGrid; - btnCancel: TfpgButton; - {@VFD_HEAD_END: CityListForm} - FData: TCityList; - FMediator: TtiModelMediator; - procedure SetData(const AValue: TCityList); - procedure SetupMediators; - procedure btnEditClicked(Sender: TObject); - public - procedure AfterCreate; override; - property Data: TCityList read FData write SetData; - end; - -{@VFD_NEWFORM_DECL} - -procedure ShowCities(const AList: TCityList); - - -implementation - -uses - tiListMediators, frmCityMaint{, tiDialogs}; - - -procedure ShowCities(const AList: TCityList); -var - frm: TCityListForm; -begin - frm := TCityListForm.Create(nil); - try - frm.SetData(AList); - frm.ShowModal; - finally; - frm.Free; - end; -end; - -{@VFD_NEWFORM_IMPL} - -procedure TCityListForm.SetupMediators; -begin - if not Assigned(FMediator) then - begin - FMediator := TtiModelMediator.Create(self); - FMediator.AddComposite('Name(110);Zip(80);CountryAsString(150)', grdName1); - end; - FMediator.Subject := FData; - FMediator.Active := True; -end; - -procedure TCityListForm.btnEditClicked(Sender: TObject); -var - c: TCity; -begin - c := TCity(TtiStringGridMediatorView(FMediator.FindByComponent(grdName1).Mediator).SelectedObject); -// tiShowString(c.AsDebugString); - - if not Assigned(c) then - Exit; //==> - - if EditCity(c) then - begin - // we can save contact here - end; -end; - -procedure TCityListForm.SetData(const AValue: TCityList); -begin - if FData=AValue then exit; - FData:=AValue; - SetupMediators; -end; - -procedure TCityListForm.AfterCreate; -begin - {@VFD_BODY_BEGIN: CityListForm} - Name := 'CityListForm'; - SetPosition(412, 278, 421, 315); - WindowTitle := 'City Listing'; - - bvlName1 := TfpgBevel.Create(self); - with bvlName1 do - begin - Name := 'bvlName1'; - SetPosition(0, 0, 420, 36); - Anchors := [anLeft,anRight,anTop]; - Shape := bsSpacer; - end; - - btnAdd := TfpgButton.Create(bvlName1); - with btnAdd do - begin - Name := 'btnAdd'; - SetPosition(12, 4, 52, 24); - Text := 'Add'; - FontDesc := '#Label1'; - ImageName := ''; - Enabled := False; - end; - - btnEdit := TfpgButton.Create(bvlName1); - with btnEdit do - begin - Name := 'btnEdit'; - SetPosition(68, 4, 52, 24); - Text := 'Edit'; - FontDesc := '#Label1'; - ImageName := ''; - TabOrder := 1; - OnClick := @btnEditClicked; - end; - - btnDelete := TfpgButton.Create(bvlName1); - with btnDelete do - begin - Name := 'btnDelete'; - SetPosition(124, 4, 52, 24); - Text := 'Delete'; - FontDesc := '#Label1'; - ImageName := ''; - TabOrder := 2; - Enabled := False; - end; - - grdName1 := TfpgStringGrid.Create(self); - with grdName1 do - begin - Name := 'grdName1'; - SetPosition(8, 40, 404, 220); - FontDesc := '#Grid'; - HeaderFontDesc := '#GridHeader'; - TabOrder := 1; - end; - - btnCancel := TfpgButton.Create(self); - with btnCancel do - begin - Name := 'btnCancel'; - SetPosition(332, 276, 80, 24); - Text := 'Cancel'; - FontDesc := '#Label1'; - ImageName := ''; - TabOrder := 2; - ModalResult := mrOK; - end; - - {@VFD_BODY_END: CityListForm} -end; - - -end. diff --git a/extras/tiopf/demos/Demo_21_AdrsBook_MGM/frmcitymaint.pas b/extras/tiopf/demos/Demo_21_AdrsBook_MGM/frmcitymaint.pas deleted file mode 100644 index 1b6f27f7..00000000 --- a/extras/tiopf/demos/Demo_21_AdrsBook_MGM/frmcitymaint.pas +++ /dev/null @@ -1,200 +0,0 @@ -unit frmCityMaint; - -{$mode objfpc}{$H+} - -interface - -uses - SysUtils, Classes, fpg_base, fpg_main, fpg_edit, - fpg_widget, fpg_form, fpg_label, fpg_button, - fpg_dialogs, fpg_combobox, - model, tiModelMediator; - -type - - TCityEditForm = class(TfpgForm) - private - {@VFD_HEAD_BEGIN: CityEditForm} - lblName1: TfpgLabel; - edName: TfpgEdit; - lblName2: TfpgLabel; - edZIP: TfpgEdit; - lblName3: TfpgLabel; - cbCountry: TfpgComboBox; - btnSave: TfpgButton; - btnCancel: TfpgButton; - btnDebug: TfpgButton; - {@VFD_HEAD_END: CityEditForm} - FMediator: TtiModelMediator; - FData: TCity; - procedure SetData(const AValue: TCity); - procedure SetupMediators; - procedure btnDebugClicked(Sender: TObject); - public - procedure AfterCreate; override; - property Data: TCity read FData write SetData; - end; - -{@VFD_NEWFORM_DECL} - -function EditCity(AData: TCity): boolean; - - -implementation - -uses - tiBaseMediator, contactmanager, typinfo, tiDialogs; - - -function EditCity(AData: TCity): boolean; -var - frm: TCityEditForm; -begin - frm:= TCityEditForm.Create(nil); - try - frm.SetData(AData); - result:= frm.ShowModal = mrOK; - finally - frm.Free; - end; -end; - -{@VFD_NEWFORM_IMPL} - -procedure TCityEditForm.SetData(const AValue: TCity); -begin - if FData=AValue then exit; - FData:=AValue; - SetupMediators; -end; - -procedure TCityEditForm.SetupMediators; -begin - if not Assigned(FMediator) then - begin - FMediator := TtiModelMediator.Create(self); - FMediator.AddProperty('Name', edName); - FMediator.AddProperty('ZIP', edZIP); - FMediator.AddProperty('Country', cbCountry).ValueList := gContactManager.CountryList; - end; - FMediator.Subject := FData; - FMediator.Active := True; -end; - -procedure TCityEditForm.btnDebugClicked(Sender: TObject); -begin - tiShowString(FData.AsDebugString); -end; - -procedure TCityEditForm.AfterCreate; -begin - {@VFD_BODY_BEGIN: CityEditForm} - Name := 'CityEditForm'; - SetPosition(673, 204, 350, 186); - WindowTitle := 'City Maintenance'; - - lblName1 := TfpgLabel.Create(self); - with lblName1 do - begin - Name := 'lblName1'; - SetPosition(8, 8, 80, 16); - FontDesc := '#Label1'; - Hint := ''; - Text := 'City name:'; - end; - - edName := TfpgEdit.Create(self); - with edName do - begin - Name := 'edName'; - SetPosition(8, 24, 200, 22); - TabOrder := 1; - Text := ''; - FontDesc := '#Edit1'; - end; - - lblName2 := TfpgLabel.Create(self); - with lblName2 do - begin - Name := 'lblName2'; - SetPosition(8, 52, 80, 16); - FontDesc := '#Label1'; - Hint := ''; - Text := 'ZIP code:'; - end; - - edZIP := TfpgEdit.Create(self); - with edZIP do - begin - Name := 'edZIP'; - SetPosition(8, 68, 120, 22); - TabOrder := 3; - Text := ''; - FontDesc := '#Edit1'; - end; - - lblName3 := TfpgLabel.Create(self); - with lblName3 do - begin - Name := 'lblName3'; - SetPosition(8, 96, 80, 16); - FontDesc := '#Label1'; - Hint := ''; - Text := 'Country:'; - end; - - cbCountry := TfpgComboBox.Create(self); - with cbCountry do - begin - Name := 'cbCountry'; - SetPosition(8, 112, 200, 22); - FontDesc := '#List'; - TabOrder := 5; - end; - - btnSave := TfpgButton.Create(self); - with btnSave do - begin - Name := 'btnSave'; - SetPosition(182, 156, 80, 24); - Anchors := [anRight,anBottom]; - Text := 'Save'; - FontDesc := '#Label1'; - Hint := ''; - ImageName := ''; - TabOrder := 6; - ModalResult := mrOK; - end; - - btnCancel := TfpgButton.Create(self); - with btnCancel do - begin - Name := 'btnCancel'; - SetPosition(266, 156, 80, 24); - Anchors := [anRight,anBottom]; - Text := 'Cancel'; - FontDesc := '#Label1'; - Hint := ''; - ImageName := ''; - TabOrder := 7; - ModalResult := mrCancel; - end; - - btnDebug := TfpgButton.Create(self); - with btnDebug do - begin - Name := 'btnDebug'; - SetPosition(8, 156, 100, 24); - Text := 'Debug (Show)'; - FontDesc := '#Label1'; - Hint := ''; - ImageName := ''; - TabOrder := 8; - OnClick := @btnDebugClicked; - end; - - {@VFD_BODY_END: CityEditForm} -end; - - -end. diff --git a/extras/tiopf/demos/Demo_21_AdrsBook_MGM/frmcontactmaint.pas b/extras/tiopf/demos/Demo_21_AdrsBook_MGM/frmcontactmaint.pas deleted file mode 100644 index 8bd46e31..00000000 --- a/extras/tiopf/demos/Demo_21_AdrsBook_MGM/frmcontactmaint.pas +++ /dev/null @@ -1,335 +0,0 @@ -unit frmContactMaint; - -{$mode objfpc}{$H+} - -interface - -uses - SysUtils, Classes, fpg_base, fpg_main, fpg_edit, - fpg_widget, fpg_form, fpg_label, fpg_button, - fpg_listview, fpg_memo, - model, tiModelMediator; - -type - - TContactEditForm = class(TfpgForm) - private - {@VFD_HEAD_BEGIN: ContactEditForm} - lblName1: TfpgLabel; - edFName: TfpgEdit; - lblName2: TfpgLabel; - edLName: TfpgEdit; - lblName3: TfpgLabel; - edEmail: TfpgEdit; - lblName4: TfpgLabel; - edMobile: TfpgEdit; - lblName5: TfpgLabel; - meComments: TfpgMemo; - lblName6: TfpgLabel; - lvAddresses: TfpgListView; - btnSave: TfpgButton; - btnCancel: TfpgButton; - btnAdd: TfpgButton; - btnEdit: TfpgButton; - btnDelete: TfpgButton; - btnDebug: TfpgButton; - {@VFD_HEAD_END: ContactEditForm} - FData: TContact; - FMediator: TtiModelMediator; - FAdrsMediator: TtiModelMediator; - procedure SetData(const AValue: TContact); - procedure SetupMediators; - procedure btnDebugClicked(Sender: TObject); - procedure btnEditClicked(Sender: TObject); - public - procedure AfterCreate; override; - property Data: TContact read FData write SetData; - end; - -{@VFD_NEWFORM_DECL} - -function EditContact(AData: TContact): Boolean; - - -implementation - -uses - contactmanager, tiDialogs, frmAddressMaint, tiListMediators; - - -function EditContact(AData: TContact): Boolean; -var - frm: TContactEditForm; -begin - frm:= TContactEditForm.Create(nil); - try - frm.SetData(AData); - result:= frm.ShowModal = mrOK; - finally - frm.Free; - end; -end; - - -{@VFD_NEWFORM_IMPL} - -procedure TContactEditForm.SetupMediators; -begin - if not Assigned(FMediator) then - begin - FMediator := TtiModelMediator.Create(self); - FMediator.AddProperty('FirstName', edFName); - FMediator.AddProperty('LastName', edLName); - FMediator.AddProperty('EMail', edEmail); - FMediator.AddProperty('Mobile', edMobile); - FMediator.AddProperty('Comments', meComments); - end; - FMediator.Subject := FData; - FMediator.Active := True; - - if not Assigned(FAdrsMediator) then - begin - FAdrsMediator := TtiModelMediator.Create(self); - FAdrsMediator.AddComposite({'AddressType.Name;}'AddressType4GUI(50,"Type");Nr;Street;Telephone1', lvAddresses); - end; - FAdrsMediator.Subject := FData.AddressList; - FAdrsMediator.Active := True; -end; - -procedure TContactEditForm.btnDebugClicked(Sender: TObject); -begin - tiShowString(FData.AsDebugString); -end; - -procedure TContactEditForm.btnEditClicked(Sender: TObject); -var - obj: TAddress; -begin - obj := TAddress(TtiListViewMediatorView(FAdrsMediator.FindByComponent(lvAddresses).Mediator).SelectedObject); - tiShowString(obj.AsDebugString); - - if not Assigned(obj) then - Exit; //==> - - if EditAddress(obj) then - begin - // do nothing - end; -end; - -procedure TContactEditForm.SetData(const AValue: TContact); -begin - if FData=AValue then exit; - FData:=AValue; - SetupMediators; -end; - -procedure TContactEditForm.AfterCreate; -begin - {@VFD_BODY_BEGIN: ContactEditForm} - Name := 'ContactEditForm'; - SetPosition(513, 423, 537, 331); - WindowTitle := 'Contact Edit Form'; - - lblName1 := TfpgLabel.Create(self); - with lblName1 do - begin - Name := 'lblName1'; - SetPosition(8, 8, 80, 16); - FontDesc := '#Label1'; - Hint := ''; - Text := 'Firstname:'; - end; - - edFName := TfpgEdit.Create(self); - with edFName do - begin - Name := 'edFName'; - SetPosition(8, 24, 216, 22); - TabOrder := 1; - Text := ''; - FontDesc := '#Edit1'; - end; - - lblName2 := TfpgLabel.Create(self); - with lblName2 do - begin - Name := 'lblName2'; - SetPosition(8, 52, 80, 16); - FontDesc := '#Label1'; - Hint := ''; - Text := 'Lastname:'; - end; - - edLName := TfpgEdit.Create(self); - with edLName do - begin - Name := 'edLName'; - SetPosition(8, 68, 216, 22); - TabOrder := 3; - Text := ''; - FontDesc := '#Edit1'; - end; - - lblName3 := TfpgLabel.Create(self); - with lblName3 do - begin - Name := 'lblName3'; - SetPosition(8, 96, 80, 16); - FontDesc := '#Label1'; - Hint := ''; - Text := 'EMail:'; - end; - - edEmail := TfpgEdit.Create(self); - with edEmail do - begin - Name := 'edEmail'; - SetPosition(8, 112, 216, 22); - TabOrder := 5; - Text := ''; - FontDesc := '#Edit1'; - end; - - lblName4 := TfpgLabel.Create(self); - with lblName4 do - begin - Name := 'lblName4'; - SetPosition(8, 140, 80, 16); - FontDesc := '#Label1'; - Hint := ''; - Text := 'Mobile:'; - end; - - edMobile := TfpgEdit.Create(self); - with edMobile do - begin - Name := 'edMobile'; - SetPosition(8, 156, 216, 22); - TabOrder := 7; - Text := ''; - FontDesc := '#Edit1'; - end; - - lblName5 := TfpgLabel.Create(self); - with lblName5 do - begin - Name := 'lblName5'; - SetPosition(8, 184, 80, 16); - FontDesc := '#Label1'; - Hint := ''; - Text := 'Comments:'; - end; - - meComments := TfpgMemo.Create(self); - with meComments do - begin - Name := 'meComments'; - SetPosition(8, 200, 216, 80); - FontDesc := '#Edit1'; - TabOrder := 9; - Lines.text := 'Hello'; - end; - - lblName6 := TfpgLabel.Create(self); - with lblName6 do - begin - Name := 'lblName6'; - SetPosition(264, 8, 80, 16); - FontDesc := '#Label1'; - Hint := ''; - Text := 'Addresses:'; - end; - - lvAddresses := TfpgListView.Create(self); - with lvAddresses do - begin - Name := 'lvAddresses'; - SetPosition(264, 24, 260, 124); - ShowHeaders := True; - TabOrder := 11; - end; - - btnSave := TfpgButton.Create(self); - with btnSave do - begin - Name := 'btnSave'; - SetPosition(364, 300, 80, 24); - Text := 'Save'; - FontDesc := '#Label1'; - Hint := ''; - ImageName := ''; - TabOrder := 12; - ModalResult := mrOK; - end; - - btnCancel := TfpgButton.Create(self); - with btnCancel do - begin - Name := 'btnCancel'; - SetPosition(448, 300, 80, 24); - Text := 'Cancel'; - FontDesc := '#Label1'; - Hint := ''; - ImageName := ''; - TabOrder := 13; - ModalResult := mrCancel; - end; - - btnAdd := TfpgButton.Create(self); - with btnAdd do - begin - Name := 'btnAdd'; - SetPosition(264, 152, 52, 24); - Text := 'Add'; - FontDesc := '#Label1'; - Hint := ''; - ImageName := ''; - TabOrder := 14; - Enabled := False; - end; - - btnEdit := TfpgButton.Create(self); - with btnEdit do - begin - Name := 'btnEdit'; - SetPosition(320, 152, 52, 24); - Text := 'Edit'; - FontDesc := '#Label1'; - Hint := ''; - ImageName := ''; - TabOrder := 15; - OnClick := @btnEditClicked; - end; - - btnDelete := TfpgButton.Create(self); - with btnDelete do - begin - Name := 'btnDelete'; - SetPosition(376, 152, 52, 24); - Text := 'Delete'; - FontDesc := '#Label1'; - Hint := ''; - ImageName := ''; - TabOrder := 16; - Enabled := False; - end; - - btnDebug := TfpgButton.Create(self); - with btnDebug do - begin - Name := 'btnDebug'; - SetPosition(8, 300, 100, 24); - Text := 'Debug (Show)'; - FontDesc := '#Label1'; - Hint := ''; - ImageName := ''; - TabOrder := 17; - OnClick := @btnDebugClicked; - end; - - {@VFD_BODY_END: ContactEditForm} -end; - - -end. diff --git a/extras/tiopf/demos/Demo_21_AdrsBook_MGM/frmcountrylist.pas b/extras/tiopf/demos/Demo_21_AdrsBook_MGM/frmcountrylist.pas deleted file mode 100644 index c9f54537..00000000 --- a/extras/tiopf/demos/Demo_21_AdrsBook_MGM/frmcountrylist.pas +++ /dev/null @@ -1,166 +0,0 @@ -unit frmCountryList; - -{$mode objfpc}{$H+} - -interface - -uses - SysUtils, Classes, fpg_base, fpg_main, - fpg_widget, fpg_form, fpg_button, fpg_grid, - fpg_dialogs, fpg_menu, - fpg_panel, - model, tiModelMediator; - -type - - TCountryListForm = class(TfpgForm) - private - {@VFD_HEAD_BEGIN: CountryListForm} - bvlName1: TfpgBevel; - btnAdd: TfpgButton; - btnEdit: TfpgButton; - btnDelete: TfpgButton; - grdName1: TfpgStringGrid; - btnCancel: TfpgButton; - {@VFD_HEAD_END: CountryListForm} - FData: TCountryList; - FMediator: TtiModelMediator; - procedure SetData(const AValue: TCountryList); - procedure SetupMediators; - procedure btnEditClicked(Sender: TObject); - public - procedure AfterCreate; override; - property Data: TCountryList read FData write SetData; - end; - -{@VFD_NEWFORM_DECL} - -procedure ShowCountries(const AList: TCountryList); - - -implementation - - - - -procedure ShowCountries(const AList: TCountryList); -var - frm: TCountryListForm; -begin - frm := TCountryListForm.Create(nil); - try - frm.SetData(AList); - frm.ShowModal; - finally; - frm.Free; - end; -end; - -{@VFD_NEWFORM_IMPL} - -procedure TCountryListForm.SetupMediators; -begin - if not Assigned(FMediator) then - begin - FMediator := TtiModelMediator.Create(self); - FMediator.AddComposite('ISO(60);Name(110)', grdName1); - end; - FMediator.Subject := FData; - FMediator.Active := True; -end; - -procedure TCountryListForm.btnEditClicked(Sender: TObject); -begin - // -end; - -procedure TCountryListForm.SetData(const AValue: TCountryList); -begin - if FData=AValue then exit; - FData:=AValue; - SetupMediators; -end; - -procedure TCountryListForm.AfterCreate; -begin - {@VFD_BODY_BEGIN: CountryListForm} - Name := 'CountryListForm'; - SetPosition(412, 278, 421, 315); - WindowTitle := 'Country Listing'; - - bvlName1 := TfpgBevel.Create(self); - with bvlName1 do - begin - Name := 'bvlName1'; - SetPosition(0, 0, 420, 36); - Anchors := [anLeft,anRight,anTop]; - Shape := bsSpacer; - end; - - btnAdd := TfpgButton.Create(bvlName1); - with btnAdd do - begin - Name := 'btnAdd'; - SetPosition(12, 4, 52, 24); - Text := 'Add'; - FontDesc := '#Label1'; - Hint := ''; - ImageName := ''; - Enabled := False; - end; - - btnEdit := TfpgButton.Create(bvlName1); - with btnEdit do - begin - Name := 'btnEdit'; - SetPosition(68, 4, 52, 24); - Text := 'Edit'; - FontDesc := '#Label1'; - Hint := ''; - ImageName := ''; - TabOrder := 1; - OnClick := @btnEditClicked; - Enabled := False; - end; - - btnDelete := TfpgButton.Create(bvlName1); - with btnDelete do - begin - Name := 'btnDelete'; - SetPosition(124, 4, 52, 24); - Text := 'Delete'; - FontDesc := '#Label1'; - Hint := ''; - ImageName := ''; - TabOrder := 2; - Enabled := False; - end; - - grdName1 := TfpgStringGrid.Create(self); - with grdName1 do - begin - Name := 'grdName1'; - SetPosition(8, 40, 404, 220); - FontDesc := '#Grid'; - HeaderFontDesc := '#GridHeader'; - TabOrder := 1; - end; - - btnCancel := TfpgButton.Create(self); - with btnCancel do - begin - Name := 'btnCancel'; - SetPosition(332, 276, 80, 24); - Text := 'Cancel'; - FontDesc := '#Label1'; - Hint := ''; - ImageName := ''; - TabOrder := 2; - ModalResult := mrOK; - end; - - {@VFD_BODY_END: CountryListForm} -end; - - -end. diff --git a/extras/tiopf/demos/Demo_21_AdrsBook_MGM/frmmain.pas b/extras/tiopf/demos/Demo_21_AdrsBook_MGM/frmmain.pas deleted file mode 100644 index 979e6592..00000000 --- a/extras/tiopf/demos/Demo_21_AdrsBook_MGM/frmmain.pas +++ /dev/null @@ -1,276 +0,0 @@ -unit frmmain; - -{$mode objfpc}{$H+} - -interface - -uses - SysUtils, Classes, - { fpGUI Toolkit } - fpg_base, fpg_main, fpg_widget, fpg_form, fpg_button, - fpg_grid, fpg_dialogs, fpg_menu, - { tiOPF } - tiModelMediator; - -type - { The main application window } - TMainForm = class(TfpgForm) - private - {@VFD_HEAD_BEGIN: MainForm} - grdContacts: TfpgStringGrid; - btnAdd: TfpgButton; - btnEdit: TfpgButton; - btnDelete: TfpgButton; - MainMenu: TfpgMenuBar; - miFile: TfpgPopupMenu; - miEdit: TfpgPopupMenu; - miSystem: TfpgPopupMenu; - {@VFD_HEAD_END: MainForm} - FMediator: TtiModelMediator; - procedure FormShow(Sender: TObject); - procedure GridDoubleClicked(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); - procedure SetupMediators; - procedure miEditAddClick(Sender: TObject); - procedure miEditEditClick(Sender: TObject); - procedure miEditDeleteClick(Sender: TObject); - procedure miSystemCityList(Sender: TObject); - procedure miSystemCountryList(Sender: TObject); - procedure miSystemAddressTypeList(Sender: TObject); - procedure miFileExit(Sender: TObject); - public - procedure AfterCreate; override; - procedure AfterConstruction; override; - constructor Create(AOwner: TComponent); override; - end; - -{@VFD_NEWFORM_DECL} - -implementation - -uses - model, contactmanager, tiListMediators, tiBaseMediator, tiMediators, - frmcontactmaint, frmcitylist, frmcountrylist, tiDialogs, tiObject; - -{@VFD_NEWFORM_IMPL} - -procedure TMainForm.FormShow(Sender: TObject); -begin -// do nothing yet -end; - -procedure TMainForm.GridDoubleClicked(Sender: TObject; AButton: TMouseButton; - AShift: TShiftState; const AMousePos: TPoint); -begin - miEditEditClick(nil); -end; - -procedure TMainForm.SetupMediators; -begin - if not Assigned(FMediator) then - begin - FMediator := TtiModelMediator.Create(self); - FMediator.AddComposite('FirstName;LastName(130);EMail(180);Mobile(130);Comments(200)', grdContacts); - end; - FMediator.Subject := gContactManager.ContactList; - FMediator.Active := True; -end; - -procedure TMainForm.miEditAddClick(Sender: TObject); -var - c: TContact; -begin - c := TContact.CreateNew; - if EditContact(c) then - gContactManager.ContactList.Add(c) - else - c.Free; -end; - -procedure TMainForm.miEditEditClick(Sender: TObject); -var - c: TContact; -begin - if grdContacts.FocusRow < 0 then - begin - tiAppError('You need to select a Contact first'); - Exit; - end; - c := TContact(TtiStringGridMediatorView(FMediator.FindByComponent(grdContacts).Mediator).SelectedObject); - - if not Assigned(c) then - Exit; //==> - - if EditContact(c) then - begin - // we can save contact here if we wanted - end; -end; - -procedure TMainForm.miEditDeleteClick(Sender: TObject); -var - c: TContact; -begin - if grdContacts.FocusRow < 0 then - begin - tiAppError('You need to select a Contact first'); - Exit; - end; - c := TContact(TtiStringGridMediatorView(FMediator.FindByComponent(grdContacts).Mediator).SelectedObject); - - if tiAppConfirmation('Are you sure you want to delete <%s>', [c.FirstName + ' ' + c.LastName]) then - begin - { We can't use .Deleted property here, because we don't actually save - changes. This means the ObjectState will only be posDelete and not - posDeleted, which is what .FreeDeleted is looking for. } -// c.Deleted := True; - c.ObjectState := posDeleted; - gContactManager.ContactList.FreeDeleted; - end; -end; - -procedure TMainForm.miSystemCityList(Sender: TObject); -begin - ShowCities(gContactManager.CityList); -end; - -procedure TMainForm.miSystemCountryList(Sender: TObject); -begin - ShowCountries(gContactManager.CountryList); -end; - -procedure TMainForm.miSystemAddressTypeList(Sender: TObject); -begin - // ShowAddressTypeList(gContactManager.AddressTypeList); -end; - -procedure TMainForm.miFileExit(Sender: TObject); -begin - Close; -end; - -procedure TMainForm.AfterCreate; -begin - {@VFD_BODY_BEGIN: MainForm} - Name := 'MainForm'; - SetPosition(373, 273, 540, 404); - WindowTitle := 'Demo 21: Address Book Demo using MGM'; - - grdContacts := TfpgStringGrid.Create(self); - with grdContacts do - begin - Name := 'grdContacts'; - SetPosition(12, 56, 516, 336); - Anchors := [anLeft,anRight,anTop,anBottom]; - FontDesc := '#Grid'; - HeaderFontDesc := '#GridHeader'; - OnDoubleClick := @GridDoubleClicked; - end; - - btnAdd := TfpgButton.Create(self); - with btnAdd do - begin - Name := 'btnAdd'; - SetPosition(12, 28, 52, 24); - Text := 'Add'; - FontDesc := '#Label1'; - Hint := ''; - ImageName := ''; - TabOrder := 1; - OnClick := @miEditAddClick; - end; - - btnEdit := TfpgButton.Create(self); - with btnEdit do - begin - Name := 'btnEdit'; - SetPosition(68, 28, 52, 24); - Text := 'Edit'; - FontDesc := '#Label1'; - Hint := ''; - ImageName := ''; - TabOrder := 2; - OnClick := @miEditEditClick; - end; - - btnDelete := TfpgButton.Create(self); - with btnDelete do - begin - Name := 'btnDelete'; - SetPosition(124, 28, 52, 24); - Text := 'Delete'; - FontDesc := '#Label1'; - Hint := ''; - ImageName := ''; - TabOrder := 3; - OnClick := @miEditDeleteClick; - end; - - MainMenu := TfpgMenuBar.Create(self); - with MainMenu do - begin - Name := 'MainMenu'; - SetPosition(0, 0, 540, 24); - Anchors := [anLeft,anRight,anTop]; - end; - - miFile := TfpgPopupMenu.Create(self); - with miFile do - begin - Name := 'miFile'; - SetPosition(344, 136, 120, 20); - AddMenuItem('E&xit', 'Alt+F4', @miFileExit); - end; - - miEdit := TfpgPopupMenu.Create(self); - with miEdit do - begin - Name := 'miEdit'; - SetPosition(344, 156, 120, 20); - AddMenuItem('Add Contact', '', @miEditAddClick); - AddMenuItem('Edit Contact', '', @miEditEditClick); - AddMenuItem('Delete Contact', '', @miEditDeleteClick); - end; - - miSystem := TfpgPopupMenu.Create(self); - with miSystem do - begin - Name := 'miSystem'; - SetPosition(344, 176, 120, 20); - AddMenuItem('City List', '', @miSystemCityList); - AddMenuItem('Country List', '', @miSystemCountryList); - AddMenuItem('Address Type List', '', @miSystemAddressTypeList).Enabled := False; - end; - - {@VFD_BODY_END: MainForm} - - // setup main menu - MainMenu.AddMenuItem('&File', nil).SubMenu := miFile; - MainMenu.AddMenuItem('&Edit', nil).SubMenu := miEdit; - MainMenu.AddMenuItem('&System', nil).SubMenu := miSystem; -end; - -procedure TMainForm.AfterConstruction; -begin - inherited AfterConstruction; - SetupMediators; -end; - -constructor TMainForm.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - gContactManager.PopulateContacts; - OnShow := @FormShow; -end; - - -initialization - RegisterFallBackMediators; - - gMediatorManager.RegisterMediator(TtiStringGridMediatorView, TContactList); - gMediatorManager.RegisterMediator(TtiListViewMediatorView, TAddressList); - gMediatorManager.RegisterMediator(TtiStringGridMediatorView, TCityList); - gMediatorManager.RegisterMediator(TtiStringGridMediatorView, TCountryList); - gMediatorManager.RegisterMediator(TtiDynamicComboBoxMediatorView, TCity, 'Country'); - gMediatorManager.RegisterMediator(TtiDynamicComboBoxMediatorView, TAddressType, 'AddressType'); - -end. diff --git a/extras/tiopf/demos/Demo_21_AdrsBook_MGM/model.pas b/extras/tiopf/demos/Demo_21_AdrsBook_MGM/model.pas deleted file mode 100644 index 643fe7c0..00000000 --- a/extras/tiopf/demos/Demo_21_AdrsBook_MGM/model.pas +++ /dev/null @@ -1,553 +0,0 @@ -{ - The business object model -} -unit model; - -{$IFDEF FPC} - {$mode objfpc}{$H+} -{$ENDIF} - -interface - -uses - Classes, SysUtils, tiObject; - -type - - TMarkObject = class(TtiObject) - protected - procedure Mark; - end; - - - TMarkObjectList = class(TtiObjectList) - protected - procedure Mark; - end; - - - TCountry = class(TMarkObject) - private - FISO: string; - FName: string; - procedure SetISO(const AValue: string); - procedure SetName(const AValue: string); - protected - function GetCaption: string; override; - public - constructor CreateNew(const AISO: string; const AName: string); reintroduce; overload; - published - property ISO: string read FISO write SetISO; - property Name: string read FName write SetName; - end; - - - TCountryList = class(TMarkObjectList) - protected - function GetItems(i: integer): TCountry; reintroduce; - procedure SetItems(i: integer; const AValue: TCountry); reintroduce; - public - function Add(const AObject: TCountry): integer; reintroduce; - property Items[i: integer]: TCountry read GetItems write SetItems; default; - end; - - - TCity = class(TMarkObject) - private - FZIP: string; - FName: string; - FCountry: TCountry; - function GetCountryAsString: string; - procedure SetCountry(const AValue: TCountry); - procedure SetName(const AValue: string); - procedure SetZIP(const AValue: string); - protected - function GetCaption: string; override; - public - procedure AssignClassProps(ASource: TtiObject); override; - published - property Country: TCountry read FCountry write SetCountry; - property Name: string read FName write SetName; - property ZIP: string read FZIP write SetZIP; - property CountryAsString: string read GetCountryAsString; - end; - - - TCityList = class(TMarkObjectList) - protected - function GetItems(i: integer): TCity; reintroduce; - procedure SetItems(i: integer; const AValue: TCity); reintroduce; - public - function Add(const AObject: TCity): integer; reintroduce; - property Items[i: integer]: TCity read GetItems write SetItems; default; - end; - - - TAddressType = class(TMarkObject) - private - FName: string; - procedure SetName(const AValue: string); - protected - function GetCaption: string; override; - published - property Name: string read FName write SetName; - end; - - - TAddressTypeList = class(TMarkObjectList) - protected - function GetItems(i: integer): TAddressType; reintroduce; - procedure SetItems(i: integer; const AValue: TAddressType); reintroduce; - public - function Add(const AObject: TAddressType): integer; reintroduce; - property Items[i: integer]: TAddressType read GetItems write SetItems; default; - end; - - - TAddress = class(TMarkObject) - private - FAddressType: TAddressType; - FCity: TCity; - FFax: string; - FNr: integer; - FStreet: string; - FTelephone1: string; - FTelephone2: string; - function GetAddressType4GUI: string; - procedure SetAddressType(const AValue: TAddressType); - procedure SetCity(const AValue: TCity); - procedure SetFax(const AValue: string); - procedure SetNr(const AValue: integer); - procedure SetStreet(const AValue: string); - procedure SetTelephone1(const AValue: string); - procedure SetTelephone2(const AValue: string); - public - constructor Create; override; - procedure AssignClassProps(ASource: TtiObject); override; - published - property Street: string read FStreet write SetStreet; - property Nr: integer read FNr write SetNr; - property Telephone1: string read FTelephone1 write SetTelephone1; - property Telephone2: string read FTelephone2 write SetTelephone2; - property Fax: string read FFax write SetFax; - property AddressType: TAddressType read FAddressType write SetAddressType; - property AddressType4GUI: string read GetAddressType4GUI; - property City: TCity read FCity write SetCity; - end; - - - TAddressList = class(TMarkObjectList) - protected - function GetItems(i: integer): TAddress; reintroduce; - procedure SetItems(i: integer; const AValue: TAddress); reintroduce; - public - function Add(const AObject: TAddress): integer; reintroduce; - property Items[i: integer]: TAddress read GetItems write SetItems; default; - end; - - - TContact = class(TMarkObject) - private - FAddressList: TAddressList; - FComments: string; - FEmail: string; - FFirstName: string; - FLastName: string; - FMobile: string; - procedure SetComments(const AValue: string); - procedure SetEmail(const AValue: string); - procedure SetFirstName(const AValue: string); - procedure SetLastName(const AValue: string); - procedure SetMobile(const AValue: string); - public - constructor Create; override; - destructor Destroy; override; - published - property FirstName: string read FFirstName write SetFirstName; - property LastName: string read FLastName write SetLastName; - property EMail: string read FEmail write SetEmail; - property Mobile: string read FMobile write SetMobile; - property Comments: string read FComments write SetComments; - property AddressList: TAddressList read FAddressList; - end; - - - TContactList = class(TMarkObjectList) - protected - function GetItems(i: integer): TContact; reintroduce; - procedure SetItems(i: integer; const AValue: TContact); reintroduce; - public - function Add(const AObject: TContact): integer; reintroduce; - property Items[i: integer]: TContact read GetItems write SetItems; default; - end; - - - -implementation - - -{ TMarkObject } - -procedure TMarkObject.Mark; -begin - if (ObjectState <> posEmpty) then - Dirty:= True; -end; - -{ TMarkObjectList } - -procedure TMarkObjectList.Mark; -begin - if (ObjectState <> posEmpty) then - Dirty:= True; -end; - -{ TCountry } - -procedure TCountry.SetISO(const AValue: string); -begin - if FISO = AValue then - Exit; //==> - - BeginUpdate; - FISO:= AValue; - Mark; - EndUpdate; -end; - -procedure TCountry.SetName(const AValue: string); -begin - if FName = AValue then - Exit; //==> - - BeginUpdate; - FName:= AValue; - Mark; - EndUpdate; -end; - -function TCountry.GetCaption: string; -begin - Result:= Name; -end; - -constructor TCountry.CreateNew(const AISO: string; const AName: string); -begin - inherited CreateNew; - FISO:= AISO; - FName:= AName; -end; - -{ TCity } - -procedure TCity.SetCountry(const AValue: TCountry); -begin - if FCountry = AValue then - Exit; //==> - - BeginUpdate; - FCountry:= AValue; - Mark; - EndUpdate; -end; - -function TCity.GetCountryAsString: string; -begin - result:= Country.Name + ' (' + Country.ISO + ')'; -end; - -procedure TCity.SetName(const AValue: string); -begin - if FName = AValue then - Exit; //==> - - BeginUpdate; - FName:= AValue; - Mark; - EndUpdate; -end; - -procedure TCity.SetZIP(const AValue: string); -begin - if FZip = AValue then - Exit; //==> - - BeginUpdate; - FZip:= AValue; - Mark; - EndUpdate; -end; - -function TCity.GetCaption: string; -begin - Result := Name; -end; - -procedure TCity.AssignClassProps(ASource: TtiObject); -begin - FCountry:= TCity(ASource).Country; // reference only -end; - -{ TAddressType } - -procedure TAddressType.SetName(const AValue: string); -begin - if FName = AValue then - Exit; //==> - - BeginUpdate; - FName:= AValue; - Mark; - EndUpdate; -end; - -function TAddressType.GetCaption: string; -begin - Result := Name; -end; - -{ TAddress } - -procedure TAddress.SetStreet(const AValue: string); -begin - if FStreet=AValue then exit; - - BeginUpdate; - FStreet:=AValue; - Mark; - EndUpdate; -end; - -procedure TAddress.SetTelephone1(const AValue: string); -begin - if FTelephone1=AValue then exit; - - BeginUpdate; - FTelephone1:=AValue; - Mark; - EndUpdate; -end; - -procedure TAddress.SetTelephone2(const AValue: string); -begin - if FTelephone2=AValue then exit; - - BeginUpdate; - FTelephone2:=AValue; - Mark; - EndUpdate; -end; - -constructor TAddress.Create; -begin - inherited Create; - FAddressType := nil; -end; - -procedure TAddress.AssignClassProps(ASource: TtiObject); -begin - FAddressType := TAddress(ASource).AddressType; // reference only - FCity := TAddress(ASource).City; // reference only -end; - -procedure TAddress.SetNr(const AValue: integer); -begin - if FNr=AValue then exit; - - BeginUpdate; - FNr:=AValue; - Mark; - EndUpdate; -end; - -procedure TAddress.SetAddressType(const AValue: TAddressType); -begin - if FAddressType = AValue then - Exit; //==> - - BeginUpdate; - FAddressType := AValue; - Mark; - EndUpdate; -end; - -function TAddress.GetAddressType4GUI: string; -begin - Result := FAddressType.Name; -end; - -procedure TAddress.SetCity(const AValue: TCity); -begin - if FCity=AValue then exit; - - BeginUpdate; - FCity:=AValue; - Mark; - EndUpdate; -end; - -procedure TAddress.SetFax(const AValue: string); -begin - if FFax=AValue then exit; - - BeginUpdate; - FFax:=AValue; - Mark; - EndUpdate; -end; - -{ TContact } - -procedure TContact.SetFirstName(const AValue: string); -begin - if FFirstName=AValue then exit; - - BeginUpdate; - FFirstName:=AValue; - Mark; - EndUpdate; -end; - -procedure TContact.SetEmail(const AValue: string); -begin - if FEmail=AValue then exit; - - BeginUpdate; - FEmail:=AValue; - Mark; - EndUpdate; -end; - -procedure TContact.SetComments(const AValue: string); -begin - if FComments=AValue then exit; - - BeginUpdate; - FComments:=AValue; - Mark; - EndUpdate; -end; - -procedure TContact.SetLastName(const AValue: string); -begin - if FLastName=AValue then exit; - - BeginUpdate; - FLastName:=AValue; - Mark; - EndUpdate; -end; - -procedure TContact.SetMobile(const AValue: string); -begin - if FMobile=AValue then exit; - - BeginUpdate; - FMobile:=AValue; - Mark; - EndUpdate; -end; - -constructor TContact.Create; -begin - inherited Create; - FAddressList:= TAddressList.Create; - FAddressList.Owner:= self; - // ToDo: Refactor to remove need for ItemOwner. Use Parent instead - FAddressList.ItemOwner:= self; -end; - -destructor TContact.Destroy; -begin - FAddressList.Free; - inherited Destroy; -end; - -{ TCountryList } - -function TCountryList.GetItems(i: integer): TCountry; -begin - Result:= TCountry(inherited GetItems(i)); -end; - -procedure TCountryList.SetItems(i: integer; const AValue: TCountry); -begin - inherited SetItems(i, AValue); -end; - -function TCountryList.Add(const AObject: TCountry): integer; -begin - Result:= inherited Add(AObject); -end; - -{ TCityList } - -function TCityList.GetItems(i: integer): TCity; -begin - result:= TCity(inherited GetItems(i)); -end; - -procedure TCityList.SetItems(i: integer; const AValue: TCity); -begin - inherited SetItems(i, AValue); -end; - -function TCityList.Add(const AObject: TCity): integer; -begin - result:= inherited Add(AObject); -end; - -{ TAddressList } - -function TAddressList.GetItems(i: integer): TAddress; -begin - result:= TAddress(inherited GetItems(i)); -end; - -procedure TAddressList.SetItems(i: integer; const AValue: TAddress); -begin - inherited SetItems(i, AValue); -end; - -function TAddressList.Add(const AObject: TAddress): integer; -begin - result:= inherited Add(AObject); -end; - -{ TContactList } - -function TContactList.GetItems(i: integer): TContact; -begin - result:= TContact(inherited GetItems(i)); -end; - -procedure TContactList.SetItems(i: integer; const AValue: TContact); -begin - inherited SetItems(i, AValue); -end; - -function TContactList.Add(const AObject: TContact): integer; -begin - result:= inherited Add(AObject); -end; - - -{ TAddressTypeList } - -function TAddressTypeList.GetItems(i: integer): TAddressType; -begin - result := TAddressType(inherited GetItems(i)); -end; - -procedure TAddressTypeList.SetItems(i: integer; const AValue: TAddressType); -begin - inherited SetItems(i, AValue); -end; - -function TAddressTypeList.Add(const AObject: TAddressType): integer; -begin - result := inherited Add(AObject); -end; - -end. - diff --git a/extras/tiopf/demos/Demo_21_AdrsBook_MGM/units/placeholder.txt b/extras/tiopf/demos/Demo_21_AdrsBook_MGM/units/placeholder.txt deleted file mode 100644 index 4805699e..00000000 --- a/extras/tiopf/demos/Demo_21_AdrsBook_MGM/units/placeholder.txt +++ /dev/null @@ -1 +0,0 @@ -do not delete me. diff --git a/extras/tiopf/demos/Demo_TtiBaseObject/PerformanceTesting.lpi b/extras/tiopf/demos/Demo_TtiBaseObject/PerformanceTesting.lpi deleted file mode 100644 index 047ccf7a..00000000 --- a/extras/tiopf/demos/Demo_TtiBaseObject/PerformanceTesting.lpi +++ /dev/null @@ -1,59 +0,0 @@ -<?xml version="1.0"?> -<CONFIG> - <ProjectOptions> - <Version Value="7"/> - <General> - <Flags> - <SaveOnlyProjectUnits Value="True"/> - <LRSInOutputDirectory Value="False"/> - </Flags> - <SessionStorage Value="InProjectDir"/> - <MainUnit Value="0"/> - <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_toolkit"/> - </Item1> - <Item2> - <PackageName Value="tiOPF"/> - </Item2> - </RequiredPackages> - <Units Count="2"> - <Unit0> - <Filename Value="PerformanceTesting.lpr"/> - <IsPartOfProject Value="True"/> - </Unit0> - <Unit1> - <Filename Value="frm_main.pas"/> - <IsPartOfProject Value="True"/> - <UnitName Value="frm_main"/> - </Unit1> - </Units> - </ProjectOptions> - <CompilerOptions> - <Version Value="8"/> - <SearchPaths> - <UnitOutputDirectory Value="units/$(TargetCPU)-$(TargetOS)"/> - </SearchPaths> - <Other> - <CustomOptions Value="-dUseCThreads -"/> - <CompilerPath Value="$(CompPath)"/> - </Other> - </CompilerOptions> -</CONFIG> diff --git a/extras/tiopf/demos/Demo_TtiBaseObject/PerformanceTesting.lpr b/extras/tiopf/demos/Demo_TtiBaseObject/PerformanceTesting.lpr deleted file mode 100644 index e43592fd..00000000 --- a/extras/tiopf/demos/Demo_TtiBaseObject/PerformanceTesting.lpr +++ /dev/null @@ -1,31 +0,0 @@ -{ - This demo does performance testing of the TtiBaseObject to see the difference - when Reference Counting is enabled, linked in or not. -} -program PerformanceTesting; - -uses - {$IFDEF UNIX}{$IFDEF UseCThreads} - cthreads, - {$ENDIF}{$ENDIF} - Classes, fpg_main, frm_main; - - -procedure MainProc; -var - frm: TMainForm; -begin - fpgApplication.Initialize; - frm := TMainForm.Create(nil); - try - frm.Show; - fpgApplication.Run; - finally - frm.Free; - end; -end; - -begin - MainProc; -end. - diff --git a/extras/tiopf/demos/Demo_TtiBaseObject/frm_main.pas b/extras/tiopf/demos/Demo_TtiBaseObject/frm_main.pas deleted file mode 100644 index 6b39cf0d..00000000 --- a/extras/tiopf/demos/Demo_TtiBaseObject/frm_main.pas +++ /dev/null @@ -1,218 +0,0 @@ -unit frm_main; - -{$mode objfpc}{$H+} - -// You need to enable these in tiOPF's tiDefines.inc as well. -{.$Define object_tracking} -{$Define reference_counting} - - -interface - -uses - SysUtils, Classes, fpg_base, fpg_main, fpg_edit, - fpg_widget, fpg_form, fpg_label, fpg_button, - fpg_listbox, fpg_memo, fpg_combobox, fpg_grid, - fpg_dialogs, fpg_checkbox, fpg_tree, fpg_trackbar, - fpg_progressbar, fpg_radiobutton, fpg_tab, fpg_menu, - fpg_panel, fpg_popupcalendar, fpg_gauge; - -type - - TMainForm = class(TfpgForm) - private - procedure PerformanceTestNoReferenceCounting(Sender: TObject); - procedure PerformanceTestReferenceCounting(Sender: TObject); - procedure btnTestValidClick(Sender: TObject); - procedure Log(const AMessage: string); - public - {@VFD_HEAD_BEGIN: MainForm} - btnNoRefCount: TfpgButton; - btnRefCount: TfpgButton; - btnTestValid: TfpgButton; - memName1: TfpgMemo; - lblName1: TfpgLabel; - lblName2: TfpgLabel; - memLog: TfpgMemo; - {@VFD_HEAD_END: MainForm} - constructor Create(AOwner: TComponent); override; - procedure AfterCreate; override; - end; - -{@VFD_NEWFORM_DECL} - -implementation - -uses - tiUtils, - tiBaseObject; - -const - CTestRunTime = 5; // Seconds - CTestCount = 1000000; // 1 million - -{@VFD_NEWFORM_IMPL} - -procedure TMainForm.PerformanceTestNoReferenceCounting(Sender: TObject); -var - LO: TtiBaseObject; - LStart: Cardinal; - LCount: Cardinal; -begin - LCount := 0; - LStart := tiGetTickCount; - while LCount < CTestCount do - begin - LO := TtiBaseObject.Create; - LO.Free; - Inc(LCount); - end; - Log(Format('%s iterations in %d ms (no reference counting)', - [tiIntToCommaStr(LCount), tiGetTickCount - LStart])); -end; - -procedure TMainForm.PerformanceTestReferenceCounting(Sender: TObject); -{$ifdef reference_counting} -var -// LO: IInterface; - LO: TtiBaseObject; // We are testing object creation only. Hence a class and not interface reference. - LStart: Cardinal; - LCount: Cardinal; -begin - LCount := 0; - LStart := tiGetTickCount; - while LCount < CTestCount do - begin - LO := TtiBaseObject.CreateWithRefCounting; - LO.Free; // we are testing object creation. This remove the garbage collector. - Inc(LCount); - end; - Log(Format('%s iterations in %d ms (reference counting)', - [tiIntToCommaStr(LCount), tiGetTickCount - LStart])); -{$else} -begin - Assert(False, 'reference_counting not enabled'); -{$endif} -end; - -procedure TMainForm.btnTestValidClick(Sender: TObject); -var - LO: TtiBaseObject; -begin - LO := TtiBaseObject.Create; - Assert(LO.TestValid); - LO.Free; - Assert(not LO.TestValid); -end; - -procedure TMainForm.Log(const AMessage: string); -begin - memLog.Lines.Add(AMessage); - memLog.Invalidate; -end; - -constructor TMainForm.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - memLog.Lines.Clear; - {$ifdef object_tracking} - Log('object_tracking is ON'); - {$else} - btnTestValid.Enabled := False; - Log('object_tracking is OFF'); - {$endif} - {$ifdef reference_counting} - Log('reference_counting is ON'); - {$else} - Log('reference_counting is OFF'); - btnRefCount.Enabled := False; - {$endif} - Log('---'); -end; - -procedure TMainForm.AfterCreate; -begin - {@VFD_BODY_BEGIN: MainForm} - Name := 'MainForm'; - SetPosition(307, 319, 357, 290); - WindowTitle := 'TtiBaseObject Performance Demo'; - WindowPosition := wpScreenCenter; - - btnNoRefCount := TfpgButton.Create(self); - with btnNoRefCount do - begin - Name := 'btnNoRefCount'; - SetPosition(16, 28, 155, 23); - Text := 'No reference counting'; - FontDesc := '#Label1'; - ImageName := ''; - OnClick := @PerformanceTestNoReferenceCounting; - end; - - btnRefCount := TfpgButton.Create(self); - with btnRefCount do - begin - Name := 'btnRefCount'; - SetPosition(16, 56, 155, 23); - Text := 'Reference counting'; - FontDesc := '#Label1'; - ImageName := ''; - OnClick := @PerformanceTestReferenceCounting; - end; - - btnTestValid := TfpgButton.Create(self); - with btnTestValid do - begin - Name := 'btnTestValid'; - SetPosition(16, 112, 155, 23); - Text := 'TtiBaseObject.TestValid'; - FontDesc := '#Label1'; - ImageName := ''; - OnClick := @btnTestValidClick; - end; - - memName1 := TfpgMemo.Create(self); - with memName1 do - begin - Name := 'memName1'; - SetPosition(176, 28, 176, 125); - Lines.Add('Toggle the conditional defines'); - Lines.Add('REFERENCE_COUNTING '); - Lines.Add('and OBJECT_TRACKING on '); - Lines.Add('and off to examine behaviour.'); - FontDesc := '#Edit1'; - Enabled := False; - end; - - lblName1 := TfpgLabel.Create(self); - with lblName1 do - begin - Name := 'lblName1'; - SetPosition(8, 8, 160, 15); - Text := 'Performance'; - FontDesc := '#Label2'; - end; - - lblName2 := TfpgLabel.Create(self); - with lblName2 do - begin - Name := 'lblName2'; - SetPosition(8, 92, 160, 15); - Text := 'TtiBaseObject.TestValid'; - FontDesc := '#Label2'; - end; - - memLog := TfpgMemo.Create(self); - with memLog do - begin - Name := 'memLog'; - SetPosition(8, 164, 344, 121); - Lines.Add(''); - FontDesc := '#Edit1'; - end; - - {@VFD_BODY_END: MainForm} -end; - - -end. diff --git a/extras/tiopf/demos/Demo_TtiBaseObject/performancetest.lpi b/extras/tiopf/demos/Demo_TtiBaseObject/performancetest.lpi deleted file mode 100644 index cf7d5e86..00000000 --- a/extras/tiopf/demos/Demo_TtiBaseObject/performancetest.lpi +++ /dev/null @@ -1,117 +0,0 @@ -<?xml version="1.0"?> -<CONFIG> - <ProjectOptions> - <Version Value="7"/> - <General> - <Flags> - <LRSInOutputDirectory Value="False"/> - </Flags> - <MainUnit Value="0"/> - <TargetFileExt Value=""/> - <ActiveEditorIndexAtStart Value="0"/> - </General> - <VersionInfo> - <ProjectVersion Value=""/> - <Language Value=""/> - <CharSet 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> - <Units Count="9"> - <Unit0> - <Filename Value="performancetest.lpr"/> - <IsPartOfProject Value="True"/> - <UnitName Value="performancetest"/> - <CursorPos X="1" Y="13"/> - <TopLine Value="13"/> - <EditorIndex Value="0"/> - <UsageCount Value="20"/> - <Loaded Value="True"/> - </Unit0> - <Unit1> - <Filename Value="frm_main.pas"/> - <UnitName Value="frm_main"/> - <CursorPos X="37" Y="85"/> - <TopLine Value="65"/> - <EditorIndex Value="2"/> - <UsageCount Value="10"/> - <Loaded Value="True"/> - </Unit1> - <Unit2> - <Filename Value="/opt/fpc_2.2.0/src/packages/fcl-base/src/inc/custapp.pp"/> - <UnitName Value="CustApp"/> - <CursorPos X="3" Y="26"/> - <TopLine Value="11"/> - <UsageCount Value="10"/> - </Unit2> - <Unit3> - <Filename Value="../../../../../3rdParty/tiOPF2/Source/Core/tiUtils.pas"/> - <UnitName Value="tiUtils"/> - <CursorPos X="9" Y="507"/> - <TopLine Value="486"/> - <UsageCount Value="10"/> - </Unit3> - <Unit4> - <Filename Value="../../../../../3rdParty/tiOPF2/Source/Core/tiLinux.pas"/> - <UnitName Value="tiLinux"/> - <CursorPos X="1" Y="48"/> - <TopLine Value="28"/> - <UsageCount Value="10"/> - </Unit4> - <Unit5> - <Filename Value="../../../../../3rdParty/tiOPF2/Source/Core/tiBaseObject.pas"/> - <UnitName Value="tiBaseObject"/> - <CursorPos X="1" Y="128"/> - <TopLine Value="94"/> - <EditorIndex Value="1"/> - <UsageCount Value="10"/> - <Loaded Value="True"/> - </Unit5> - <Unit6> - <Filename Value="/opt/fpc_2.2.0/src/rtl/inc/objpash.inc"/> - <CursorPos X="29" Y="220"/> - <TopLine Value="212"/> - <UsageCount Value="10"/> - </Unit6> - <Unit7> - <Filename Value="/opt/fpc_2.2.0/src/rtl/inc/objpas.inc"/> - <CursorPos X="9" Y="709"/> - <TopLine Value="705"/> - <UsageCount Value="10"/> - </Unit7> - <Unit8> - <Filename Value="FMain.pas"/> - <UnitName Value="FMain"/> - <CursorPos X="1" Y="1"/> - <TopLine Value="38"/> - <UsageCount Value="10"/> - </Unit8> - </Units> - <JumpHistory Count="2" HistoryIndex="1"> - <Position1> - <Filename Value="performancetest.lpr"/> - <Caret Line="112" Column="1" TopLine="112"/> - </Position1> - <Position2> - <Filename Value="performancetest.lpr"/> - <Caret Line="249" Column="1" TopLine="220"/> - </Position2> - </JumpHistory> - </ProjectOptions> - <CompilerOptions> - <Version Value="8"/> - <Other> - <CompilerPath Value="$(CompPath)"/> - </Other> - </CompilerOptions> -</CONFIG> diff --git a/extras/tiopf/demos/Demo_TtiBaseObject/performancetest.lpr b/extras/tiopf/demos/Demo_TtiBaseObject/performancetest.lpr deleted file mode 100644 index d42615cc..00000000 --- a/extras/tiopf/demos/Demo_TtiBaseObject/performancetest.lpr +++ /dev/null @@ -1,248 +0,0 @@ -{ - This program tests the speed of Reference Counted and non-Reference Counted - objects over a set time period. Default of 5 seconds. -} -program performancetest; - -{$mode objfpc}{$H+} - -uses - Classes, SysUtils, CustApp; - -const - CTestCount = 1000000; // 1 million - -type - TMyApplication = class(TCustomApplication) - protected - procedure DoRun; override; - procedure TestRefCountedObjects; - procedure TestNonRefCountedObjects; - procedure TestRefCountedMyObjects; - procedure TestNonRefCountedMyObjects; - procedure Log(const AMessage: string); - public - constructor Create(TheOwner: TComponent); override; - destructor Destroy; override; - procedure WriteHelp; virtual; - end; - - - TMyBaseObject = class(TObject, IUnknown) - private - FRefCounting: Boolean; - FRefCount: Integer; - protected - function QueryInterface(const IID: TGUID; out Obj): longint; stdcall; - function _AddRef: longint; stdcall; - function _Release: longint; stdcall; - public - constructor Create; - destructor Destroy; override; - constructor CreateWithRefCounting; - procedure AfterConstruction; override; - procedure BeforeDestruction; override; - class function NewInstance: TObject; override; - end; - -{ TMyBaseObject } - -function TMyBaseObject.QueryInterface(const IID: TGUID; out Obj): longint; stdcall; -begin - if GetInterface(IID, Obj) then - Result := 0 - else - Result := E_NOINTERFACE; -end; - -function TMyBaseObject._AddRef: longint; stdcall; -begin - Result := InterlockedIncrement(FRefCount); -end; - -function TMyBaseObject._Release: longint; stdcall; -begin - Result := InterlockedDecrement(FRefCount); - if FRefCounting then - if Result = 0 then - Destroy; -end; - -constructor TMyBaseObject.Create; -begin - FRefCounting := False; -end; - -destructor TMyBaseObject.Destroy; -begin - inherited Destroy; -end; - -constructor TMyBaseObject.CreateWithRefCounting; -begin - Create; - FRefCounting := True; -end; - -procedure TMyBaseObject.AfterConstruction; -begin - inherited AfterConstruction; - // Release the constructor's implicit refcount - if FRefCounting then - InterlockedDecrement(FRefCount); -end; - -procedure TMyBaseObject.BeforeDestruction; -begin - if FRefCounting then - if FRefCount <> 0 then - System.Error(reInvalidPtr); - inherited BeforeDestruction; -end; - -class function TMyBaseObject.NewInstance: TObject; -begin - Result := inherited NewInstance; - TMyBaseObject(Result).FRefCount := 1; -end; - -function tiGetTickCount: Cardinal; -begin - Result := Cardinal(Trunc(Now * 24 * 60 * 60 * 1000)); -end; - - -{ TMyApplication } - -procedure TMyApplication.DoRun; -var - ErrorMsg: String; -begin - // quick check parameters - ErrorMsg := CheckOptions('h','help'); - if ErrorMsg <> '' then - begin - ShowException(Exception.Create(ErrorMsg)); - Halt; - end; - - // parse parameters - if HasOption('h','help') then - begin - WriteHelp; - Halt; - end; - -// TestNonRefCountedMyObjects; - TestNonRefCountedObjects; - TestRefCountedObjects; - TestNonRefCountedMyObjects; - TestRefCountedMyObjects; - - // stop program loop - Terminate; -end; - -procedure TMyApplication.TestRefCountedObjects; -var - LO: TInterfacedObject; - LStart: Cardinal; - LCount: Cardinal; -begin - LCount := 0; - LStart := tiGetTickCount; - while LCount < CTestCount do - begin - LO := TInterfacedObject.Create; - LO.Free; - Inc(LCount); - end; - Log(Format('%s iterations in %d ms (reference counting with TInterfacedObject)', - [IntToStr(LCount), tiGetTickCount - LStart])); -end; - -procedure TMyApplication.TestNonRefCountedObjects; -var - LO: TObject; - LStart: Cardinal; - LCount: Cardinal; -begin - LCount := 0; - LStart := tiGetTickCount; - while LCount < CTestCount do - begin - LO := TObject.Create; - LO.Free; - Inc(LCount); - end; - Log(Format('%s iterations in %d ms (no reference counting with TObject)', - [IntToStr(LCount), tiGetTickCount - LStart])); -end; - -procedure TMyApplication.TestRefCountedMyObjects; -var - LO: TMyBaseObject; - LStart: Cardinal; - LCount: Cardinal; -begin - LCount := 0; - LStart := tiGetTickCount; - while LCount < CTestCount do - begin - LO := TMyBaseObject.CreateWithRefCounting; - LO.Free; - Inc(LCount); - end; - Log(Format('%s iterations in %d ms (reference counting with MyBaseObject)', - [IntToStr(LCount), tiGetTickCount - LStart])); -end; - -procedure TMyApplication.TestNonRefCountedMyObjects; -var - LO: TMyBaseObject; - LStart: Cardinal; - LCount: Cardinal; -begin - LCount := 0; - LStart := tiGetTickCount; - while LCount < CTestCount do - begin - LO := TMyBaseObject.Create; - LO.Free; - Inc(LCount); - end; - Log(Format('%s iterations in %d ms (no reference counting with MyBaseObject)', - [IntToStr(LCount), tiGetTickCount - LStart])); -end; - -procedure TMyApplication.Log(const AMessage: string); -begin - writeln(AMessage); -end; - -constructor TMyApplication.Create(TheOwner: TComponent); -begin - inherited Create(TheOwner); - StopOnException := True; -end; - -destructor TMyApplication.Destroy; -begin - inherited Destroy; -end; - -procedure TMyApplication.WriteHelp; -begin - { add your help code here } - writeln('Usage: ',ExeName,' -h'); -end; - -var - Application: TMyApplication; -begin - Application := TMyApplication.Create(nil); - Application.Title := 'My Application'; - Application.Run; - Application.Free; -end. - diff --git a/extras/tiopf/demos/EditControlsDemo/editmediators.lpi b/extras/tiopf/demos/EditControlsDemo/editmediators.lpi deleted file mode 100644 index 0f0543c7..00000000 --- a/extras/tiopf/demos/EditControlsDemo/editmediators.lpi +++ /dev/null @@ -1,73 +0,0 @@ -<?xml version="1.0"?> -<CONFIG> - <ProjectOptions> - <Version Value="7"/> - <General> - <Flags> - <SaveOnlyProjectUnits Value="True"/> - <LRSInOutputDirectory Value="False"/> - </Flags> - <SessionStorage Value="InProjectDir"/> - <MainUnit Value="0"/> - <TargetFileExt Value=""/> - <UseAppBundle Value="False"/> - </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="1"> - <Item1> - <PackageName Value="tiOPFfpGUI"/> - <MinVersion Major="2" Release="3" Valid="True"/> - </Item1> - </RequiredPackages> - <Units Count="5"> - <Unit0> - <Filename Value="editmediators.lpr"/> - <IsPartOfProject Value="True"/> - <UnitName Value="editmediators"/> - </Unit0> - <Unit1> - <Filename Value="frmMain.pas"/> - <IsPartOfProject Value="True"/> - <UnitName Value="frmMain"/> - </Unit1> - <Unit2> - <Filename Value="../Common/Model_View.pas"/> - <IsPartOfProject Value="True"/> - <UnitName Value="Model_View"/> - </Unit2> - <Unit3> - <Filename Value="../Common/Constants.pas"/> - <IsPartOfProject Value="True"/> - <UnitName Value="Constants"/> - </Unit3> - <Unit4> - <Filename Value="../Common/Model.pas"/> - <IsPartOfProject Value="True"/> - <UnitName Value="Model"/> - </Unit4> - </Units> - </ProjectOptions> - <CompilerOptions> - <Version Value="8"/> - <SearchPaths> - <OtherUnitFiles Value="../Common/"/> - <UnitOutputDirectory Value="units/$(TargetCPU)-$(TargetOS)"/> - </SearchPaths> - <Other> - <CompilerPath Value="$(CompPath)"/> - </Other> - </CompilerOptions> -</CONFIG> diff --git a/extras/tiopf/demos/EditControlsDemo/editmediators.lpr b/extras/tiopf/demos/EditControlsDemo/editmediators.lpr deleted file mode 100644 index 0dd11cc8..00000000 --- a/extras/tiopf/demos/EditControlsDemo/editmediators.lpr +++ /dev/null @@ -1,27 +0,0 @@ -program editmediators; - -{$mode objfpc}{$H+} - -uses - {$IFDEF UNIX}{$IFDEF UseCThreads} - cthreads, - {$ENDIF}{$ENDIF} - Classes, fpg_main, frmMain; - - - -procedure MainProc; -var - frm: TMainForm; -begin - fpgApplication.Initialize; - frm := TMainForm.Create(nil); - frm.Show; - fpgApplication.Run; -end; - -begin - MainProc; -end. - - diff --git a/extras/tiopf/demos/EditControlsDemo/frmMain.pas b/extras/tiopf/demos/EditControlsDemo/frmMain.pas deleted file mode 100644 index 03749901..00000000 --- a/extras/tiopf/demos/EditControlsDemo/frmMain.pas +++ /dev/null @@ -1,237 +0,0 @@ -unit frmMain; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, fpg_form, fpg_button, fpg_label, fpg_edit, fpg_trackbar, - fpg_combobox, fpg_memo, Model, tiModelMediator, Model_View; - -type - TMainForm = class(TfpgForm) - private - btnClose: TfpgButton; - btnViaCode: TfpgButton; - btnShowModel: TfpgButton; - Label1: TfpgLabel; - Label2: TfpgLabel; - edtName: TfpgEdit; - AgeTrackBar: TfpgTrackBar; - memMemo: TfpgMemo; - cbGender: TfpgComboBox; - Label3: TfpgLabel; - - { The object we will be working with. } - FPerson: TPerson; - { Form Mediator } - FMediator: TtiModelMediator; - - procedure btnCloseClick(Sender: TObject); - procedure btnShowModelClick(Sender: TObject); - procedure btnViaCodeClick(Sender: TObject); - procedure InitializeComponents; - procedure SetupMediators; - public - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - procedure AfterConstruction; override; - end; - -implementation - -uses - fpg_dialogs - ; - -{ TMainForm } - -procedure TMainForm.btnCloseClick(Sender: TObject); -begin - Close; -end; - -procedure TMainForm.btnShowModelClick(Sender: TObject); -begin - ShowMessage(FPerson.AsDebugString); -end; - -{ The controls will automatically update as well! } -procedure TMainForm.btnViaCodeClick(Sender: TObject); -begin - FPerson.Name := 'John Doe'; - FPerson.Age := 23; - FPerson.Gender := genFemale; -end; - -procedure TMainForm.InitializeComponents; -begin - Label1 := TfpgLabel.Create(self); - with Label1 do - begin - Left := 8; - Height := 17; - Top := 16; - Width := 49; - Text := 'Name:'; - end; - - Label2 := TfpgLabel.Create(self); - with Label2 do - begin - Left := 8; - Height := 17; - Top := 48; - Width := 34; - Text := 'Age:'; - end; - - Label3 := TfpgLabel.Create(self); - with Label3 do - begin - Left := 264; - Height := 17; - Top := 16; - Width := 90; - Text := '(Read-Only)'; - end; - - btnClose := TfpgButton.Create(self); - with btnClose do - begin - Left := 416; - Height := 25; - Top := 160; - Width := 75; - Text := 'Close'; - OnClick := @btnCloseClick; - ImageName := 'stdimg.Close'; - ShowImage := True; - TabOrder := 0; - end; - - btnViaCode := TfpgButton.Create(self); - with btnViaCode do - begin - Left := 7; - Height := 25; - Top := 160; - Width := 150; - Text := 'Change via Code'; - OnClick := @btnViaCodeClick; - TabOrder := 1; - end; - - btnShowModel := TfpgButton.Create(self); - with btnShowModel do - begin - Left := 164; - Height := 25; - Top := 160; - Width := 100; - Text := 'Show Model'; - OnClick := @btnShowModelClick; - TabOrder := 2; - end; - - edtName := TfpgEdit.Create(self); - with edtName do - begin - Left := 64; - Height := 21; - Top := 16; - Width := 150; - TabOrder := 3; - end; - - AgeTrackBar := TfpgTrackBar.Create(self); - with AgeTrackBar do - begin - Left := 64; - Height := 41; - Top := 72; - Width := 150; - Max := 100; - ShowPosition := True; - TabOrder := 5; - end; - - memMemo := TfpgMemo.Create(self); - with memMemo do - begin - Left := 264; - Height := 57; - Top := 32; - Width := 185; - TabOrder := 6; - end; - - cbGender := TfpgComboBox.Create(self); - with cbGender do - begin - Left := 264; - Height := 21; - Top := 96; - TabOrder := 7; - end; -end; - -procedure TMainForm.SetupMediators; -begin -{ - FComboBoxGenderMediator := TPerson_Gender_ComboBox_Mediator.CreateCustom(cbGender, FPerson, 'GenderGUI', 'Text'); -} - if not Assigned(FMediator) then - begin - FMediator := TtiModelMediator.Create(self); - FMediator.Name := 'DemoFormMediator'; - FMediator.AddProperty('Name', edtName); - FMediator.AddProperty('Age', AgeTrackBar); - FMediator.AddProperty('Name', memMemo); - FMediator.AddProperty('GenderGUI', cbGender); - end; - FMediator.Subject := FPerson; - FMediator.Active := True; -end; - -constructor TMainForm.Create(AOwner: TComponent); -var - i: TGender; -begin - inherited Create(AOwner); - WindowTitle := 'Edit Mediators Demo'; - WindowPosition := wpUser; - SetPosition(100, 100, 500, 200); - - { The Data Object being observed } - FPerson := TPerson.Create; - FPerson.Name := 'Graeme Geldenhuys'; - FPerson.Age := 32; - - InitializeComponents; - - for i := Low(TGender) to High(TGender) do - cbGender.Items.Add(cGender[i]); -end; - -destructor TMainForm.Destroy; -begin - // TFormMediator (FMediator) get free'd automatically because it's a TComponent - FPerson.Free; - inherited Destroy; -end; - -procedure TMainForm.AfterConstruction; -begin - inherited AfterConstruction; - { The only trick here is to not let the OnChange events fire - before the mediators are not set up!! } - SetupMediators; - - // This will cause all components to update at once - FPerson.NotifyObservers; -end; - - -end. - diff --git a/extras/tiopf/demos/ListControlDemo/frmMain.pas b/extras/tiopf/demos/ListControlDemo/frmMain.pas deleted file mode 100644 index 551a6b18..00000000 --- a/extras/tiopf/demos/ListControlDemo/frmMain.pas +++ /dev/null @@ -1,255 +0,0 @@ -unit frmMain; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, fpg_form, fpg_button, fpg_label, fpg_edit, fpg_trackbar, - fpg_combobox, fpg_checkbox, fpg_listbox, Model, - tiGenericEditMediators, tiGenericListMediators; - -type - TMainForm = class(TfpgForm) - private - btnClose: TfpgButton; - btnViaCode: TfpgButton; - btnAddViaCode: TfpgButton; - btnShowModel: TfpgButton; - btnDeleted: TfpgButton; - lblName: TfpgLabel; - edtName: TfpgEdit; - lblAge: TfpgLabel; -// edtAge: TSpinEdit; - AgeTrackBar: TfpgTrackBar; - cbPeople: TfpgComboBox; - lbPeople: TfpgListBox; - lblPerson: TfpgLabel; -// gbPerson: TGroupBox; - chkShowDeleted: TfpgCheckBox; - { The object we will be working with. } - FPersonList: TPersonList; - - { Mediators } - FComboBoxMediator: TComboBoxMediator; - FListBoxMediator: TListBoxMediator; - FNameMediator: TMediatorEditView; -// FAgeMediator: TMediatorSpinEditView; - FTrackBarAgeMediator: TMediatorTrackBarView; - - procedure btnCloseClick(Sender: TObject); - procedure btnShowModelClick(Sender: TObject); - procedure btnViaCodeClick(Sender: TObject); - procedure btnDeleteClick(Sender: TObject); - procedure btnViaCodeAddClick(Sender: TObject); - procedure lbSelectionChanged(Sender: TObject); - procedure cbSelectionChanged(Sender: TObject); - procedure chkShowDeletedChange(Sender: TObject); - - procedure InitializeComponents; - procedure SetupMediators; - procedure SetupEventHandlers; - public - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - procedure AfterConstruction; override; - end; - -implementation - -uses - Model_View - ,gfxbase - ,tiObject - ,tiDialogs - ; - -{ TMainForm } - -procedure TMainForm.btnCloseClick(Sender: TObject); -begin - Close; -end; - -procedure TMainForm.btnShowModelClick(Sender: TObject); -begin - tiShowString(FPersonList.AsDebugString); -end; - -procedure TMainForm.btnViaCodeClick(Sender: TObject); -begin - { The BeginUpdate/EndUpdate will let the Item notify its observers - only once, even though two change where made. - Note: - This is for observers to the Item, not the List that the Item belongs to! } - FPersonList.Items[1].BeginUpdate; - FPersonList.Items[1].Name := 'I have changed via code'; - FPersonList.Items[1].Age := 99; - FPersonList.Items[1].EndUpdate; - { This notifies observers of the List, that something has changed. } - FPersonList.NotifyObservers; -end; - -{ This toggles the Deleted state of an object. Not really the correct way of - doing things. It is for demonstration purposes only! } -procedure TMainForm.btnDeleteClick(Sender: TObject); -begin - if FListBoxMediator.SelectedObject.Deleted then - FListBoxMediator.SelectedObject.ObjectState := posCreate - else - FListBoxMediator.SelectedObject.Deleted := True; - FPersonList.NotifyObservers; -end; - -procedure TMainForm.btnViaCodeAddClick(Sender: TObject); -var - lData: TPerson; -begin - lData := TPerson.Create; - lData.Name := 'I am new'; - lData.Age := 44; - FPersonList.Add(lData); -end; - -procedure TMainForm.lbSelectionChanged(Sender: TObject); -var - backup: TNotifyEvent; -begin - FListBoxMediator.HandleSelectionChanged; - { This is only done to keep the ComboBox and ListBox in sync. This would not - be done or needed in a real application } - backup := cbPeople.OnChange; - cbPeople.OnChange := nil; - cbPeople.FocusItem := lbPeople.FocusItem; - cbpeople.OnChange := backup; -end; - -procedure TMainForm.cbSelectionChanged(Sender: TObject); -var - backup: TNotifyEvent; -begin - FComboBoxMediator.HandleSelectionChanged; - { This is only done to keep the ComboBox and ListBox in sync. This would not - be done or needed in a real application } - backup := lbPeople.OnChange; - lbPeople.OnChange := nil; - lbPeople.FocusItem := cbPeople.FocusItem; - lbPeople.OnChange := backup; -end; - -procedure TMainForm.chkShowDeletedChange(Sender: TObject); -begin - FComboBoxMediator.ShowDeleted := chkShowDeleted.Checked; - FListBoxMediator.ShowDeleted := chkShowDeleted.Checked; -end; - -procedure TMainForm.InitializeComponents; -var - lbl: TfpgLabel; -begin - btnClose := CreateButton(self, 416, 370, 75, 'Close', @btnCloseClick); - btnClose.ImageName := 'stdimg.Close'; - btnClose.ShowImage := True; - - btnViaCode := CreateButton(self, 7, btnClose.Top, 150, 'Change via Code', @btnViaCodeClick); - btnViaCode.Hint := 'This changes a object via code, and magically the list views are updated.'; - - btnAddViaCode := CreateButton(self, 7, btnViaCode.Top - btnViaCode.Height - 5, 150, 'Add via Code', @btnViaCodeAddClick); - btnAddViaCode.Hint := 'This adds a object via code, and magically the list views are updated.'; - - btnShowModel := CreateButton(self, btnViaCode.Right + 7, btnViaCode.Top, 100, 'Show Model', @btnShowModelClick); - btnShowModel.Hint := 'Show the internal state of all objects'; - - btnDeleted := CreateButton(self, btnShowModel.Right + 7, btnClose.Top, 75, 'Delete', @btnDeleteClick); - btnDeleted.Hint := 'Toggle the Deleted state of seleted object in ListBox'; - - lblPerson := CreateLabel(self, 7, 20, 'Details of selected object in ComboBox'); - lblPerson.FontDesc := '#Label2'; - - lblName := CreateLabel(self, 25, lblPerson.Bottom + 7, 'Name:'); - edtName := CreateEdit(self, lblName.Right + 7, lblPerson.Bottom + 5, 150, 20); - edtName.Enabled := False; - - lblAge := CreateLabel(self, 25, edtName.Bottom + 7, 'Age:'); - AgeTrackBar := TfpgTrackbar.Create(self); - AgeTrackBar.Left := edtName.Left; - AgeTrackBar.Top := lblAge.Top-4; - AgeTrackBar.Width := edtName.Width; - AgeTrackBar.ShowPosition := True; - AgeTrackBar.Enabled := False; - - lbl := CreateLabel(self, edtName.Right + 30, edtName.Top, 'These components observe the selected item of ComboBox', 200, AgeTrackBar.Top-5); - lbl.TextColor := clBlue; - lbl.WrapText := True; - - lbPeople := TfpgListBox.Create(self); - lbPeople.Top := AgeTrackBar.Bottom + 17; - lbPeople.Left := 7; - lbPeople.Height := 200; - lbPeople.Width := 200; - lbPeople.Hint := 'Shows objects from the object list'; - - cbPeople := TfpgComboBox.Create(self); - cbPeople.Top := AgeTrackBar.Bottom + 17; - cbPeople.Left := lbPeople.Right + 15; - cbPeople.Width := 200; - cbPeople.Hint := 'Shows objects from the object list'; - - chkShowDeleted := CreateCheckBox(self, cbPeople.Left, lbPeople.Bottom-20, 'Show Deleted'); - -end; - -procedure TMainForm.SetupMediators; -begin - { list mediators } - FComboBoxMediator := TPersonList_ComboBox_Mediator.CreateCustom(FPersonList, cbPeople); - FListBoxMediator := TListBoxMediator.CreateCustom(FPersonList, lbPeople); - - { property/edit mediators } - FNameMediator := TPerson_Name_TextEdit_View.CreateCustom(edtName, FComboBoxMediator.SelectedObject, 'Name', 'Text'); - FTrackBarAgeMediator := TPerson_Age_TrackBar_Mediator.CreateCustom(AgeTrackBar, FComboBoxMediator.SelectedObject, 'Age', 'Position'); - - { By default we creating mediators, they are not updated automatically. This - allows us to notify all observers at once. This behaviour can be changed. } - FPersonList.NotifyObservers; -end; - -procedure TMainForm.SetupEventHandlers; -begin - lbPeople.OnChange := @lbSelectionChanged; - cbPeople.OnChange := @cbSelectionChanged; - chkShowDeleted.OnChange := @chkShowDeletedChange; -end; - -constructor TMainForm.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - WindowTitle := 'List Mediators Demo'; - WindowPosition := wpUser; - SetPosition(100, 100, 500, 400); - - InitializeComponents; - FPersonList := GeneratePersonList; - SetupEventHandlers; -end; - -destructor TMainForm.Destroy; -begin - FNameMediator.Free; - FTrackBarAgeMediator.Free; - FComboBoxMediator.Free; - FListBoxMediator.Free; - FPersonList.Free; - inherited Destroy; -end; - -procedure TMainForm.AfterConstruction; -begin - inherited AfterConstruction; - { The only trick here is to not let the OnChange events fire - before the mediators are not set up!! } - SetupMediators; -end; - -end. - diff --git a/extras/tiopf/demos/ListControlDemo/listcontroldemo.lpi b/extras/tiopf/demos/ListControlDemo/listcontroldemo.lpi deleted file mode 100644 index 6faa819b..00000000 --- a/extras/tiopf/demos/ListControlDemo/listcontroldemo.lpi +++ /dev/null @@ -1,74 +0,0 @@ -<?xml version="1.0"?> -<CONFIG> - <ProjectOptions> - <Version Value="7"/> - <General> - <Flags> - <SaveOnlyProjectUnits Value="True"/> - <LRSInOutputDirectory Value="False"/> - </Flags> - <SessionStorage Value="InProjectDir"/> - <MainUnit Value="0"/> - <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="1"> - <Item1> - <PackageName Value="tiOPFfpGUI"/> - <MinVersion Major="2" Release="3" Valid="True"/> - </Item1> - </RequiredPackages> - <Units Count="5"> - <Unit0> - <Filename Value="listcontroldemo.lpr"/> - <IsPartOfProject Value="True"/> - <UnitName Value="listcontroldemo"/> - </Unit0> - <Unit1> - <Filename Value="frmMain.pas"/> - <IsPartOfProject Value="True"/> - <UnitName Value="frmMain"/> - </Unit1> - <Unit2> - <Filename Value="../Common/Model_View.pas"/> - <IsPartOfProject Value="True"/> - <UnitName Value="Model_View"/> - </Unit2> - <Unit3> - <Filename Value="../Common/Constants.pas"/> - <IsPartOfProject Value="True"/> - <UnitName Value="Constants"/> - </Unit3> - <Unit4> - <Filename Value="../Common/Model.pas"/> - <IsPartOfProject Value="True"/> - <UnitName Value="Model"/> - </Unit4> - </Units> - </ProjectOptions> - <CompilerOptions> - <Version Value="8"/> - <SearchPaths> - <OtherUnitFiles Value="../Common/"/> - <UnitOutputDirectory Value="units/$(TargetCPU)-$(TargetOS)"/> - </SearchPaths> - <Other> - <CustomOptions Value=" -"/> - <CompilerPath Value="$(CompPath)"/> - </Other> - </CompilerOptions> -</CONFIG> diff --git a/extras/tiopf/demos/ListControlDemo/listcontroldemo.lpr b/extras/tiopf/demos/ListControlDemo/listcontroldemo.lpr deleted file mode 100644 index 6455aa9b..00000000 --- a/extras/tiopf/demos/ListControlDemo/listcontroldemo.lpr +++ /dev/null @@ -1,26 +0,0 @@ -program listcontroldemo; - -{$mode objfpc}{$H+} - -uses - {$IFDEF UNIX}{$IFDEF UseCThreads} - cthreads, - {$ENDIF}{$ENDIF} - Classes, fpg_base, fpg_main, frmMain, Model, Constants, Model_View; - - -procedure MainProc; -var - frm: TMainForm; -begin - fpgApplication.Initialize; - frm := TMainForm.Create(nil); - frm.Show; - fpgApplication.Run; -end; - -begin - MainProc; -end. - - diff --git a/extras/tiopf/demos/StringGridMediatorDemo/frm_main.pas b/extras/tiopf/demos/StringGridMediatorDemo/frm_main.pas deleted file mode 100644 index 3878ad61..00000000 --- a/extras/tiopf/demos/StringGridMediatorDemo/frm_main.pas +++ /dev/null @@ -1,288 +0,0 @@ -unit frm_main; - -{$mode objfpc}{$H+} - -interface - -uses - SysUtils, Classes, fpg_base, fpg_main, fpg_edit, - fpg_widget, fpg_form, fpg_label, fpg_button, - fpg_basegrid, fpg_grid, fpg_menu, - fpg_panel, fpg_popupcalendar, fpg_gauge, Model, tiListMediators; - -type - - TMainForm = class(TfpgForm) - private - FList: TPersonList; - medGrid: TtiStringGridMediatorView; - procedure SetupMediators; - procedure ValidateData; - procedure btnAddClicked(Sender: TObject); - procedure btnEditClicked(Sender: TObject); - procedure btnDeleteClicked(Sender: TObject); - procedure btnUpdateClicked(Sender: TObject); - procedure btnQuitClicked(Sender: TObject); - procedure btnRetrieveClicked(Sender: TObject); - public - {@VFD_HEAD_BEGIN: MainForm} - grdName1: TfpgStringGrid; - lblName1: TfpgLabel; - edtName: TfpgEdit; - lblName2: TfpgLabel; - edtAge: TfpgEdit; - btnQuit: TfpgButton; - btnUpdate: TfpgButton; - btnAdd: TfpgButton; - btnEdit: TfpgButton; - btnDelete: TfpgButton; - btnRetrieve: TfpgButton; - lblName3: TfpgLabel; - {@VFD_HEAD_END: MainForm} - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - procedure AfterCreate; override; - end; - -{@VFD_NEWFORM_DECL} - -implementation - -uses - fpg_dialogs, frm_personmaint; - -{@VFD_NEWFORM_IMPL} - -procedure TMainForm.SetupMediators; -begin - medGrid := TtiStringGridMediatorView.CreateCustom(FList, grdName1, 'Name(200);Age'); -end; - -procedure TMainForm.ValidateData; -var - i: integer; -begin - try - i := StrToInt(edtAge.Text); - if (i < 1) or (i > 100) then - begin - TfpgMessageDialog.Warning('Age out of range', 'Age must be between 1 and 100'); - Abort; - end; - except - on E: Exception do - TfpgMessageDialog.Critical('Age must be a numeric value', E.Message); - end; -end; - -procedure TMainForm.btnAddClicked(Sender: TObject); -var - lData: TPerson; -begin - lData := TPerson.CreateNew; - lData.Name := 'New Name'; - lData.Age := 12; - FList.Add(lData); -end; - -procedure TMainForm.btnEditClicked(Sender: TObject); -begin - if medGrid.SelectedObject = nil then - Exit; - EditPerson(TPerson(medGrid.SelectedObject)); -end; - -procedure TMainForm.btnDeleteClicked(Sender: TObject); -begin - medGrid.SelectedObject.Deleted := True; - FList.NotifyObservers; -end; - -procedure TMainForm.btnUpdateClicked(Sender: TObject); -var - lData: TPerson; -begin - ValidateData; - lData := medGrid.SelectedObject as TPerson; - lData.BeginUpdate; - lData.Name := edtName.Text; - lData.Age := StrToInt(edtAge.Text); - lData.EndUpdate; -end; - -procedure TMainForm.btnQuitClicked(Sender: TObject); -begin - Close; -end; - -procedure TMainForm.btnRetrieveClicked(Sender: TObject); -var - lData: TPerson; -begin - lData := medGrid.SelectedObject as TPerson; - if lData = nil then - Exit; - edtName.Text := lData.Name; - edtAge.Text := IntToStr(lData.Age); -end; - -constructor TMainForm.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - FList := GeneratePersonList; -end; - -destructor TMainForm.Destroy; -begin - medGrid.Free; - FList.Free; - inherited Destroy; -end; - -procedure TMainForm.AfterCreate; -begin - {@VFD_BODY_BEGIN: MainForm} - Name := 'MainForm'; - SetPosition(308, 203, 463, 265); - WindowTitle := 'StringGrid Mediator Demo'; - - grdName1 := TfpgStringGrid.Create(self); - with grdName1 do - begin - Name := 'grdName1'; - SetPosition(8, 28, 272, 172); - FontDesc := '#Grid'; - HeaderFontDesc := '#GridHeader'; - end; - - lblName1 := TfpgLabel.Create(self); - with lblName1 do - begin - Name := 'lblName1'; - SetPosition(332, 80, 80, 15); - FontDesc := '#Label1'; - Text := 'Name:'; - end; - - edtName := TfpgEdit.Create(self); - with edtName do - begin - Name := 'edtName'; - SetPosition(332, 96, 120, 21); - TabOrder := 2; - Text := ''; - FontDesc := '#Edit1'; - end; - - lblName2 := TfpgLabel.Create(self); - with lblName2 do - begin - Name := 'lblName2'; - SetPosition(332, 120, 80, 15); - FontDesc := '#Label1'; - Text := 'Age:'; - end; - - edtAge := TfpgEdit.Create(self); - with edtAge do - begin - Name := 'edtAge'; - SetPosition(332, 136, 52, 21); - TabOrder := 4; - Text := ''; - FontDesc := '#Edit1'; - end; - - btnQuit := TfpgButton.Create(self); - with btnQuit do - begin - Name := 'btnQuit'; - SetPosition(376, 236, 80, 23); - Anchors := [anRight,anBottom]; - Text := 'Quit'; - FontDesc := '#Label1'; - ImageName := 'stdimg.quit'; - TabOrder := 5; - OnClick := @btnQuitClicked; - end; - - btnUpdate := TfpgButton.Create(self); - with btnUpdate do - begin - Name := 'btnUpdate'; - SetPosition(356, 168, 80, 23); - Text := 'Update'; - FontDesc := '#Label1'; - ImageName := ''; - TabOrder := 6; - OnClick := @btnUpdateClicked; - end; - - btnAdd := TfpgButton.Create(self); - with btnAdd do - begin - Name := 'btnAdd'; - SetPosition(8, 4, 48, 20); - Text := 'add'; - FontDesc := '#Label1'; - ImageName := ''; - TabOrder := 7; - OnClick := @btnAddClicked; -// Enabled := False; - end; - - btnEdit := TfpgButton.Create(self); - with btnEdit do - begin - Name := 'btnEdit'; - SetPosition(60, 4, 48, 20); - Text := 'edit'; - FontDesc := '#Label1'; - ImageName := ''; - TabOrder := 8; - OnClick := @btnEditClicked; - end; - - btnDelete := TfpgButton.Create(self); - with btnDelete do - begin - Name := 'btnDelete'; - SetPosition(112, 4, 48, 20); - Text := 'delete'; - FontDesc := '#Label1'; - ImageName := ''; - TabOrder := 9; - OnClick := @btnDeleteClicked; -// Enabled := False; - end; - - btnRetrieve := TfpgButton.Create(self); - with btnRetrieve do - begin - Name := 'btnRetrieve'; - SetPosition(288, 84, 28, 23); - Text := '>>'; - FontDesc := '#Label1'; - ImageName := ''; - TabOrder := 10; - OnClick := @btnRetrieveClicked; - end; - - lblName3 := TfpgLabel.Create(self); - with lblName3 do - begin - Name := 'lblName3'; - SetPosition(288, 0, 167, 70); - Anchors := [anLeft,anRight,anTop]; - FontDesc := '#Label1'; - Text := 'The controls below allow you to manually update the selected object. No mediators are used.'; - WrapText := True; - end; - - {@VFD_BODY_END: MainForm} - - SetupMediators; -end; - - -end. diff --git a/extras/tiopf/demos/StringGridMediatorDemo/frm_personmaint.pas b/extras/tiopf/demos/StringGridMediatorDemo/frm_personmaint.pas deleted file mode 100644 index 96620e92..00000000 --- a/extras/tiopf/demos/StringGridMediatorDemo/frm_personmaint.pas +++ /dev/null @@ -1,191 +0,0 @@ -unit frm_personmaint; - -{$mode objfpc}{$H+} - -interface - -uses - SysUtils, Classes, fpg_base, fpg_main, fpg_edit, - fpg_form, fpg_label, fpg_button, - model, model_view; - -type - - TPersonMaintForm = class(TfpgForm) - private - FData: TPerson; - FMemento: TPersonMemento; // This form is the Caretaker - FmedName: TPerson_Name_TextEdit_View; - FmedAge: TPerson_Age_TextEdit_View; - procedure FormShow(Sender: TObject); - procedure SetData(const AValue: TPerson); - procedure SetupMediators; - public - {@VFD_HEAD_BEGIN: PersonMaintForm} - lblName1: TfpgLabel; - edtName: TfpgEdit; - lblName2: TfpgLabel; - edtAge: TfpgEdit; - btnOK: TfpgButton; - btnCancel: TfpgButton; - lblName3: TfpgLabel; - {@VFD_HEAD_END: PersonMaintForm} - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - procedure AfterCreate; override; - property Data: TPerson read FData write SetData; - end; - - -procedure EditPerson(const AData: TPerson); - -{@VFD_NEWFORM_DECL} - -implementation - -procedure EditPerson(const AData: TPerson); -var - frm: TPersonMaintForm; -begin - frm := TPersonMaintForm.Create(nil); - try - frm.Data := AData; - if frm.ShowModal = 2 then // Cancel clicked - begin - // undo changes - AData.BeginUpdate; - AData.Memento := frm.FMemento; - AData.EndUpdate; - end; - finally - frm.Free; - end; -end; - -{@VFD_NEWFORM_IMPL} - -procedure TPersonMaintForm.FormShow(Sender: TObject); -begin - SetupMediators; -end; - -procedure TPersonMaintForm.SetData(const AValue: TPerson); -begin - if FData = AValue then - exit; //==>> - FData := AValue; - FreeAndNil(FMemento); - FMemento := FData.Memento; -end; - -procedure TPersonMaintForm.SetupMediators; -begin - FmedName := TPerson_Name_TextEdit_View.CreateCustom(edtName, FData, 'Name', 'Text'); - FmedAge := TPerson_Age_TextEdit_View.CreateCustom(edtAge, FData, 'Age', 'Text'); -// edtName.Text := FData.Name; -// edtAge.Text := IntToStr(FData.Age); - - // Notify all observers to update themselves. - FData.NotifyObservers; -end; - -constructor TPersonMaintForm.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - OnShow := @FormShow; -end; - -destructor TPersonMaintForm.Destroy; -begin - FmedName.Free; - FmedAge.Free; - inherited Destroy; -end; - -procedure TPersonMaintForm.AfterCreate; -begin - {@VFD_BODY_BEGIN: PersonMaintForm} - Name := 'PersonMaintForm'; - SetPosition(418, 244, 232, 190); - WindowTitle := 'Edit Person...'; - - lblName1 := TfpgLabel.Create(self); - with lblName1 do - begin - Name := 'lblName1'; - SetPosition(8, 8, 212, 15); - FontDesc := '#Label1'; - Text := 'Name:'; - end; - - edtName := TfpgEdit.Create(self); - with edtName do - begin - Name := 'edtName'; - SetPosition(8, 24, 212, 21); - TabOrder := 1; - Text := ''; - FontDesc := '#Edit1'; - end; - - lblName2 := TfpgLabel.Create(self); - with lblName2 do - begin - Name := 'lblName2'; - SetPosition(8, 56, 212, 15); - FontDesc := '#Label1'; - Text := 'Age:'; - end; - - edtAge := TfpgEdit.Create(self); - with edtAge do - begin - Name := 'edtAge'; - SetPosition(8, 72, 64, 21); - TabOrder := 3; - Text := ''; - FontDesc := '#Edit1'; - end; - - btnOK := TfpgButton.Create(self); - with btnOK do - begin - Name := 'btnOK'; - SetPosition(56, 159, 80, 23); - Anchors := [anRight,anBottom]; - Text := 'OK'; - FontDesc := '#Label1'; - ImageName := ''; - ModalResult := 1; - TabOrder := 4; - end; - - btnCancel := TfpgButton.Create(self); - with btnCancel do - begin - Name := 'btnCancel'; - SetPosition(140, 159, 80, 23); - Anchors := [anRight,anBottom]; - Text := 'Cancel'; - FontDesc := '#Label1'; - ImageName := ''; - ModalResult := 2; - TabOrder := 5; - end; - - lblName3 := TfpgLabel.Create(self); - with lblName3 do - begin - Name := 'lblName3'; - SetPosition(8, 108, 212, 39); - Anchors := [anLeft,anRight,anTop,anBottom]; - FontDesc := '#Label1'; - Text := 'Notice as you change the values they are updated in the MainForm''s Grid.'; - WrapText := True; - end; - - {@VFD_BODY_END: PersonMaintForm} -end; - - -end. diff --git a/extras/tiopf/demos/StringGridMediatorDemo/stringgridmediatordemo.lpi b/extras/tiopf/demos/StringGridMediatorDemo/stringgridmediatordemo.lpi deleted file mode 100644 index b18e4bf3..00000000 --- a/extras/tiopf/demos/StringGridMediatorDemo/stringgridmediatordemo.lpi +++ /dev/null @@ -1,84 +0,0 @@ -<?xml version="1.0"?> -<CONFIG> - <ProjectOptions> - <Version Value="7"/> - <General> - <Flags> - <SaveOnlyProjectUnits Value="True"/> - <LRSInOutputDirectory 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="1"> - <Item1> - <PackageName Value="tiOPFfpGUI"/> - </Item1> - </RequiredPackages> - <Units Count="6"> - <Unit0> - <Filename Value="stringgridmediatordemo.lpr"/> - <IsPartOfProject Value="True"/> - <UnitName Value="stringgridmediatordemo"/> - </Unit0> - <Unit1> - <Filename Value="frm_main.pas"/> - <IsPartOfProject Value="True"/> - <UnitName Value="frm_main"/> - </Unit1> - <Unit2> - <Filename Value="../Common/Model.pas"/> - <IsPartOfProject Value="True"/> - <UnitName Value="Model"/> - </Unit2> - <Unit3> - <Filename Value="../Common/Constants.pas"/> - <IsPartOfProject Value="True"/> - <UnitName Value="Constants"/> - </Unit3> - <Unit4> - <Filename Value="../Common/Model_View.pas"/> - <IsPartOfProject Value="True"/> - <UnitName Value="Model_View"/> - </Unit4> - <Unit5> - <Filename Value="frm_personmaint.pas"/> - <IsPartOfProject Value="True"/> - <UnitName Value="frm_personmaint"/> - </Unit5> - </Units> - </ProjectOptions> - <CompilerOptions> - <Version Value="8"/> - <SearchPaths> - <OtherUnitFiles Value="../Common/"/> - <UnitOutputDirectory Value="units/$(TargetCPU)-$(TargetOS)"/> - </SearchPaths> - <Linking> - <Debugging> - <GenerateDebugInfo Value="True"/> - </Debugging> - </Linking> - <Other> - <CustomOptions Value=" -"/> - <CompilerPath Value="$(CompPath)"/> - </Other> - </CompilerOptions> -</CONFIG> diff --git a/extras/tiopf/demos/StringGridMediatorDemo/stringgridmediatordemo.lpr b/extras/tiopf/demos/StringGridMediatorDemo/stringgridmediatordemo.lpr deleted file mode 100644 index 366718b0..00000000 --- a/extras/tiopf/demos/StringGridMediatorDemo/stringgridmediatordemo.lpr +++ /dev/null @@ -1,30 +0,0 @@ -program stringgridmediatordemo; - -{$mode objfpc}{$H+} - -uses - {$IFDEF UNIX}{$IFDEF UseCThreads} - cthreads, - {$ENDIF}{$ENDIF} - Classes, fpg_main, frm_main, Model, Constants, tiOPFfpGUI, frm_personmaint, - Model_View; - - -procedure MainProc; -var - frm: TMainForm; -begin - fpgApplication.Initialize; - frm := TMainForm.Create(nil); - try - frm.Show; - fpgApplication.Run; - finally - frm.Free; - end; -end; - -begin - MainProc; -end. - diff --git a/extras/tiopf/demos/readme.txt b/extras/tiopf/demos/readme.txt deleted file mode 100644 index 4961aa2c..00000000 --- a/extras/tiopf/demos/readme.txt +++ /dev/null @@ -1,29 +0,0 @@ - - Model-GUI-Mediator (MGM) pattern implementation by Graeme Geldenhuys. - --------------------------------------------------------------------- - -This allows standard controls or any other GUI controls for that matter to become -object-aware. The benefits are much greater ease in cross platform development, -or if you would like to make your favorite set of GUI controls object-aware. - -Please note this is work in progress... -So far I have implemented most used basic edit controls: - TfpgEdit - TfpgSpinEdit (dependend on fpGUI component) - TfpgLabel - TfpgComboBox (single and list property) - TfpgTrackBar - TfpgMemo - TfpgListView (includes popup menu) - TfpgListBox (includes popup menu) - -Currently I am considering implementing the container classes like TfpgTreeView. -They are quite complex and there are multiple ways of implementing them. - -For more information on the MGM pattern, visit Andy Bulka's website. - http://www.atug.com/andypatterns/mgm.htm - - - ----oO0Oo---- - - diff --git a/extras/tiopf/demos/rtf_reporting/demo.rtf b/extras/tiopf/demos/rtf_reporting/demo.rtf deleted file mode 100644 index 637733dd..00000000 --- a/extras/tiopf/demos/rtf_reporting/demo.rtf +++ /dev/null @@ -1,93 +0,0 @@ -{\rtf1\ansi\deff1\adeflang1025 -{\fonttbl{\f0\froman\fprq2\fcharset0 Times New Roman;}{\f1\fnil\fprq0\fcharset0 Times{\*\falt Times New Roman};}{\f2\fnil\fprq0\fcharset0 Times{\*\falt Times New Roman};}{\f3\fswiss\fprq2\fcharset0 DejaVuSans;}{\f4\fnil\fprq0\fcharset0 Times{\*\falt Times New Roman};}{\f5\fswiss\fprq0\fcharset0 Helvetica;}{\f6\fnil\fprq2\fcharset0 AR PL ShanHeiSun Uni;}{\f7\fnil\fprq0\fcharset0 Tahoma;}{\f8\fswiss\fprq0\fcharset0 Tahoma;}} -{\colortbl;\red0\green0\blue0;\red0\green0\blue128;\red255\green0\blue0;\red153\green153\blue153;\red230\green230\blue230;\red128\green128\blue128;} -{\stylesheet{\s1\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057\snext1 Normal;} -{\s2\sb240\sa120\keepn\rtlch\af5\afs28\lang255\ltrch\dbch\af6\langfe255\hich\f5\fs28\lang2057\loch\f5\fs28\lang2057\sbasedon1\snext3 Heading;} -{\s3\sa120\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057\sbasedon1\snext3 Body Text;} -{\s4\sa120\rtlch\af8\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057\sbasedon3\snext4 List;} -{\s5\sb120\sa120\rtlch\af7\afs24\lang255\ai\ltrch\dbch\af3\langfe255\hich\f2\fs24\lang2057\i\loch\f2\fs24\lang2057\i\sbasedon1\snext5 caption;} -{\s6\rtlch\af8\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057\sbasedon1\snext6 Index;} -{\s7\sb120\sa120\rtlch\af8\afs24\lang255\ai\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\i\loch\fs24\lang2057\i\sbasedon1\snext7 caption;} -{\s8\sb240\sa120\keepn\rtlch\af5\afs21\lang255\ab\ltrch\dbch\af6\langfe255\hich\f5\fs21\lang2057\b\loch\f5\fs21\lang2057\b\sbasedon2\snext3{\*\soutlvl8} heading 9;} -{\s9\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057\sbasedon1\snext9 Table Contents;} -{\s10\qc\rtlch\afs24\lang255\ab\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\b\loch\fs24\lang2057\b\sbasedon9\snext10 Table Heading;} -{\*\cs12\cf0\rtlch\af1\afs24\lang255\ltrch\dbch\af1\langfe255\hich\f1\fs24\lang2057\loch\f1\fs24\lang2057 RTF_Num 2 1;} -{\*\cs13\cf0\rtlch\af1\afs24\lang255\ltrch\dbch\af1\langfe255\hich\f1\fs24\lang2057\loch\f1\fs24\lang2057 RTF_Num 2 2;} -{\*\cs14\cf0\rtlch\af1\afs24\lang255\ltrch\dbch\af1\langfe255\hich\f1\fs24\lang2057\loch\f1\fs24\lang2057 RTF_Num 2 3;} -{\*\cs15\cf0\rtlch\af1\afs24\lang255\ltrch\dbch\af1\langfe255\hich\f1\fs24\lang2057\loch\f1\fs24\lang2057 RTF_Num 2 4;} -{\*\cs16\cf0\rtlch\af1\afs24\lang255\ltrch\dbch\af1\langfe255\hich\f1\fs24\lang2057\loch\f1\fs24\lang2057 RTF_Num 2 5;} -{\*\cs17\cf0\rtlch\af1\afs24\lang255\ltrch\dbch\af1\langfe255\hich\f1\fs24\lang2057\loch\f1\fs24\lang2057 RTF_Num 2 6;} -{\*\cs18\cf0\rtlch\af1\afs24\lang255\ltrch\dbch\af1\langfe255\hich\f1\fs24\lang2057\loch\f1\fs24\lang2057 RTF_Num 2 7;} -{\*\cs19\cf0\rtlch\af1\afs24\lang255\ltrch\dbch\af1\langfe255\hich\f1\fs24\lang2057\loch\f1\fs24\lang2057 RTF_Num 2 8;} -{\*\cs20\cf0\rtlch\af1\afs24\lang255\ltrch\dbch\af1\langfe255\hich\f1\fs24\lang2057\loch\f1\fs24\lang2057 RTF_Num 2 9;} -{\*\cs21\cf0\rtlch\af1\afs24\lang255\ltrch\dbch\af1\langfe255\hich\f1\fs24\lang2057\loch\f1\fs24\lang2057 RTF_Num 2 10;} -{\*\cs22\cf2\ul\ulc0\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 Internet link;} -{\*\cs23\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 Numbering Symbols;} -}{\*\listtable{\list\listtemplateid1 -{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'02\'00.;}{\levelnumbers\'01;}\fi-360\li720} -{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'02\'01.;}{\levelnumbers\'01;}\fi-360\li1080} -{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'02\'02.;}{\levelnumbers\'01;}\fi-360\li1440} -{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'02\'03.;}{\levelnumbers\'01;}\fi-360\li1800} -{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'02\'04.;}{\levelnumbers\'01;}\fi-360\li2160} -{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'02\'05.;}{\levelnumbers\'01;}\fi-360\li2520} -{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'02\'06.;}{\levelnumbers\'01;}\fi-360\li2880} -{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'02\'07.;}{\levelnumbers\'01;}\fi-360\li3240} -{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'02\'08.;}{\levelnumbers\'01;}\fi-360\li3600} -{\*\soutlvl{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'02\'09.;}{\levelnumbers\'01;}\fi-360\li3960}}{\listname RTF_Num 2;}\listid1} -}{\listoverridetable{\listoverride\listid1\listoverridecount0\ls0}} - -{\info{\creatim\yr0\mo0\dy0\hr0\min0}{\revtim\yr0\mo0\dy0\hr0\min0}{\printim\yr0\mo0\dy0\hr0\min0}{\comment StarWriter}{\vern6800}}\deftab709 -{\*\pgdsctbl -{\pgdsc0\pgdscuse195\pgwsxn11905\pghsxn16837\marglsxn1134\margrsxn1134\margtsxn1134\margbsxn1134\pgdscnxt0 Standard;}} -{\*\pgdscno0}\paperh16837\paperw11905\margl1134\margr1134\margt1134\margb1134\sectd\sbknone\pgwsxn11905\pghsxn16837\marglsxn1134\margrsxn1134\margtsxn1134\margbsxn1134\ftnbj\ftnstart1\ftnrstcont\ftnnar\aenddoc\aftnrstcont\aftnstart1\aftnnrlc -\pard\plain \ltrpar\s1\ql\rtlch\afs32\lang255\ltrch\dbch\af3\langfe255\hich\fs32\lang2057\loch\fs32\lang2057 {\rtlch \ltrch\loch\f1\fs32\lang2057\i0\b0 Simple demo of tiRtfReport} -\par \pard\plain \ltrpar\s1\ql\rtlch\afs20\lang255\ab\ltrch\dbch\af3\langfe255\hich\fs20\lang2057\b\loch\fs20\lang2057\b -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs20\lang2057\b\loch\fs20\lang2057\b {\rtlch \ltrch\loch\f1\fs20\lang2057\i0\b This shows embedded \\Date\\ \\Time\\ (date & time) value. \line Date \\Date\\ in decoded format: Y=\\SYear(Date)\\ M=\\Month(Date)\\ D=\\Day(Date)\\} -\par \pard\plain \ltrpar\s1\ql\rtlch\afs20\lang255\ltrch\dbch\af3\langfe255\hich\fs20\lang2057\loch\fs20\lang2057 {\rtlch \ltrch\loch\f1\fs20\lang2057\i0\b0 If you view the report design you will notice that function parameters do not need to be escaped with the backslash symbol.} -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ab\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\b\loch\fs24\lang2057\b {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b Accessing the tiOPF framework objects} -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 \\@count:=0\\\\scan(demoitems)\\} -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat4\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat4\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat4\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\clcbpat4\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Id} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Name} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Data.Id} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Data.Name} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 \\scanentry\\\\@count:=@count+1\\} -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx1264\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx4815\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\clcbpat5\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 \\DemoItems.Id\\} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 \\demoitems.Name\\} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 \\demoitems.oData.Id\\} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 \\demoitems.oData.Name\\} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 \\if(RecordCount(demoitems.oList)>0)\\\\scan(demoitems.oList)\\} -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 \\demoitems.oList.Id\\} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 \\demoitems.oList.Name\\} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 \\endscan\\\\endif\\\\endscan\\} -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Total of \\@count\\ records in the demoitems list.} -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ab\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\b\loch\fs24\lang2057\b {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b Custom function} -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is the result of the extra defined function: \\bla\\} -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 If you mistype a field name you get something like this: \\First(DemoItems)\\\\DemoItems.Hahaha\\. This is extremely useful for detecting and solving errors in your RTF reports.} -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ab\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\b\loch\fs24\lang2057\b {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b Report Design} -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Sometimes it is necessary to make report fields hidden so that it fixes report formatting issues. To view all the Report Fields you need to tell OpenOffice to show hidden text.} -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Follow these steps to view hidden text:} -\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\f3 1.\tab}\ilvl0 \ltrpar\s1\ls0\li720\ri0\lin720\rin0\fi-360\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Enable nonprinting characters: View | Nonprinting Characters} -\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\f3 2.\tab}\ilvl0 \ltrpar\s1\ls0\li720\ri0\lin720\rin0\fi-360\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 If you don't see all the fields yet (eg: between the table header and table details lines) you need to enable the show hidden text option in: Tools | Options | OpenOffice.org Writer | Formatting Aids. Then tick the "Hidden text" option in the "Display of" - section.} -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\par \pard\plain \ltrpar\s1\cf3\qc\rtlch\afs24\lang255\ab\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\b\loch\fs24\lang2057\b {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b The End!} -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\par }
\ No newline at end of file diff --git a/extras/tiopf/demos/rtf_reporting/demoproject.lpi b/extras/tiopf/demos/rtf_reporting/demoproject.lpi deleted file mode 100644 index dd154d16..00000000 --- a/extras/tiopf/demos/rtf_reporting/demoproject.lpi +++ /dev/null @@ -1,56 +0,0 @@ -<?xml version="1.0"?> -<CONFIG> - <ProjectOptions> - <Version Value="7"/> - <General> - <Flags> - <SaveOnlyProjectUnits Value="True"/> - <LRSInOutputDirectory 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="1"> - <Item1> - <PackageName Value="tiOPFfpGUI"/> - </Item1> - </RequiredPackages> - <Units Count="2"> - <Unit0> - <Filename Value="demoproject.lpr"/> - <IsPartOfProject Value="True"/> - <UnitName Value="demoproject"/> - </Unit0> - <Unit1> - <Filename Value="frmMain.pas"/> - <IsPartOfProject Value="True"/> - <UnitName Value="frmMain"/> - </Unit1> - </Units> - </ProjectOptions> - <CompilerOptions> - <Version Value="8"/> - <SearchPaths> - <UnitOutputDirectory Value="units/$(TargetCPU)-$(TargetOS)"/> - </SearchPaths> - <Other> - <CompilerPath Value="$(CompPath)"/> - </Other> - </CompilerOptions> -</CONFIG> diff --git a/extras/tiopf/demos/rtf_reporting/demoproject.lpr b/extras/tiopf/demos/rtf_reporting/demoproject.lpr deleted file mode 100644 index e8ab8521..00000000 --- a/extras/tiopf/demos/rtf_reporting/demoproject.lpr +++ /dev/null @@ -1,30 +0,0 @@ -program demoproject; - -{$mode objfpc}{$H+} - -uses - {$IFDEF UNIX}{$IFDEF UseCThreads} - cthreads, - {$ENDIF}{$ENDIF} - Classes, fpg_main, frmMain; - - -procedure MainProc; -var - frm: TMainForm; -begin - fpgApplication.Initialize; - frm := TMainForm.Create(nil); - try - frm.Show; - fpgApplication.Run; - finally - frm.Free; - end; -end; - -begin - MainProc; -end. - - diff --git a/extras/tiopf/demos/rtf_reporting/frmMain.pas b/extras/tiopf/demos/rtf_reporting/frmMain.pas deleted file mode 100644 index 2cbe8593..00000000 --- a/extras/tiopf/demos/rtf_reporting/frmMain.pas +++ /dev/null @@ -1,313 +0,0 @@ -unit frmMain; - -{$mode objfpc}{$H+} - {$ASMMODE intel} - -interface - -uses - SysUtils, Classes, fpg_base, fpg_main, - fpg_form, fpg_label, fpg_button, - tiRtfReport; - -type - - //Add extra functions in your rtfreport - TRtfPrivateParser = class(TtiRtfParser) - protected - procedure AddFunctions; override; - procedure UdfBla(AArgument: TRtfArgument); - procedure UdfCentreAddress(AArgument: TRtfArgument); - end; - - - TMainForm = class(TfpgForm) - private - ResultFile: string; - TemplateFile: string; - procedure btnEditClicked(Sender: TObject); - procedure btnParseClicked(Sender: TObject); - procedure btnShowClicked(Sender: TObject); - public - {@VFD_HEAD_BEGIN: MainForm} - Label1: TfpgLabel; - btnParse: TfpgButton; - btnEdit: TfpgButton; - btnShow: TfpgButton; - {@VFD_HEAD_END: MainForm} - constructor Create(AOwner: TComponent); override; - procedure AfterCreate; override; - end; - -{@VFD_NEWFORM_DECL} - - -implementation - -uses - tiObject, process; - - -type - // Simple BOM structure, nothing fancy - TtiNestedDemoItem = class(TtiObject) - private - FId: integer; - FName: string; - published - property Id: integer read FId write FId; - property Name: string read FName write FName; - end; - - - TtiNestedDemoItems = class(TtiObjectList) - protected - function GetItems(Idx: integer): TtiNestedDemoItem; reintroduce; - public - property Items[Idx: integer]: TtiNestedDemoItem read GetItems; - end; - - - TtiDemoItem = class(TtiObject) - private - FId: integer; - FName: string; - FData: TtiNestedDemoItem; - FList: TtiNestedDemoItems; - public - constructor Create; override; - destructor Destroy; override; - published - property Id: integer read FId write FId; - property Name: string read FName write FName; - property oData: TtiNestedDemoItem read FData; - property oList: TtiNestedDemoItems read FList; - end; - - - TtiDemoItems = class(TtiObjectList) - protected - function GetItems(Idx: integer): TtiDemoItem; reintroduce; - public - procedure Populate; - property Items[Idx: integer]: TtiDemoItem read GetItems; - end; - - -{ TtiNestedDemoItems } - -function TtiNestedDemoItems.GetItems(Idx: integer): TtiNestedDemoItem; -begin - Result := TtiNestedDemoItem(inherited GetItems(Idx)); -end; - - -{ TtiDemoItem } - -constructor TtiDemoItem.Create; -begin - inherited; - FData := TtiNestedDemoItem.Create; - FList := TtiNestedDemoItems.Create; -end; - -destructor TtiDemoItem.Destroy; -begin - FData.Free; - FList.Free; - inherited; -end; - - -{ TtiDemoItems } - -function TtiDemoItems.GetItems(Idx: integer): TtiDemoItem; -begin - Result := TtiDemoItem(inherited GetItems(Idx)); -end; - -procedure TtiDemoItems.Populate; -var - i, j: integer; - ADemoItem: TtiDemoItem; - ANestedDemoItem: TtiNestedDemoItem; -begin - for i := 1 to 20 do begin - ADemoItem := TtiDemoItem.Create; - ADemoItem.Id := i; - ADemoItem.Name := Format('This is demo item %d',[i]); - ADemoItem.oData.Id := i * 1000; - ADemoItem.oData.Name := Format('This is demo data item %d',[i * 1000]); - Add(ADemoItem); - - for j := 1 to Random(5) do begin - ANestedDemoItem := TtiNestedDemoItem.Create; - ANestedDemoItem.Id := j; - ANestedDemoItem.Name := Format('This is nested demo item %d',[j]); - ADemoItem.oList.Add(ANestedDemoItem); - end; - end; -end; - - -{@VFD_NEWFORM_IMPL} - -procedure TMainForm.btnEditClicked(Sender: TObject); -var - p: TProcess; -begin - p := TProcess.Create(nil); - try - p.CommandLine := 'xdg-open ' + TemplateFile; - p.Execute; - finally - p.Free; - end; -end; - -procedure TMainForm.btnParseClicked(Sender: TObject); -var - AStart: TDateTime; - FParser: TRtfPrivateParser; - ADemoItems: TtiDemoItems; -begin - ADemoItems := TtiDemoItems.Create; - try - ADemoItems.Populate; - - try - AStart := Now; - - Label1.Text := 'working'; - btnShow.Enabled := false; - btnParse.Enabled := false; - MouseCursor := mcHourGlass; - FParser := TRtfPrivateParser.Create; - try -// FParser.OnPictureAttr := OnPictureAttr; -// FParser.OnCreateDataset := OnCreateDataset; - FParser.Datasets.Add(ADemoItems, 'DemoItems'); -// FParser.Datasets.Add(tbBioLife, 'BioLife'); - FParser.LoadFromFile(TemplateFile); - FParser.Execute; - FParser.SaveToFile(ResultFile); - finally - FParser.Free; - MouseCursor := mcDefault; - btnShow.Enabled := true; - btnParse.Enabled := true; - end; - - Label1.Text := Format('Session completed in %s',[FormatDateTime('hh:nn:ss:zzz', Now - AStart)]); - btnShow.Click; - except - on E: Exception do begin - fpgApplication.HandleException(E); - end; - end; - - finally - ADemoItems.Free; - end; -end; - -procedure TMainForm.btnShowClicked(Sender: TObject); -var - p: TProcess; -begin - p := TProcess.Create(nil); - try - p.CommandLine := 'xdg-open ' + ResultFile; - p.Execute; - finally - p.Free; - end; -end; - -constructor TMainForm.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - TemplateFile := 'demo.rtf'; -// TemplateFile := 'demo_ms.rtf'; - ResultFile := 'result.rtf'; - ShortDateFormat := 'yyyy-mm-dd'; -end; - -procedure TMainForm.AfterCreate; -begin - {@VFD_BODY_BEGIN: MainForm} - Name := 'MainForm'; - SetPosition(333, 208, 300, 124); - WindowTitle := 'RTF Reporting Demo'; - - Label1 := TfpgLabel.Create(self); - with Label1 do - begin - Name := 'Label1'; - SetPosition(20, 16, 244, 16); - FontDesc := '#Label1'; - Text := '--'; - end; - - btnParse := TfpgButton.Create(self); - with btnParse do - begin - Name := 'btnParse'; - SetPosition(28, 80, 75, 24); - Text := 'Parse'; - FontDesc := '#Label1'; - ImageName := ''; - TabOrder := 1; - OnClick := @btnParseClicked; - end; - - btnEdit := TfpgButton.Create(self); - with btnEdit do - begin - Name := 'btnEdit'; - SetPosition(112, 80, 75, 24); - Text := 'Edit'; - FontDesc := '#Label1'; - ImageName := ''; - TabOrder := 2; - OnClick := @btnEditClicked; - end; - - btnShow := TfpgButton.Create(self); - with btnShow do - begin - Name := 'btnShow'; - SetPosition(196, 80, 75, 24); - Text := 'Show'; - FontDesc := '#Label1'; - ImageName := ''; - TabOrder := 3; - OnClick := @btnShowClicked; - end; - - {@VFD_BODY_END: MainForm} -end; - - -{ TRtfPrivateParser } - -procedure TRtfPrivateParser.AddFunctions; -begin - inherited AddFunctions; - Functions.Add(etFunction, 'Bla', 0, 0, @UdfBla); - Functions.Add(etFunction, 'CentreAddress', 0, 0, @UdfCentreAddress); -end; - -procedure TRtfPrivateParser.UdfBla(AArgument: TRtfArgument); -begin - AArgument.Token := etLitString; - AArgument.Value := 'Best value is 1.5e+400'; -end; - -procedure TRtfPrivateParser.UdfCentreAddress(AArgument: TRtfArgument); -begin - AArgument.Token := etLitString; - AArgument.Value := '8 Stellendal Road, Somerset West, 7130'; -end; - -end. diff --git a/extras/tiopf/demos/rtf_reporting/result.pdf b/extras/tiopf/demos/rtf_reporting/result.pdf Binary files differdeleted file mode 100644 index 67e95d42..00000000 --- a/extras/tiopf/demos/rtf_reporting/result.pdf +++ /dev/null diff --git a/extras/tiopf/demos/rtf_reporting/result.rtf b/extras/tiopf/demos/rtf_reporting/result.rtf deleted file mode 100644 index df05f576..00000000 --- a/extras/tiopf/demos/rtf_reporting/result.rtf +++ /dev/null @@ -1,489 +0,0 @@ -{\rtf1\ansi\deff1\adeflang1025 -{\fonttbl{\f0\froman\fprq2\fcharset0 Times New Roman;}{\f1\fnil\fprq0\fcharset0 Times{\*\falt Times New Roman};}{\f2\fnil\fprq0\fcharset0 Times{\*\falt Times New Roman};}{\f3\fswiss\fprq2\fcharset0 DejaVuSans;}{\f4\fnil\fprq0\fcharset0 Times{\*\falt Times New Roman};}{\f5\fswiss\fprq0\fcharset0 Helvetica;}{\f6\fnil\fprq2\fcharset0 AR PL ShanHeiSun Uni;}{\f7\fnil\fprq0\fcharset0 Tahoma;}{\f8\fswiss\fprq0\fcharset0 Tahoma;}} -{\colortbl;\red0\green0\blue0;\red0\green0\blue128;\red255\green0\blue0;\red153\green153\blue153;\red230\green230\blue230;\red128\green128\blue128;\red0\green0\blue255;\red0\green255\blue255;} -{\stylesheet{\s1\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057\snext1 Normal;} -{\s2\sb240\sa120\keepn\rtlch\af5\afs28\lang255\ltrch\dbch\af6\langfe255\hich\f5\fs28\lang2057\loch\f5\fs28\lang2057\sbasedon1\snext3 Heading;} -{\s3\sa120\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057\sbasedon1\snext3 Body Text;} -{\s4\sa120\rtlch\af8\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057\sbasedon3\snext4 List;} -{\s5\sb120\sa120\rtlch\af7\afs24\lang255\ai\ltrch\dbch\af3\langfe255\hich\f2\fs24\lang2057\i\loch\f2\fs24\lang2057\i\sbasedon1\snext5 caption;} -{\s6\rtlch\af8\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057\sbasedon1\snext6 Index;} -{\s7\sb120\sa120\rtlch\af8\afs24\lang255\ai\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\i\loch\fs24\lang2057\i\sbasedon1\snext7 caption;} -{\s8\sb240\sa120\keepn\rtlch\af5\afs21\lang255\ab\ltrch\dbch\af6\langfe255\hich\f5\fs21\lang2057\b\loch\f5\fs21\lang2057\b\sbasedon2\snext3{\*\soutlvl8} heading 9;} -{\s9\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057\sbasedon1\snext9 Table Contents;} -{\s10\qc\rtlch\afs24\lang255\ab\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\b\loch\fs24\lang2057\b\sbasedon9\snext10 Table Heading;} -{\*\cs12\cf0\rtlch\af1\afs24\lang255\ltrch\dbch\af1\langfe255\hich\f1\fs24\lang2057\loch\f1\fs24\lang2057 RTF_Num 2 1;} -{\*\cs13\cf0\rtlch\af1\afs24\lang255\ltrch\dbch\af1\langfe255\hich\f1\fs24\lang2057\loch\f1\fs24\lang2057 RTF_Num 2 2;} -{\*\cs14\cf0\rtlch\af1\afs24\lang255\ltrch\dbch\af1\langfe255\hich\f1\fs24\lang2057\loch\f1\fs24\lang2057 RTF_Num 2 3;} -{\*\cs15\cf0\rtlch\af1\afs24\lang255\ltrch\dbch\af1\langfe255\hich\f1\fs24\lang2057\loch\f1\fs24\lang2057 RTF_Num 2 4;} -{\*\cs16\cf0\rtlch\af1\afs24\lang255\ltrch\dbch\af1\langfe255\hich\f1\fs24\lang2057\loch\f1\fs24\lang2057 RTF_Num 2 5;} -{\*\cs17\cf0\rtlch\af1\afs24\lang255\ltrch\dbch\af1\langfe255\hich\f1\fs24\lang2057\loch\f1\fs24\lang2057 RTF_Num 2 6;} -{\*\cs18\cf0\rtlch\af1\afs24\lang255\ltrch\dbch\af1\langfe255\hich\f1\fs24\lang2057\loch\f1\fs24\lang2057 RTF_Num 2 7;} -{\*\cs19\cf0\rtlch\af1\afs24\lang255\ltrch\dbch\af1\langfe255\hich\f1\fs24\lang2057\loch\f1\fs24\lang2057 RTF_Num 2 8;} -{\*\cs20\cf0\rtlch\af1\afs24\lang255\ltrch\dbch\af1\langfe255\hich\f1\fs24\lang2057\loch\f1\fs24\lang2057 RTF_Num 2 9;} -{\*\cs21\cf0\rtlch\af1\afs24\lang255\ltrch\dbch\af1\langfe255\hich\f1\fs24\lang2057\loch\f1\fs24\lang2057 RTF_Num 2 10;} -{\*\cs22\cf2\ul\ulc0\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 Internet link;} -{\*\cs23\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 Numbering Symbols;} -}{\*\listtable{\list\listtemplateid1 -{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'02\'00.;}{\levelnumbers\'01;}\fi-360\li720} -{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'02\'01.;}{\levelnumbers\'01;}\fi-360\li1080} -{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'02\'02.;}{\levelnumbers\'01;}\fi-360\li1440} -{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'02\'03.;}{\levelnumbers\'01;}\fi-360\li1800} -{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'02\'04.;}{\levelnumbers\'01;}\fi-360\li2160} -{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'02\'05.;}{\levelnumbers\'01;}\fi-360\li2520} -{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'02\'06.;}{\levelnumbers\'01;}\fi-360\li2880} -{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'02\'07.;}{\levelnumbers\'01;}\fi-360\li3240} -{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'02\'08.;}{\levelnumbers\'01;}\fi-360\li3600} -{\*\soutlvl{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'02\'09.;}{\levelnumbers\'01;}\fi-360\li3960}}{\listname RTF_Num 2;}\listid1} -}{\listoverridetable{\listoverride\listid1\listoverridecount0\ls0}} - -{\info{\creatim\yr0\mo0\dy0\hr0\min0}{\revtim\yr0\mo0\dy0\hr0\min0}{\printim\yr0\mo0\dy0\hr0\min0}{\comment StarWriter}{\vern6800}}\deftab709 -{\*\pgdsctbl -{\pgdsc0\pgdscuse195\pgwsxn11905\pghsxn16837\marglsxn1134\margrsxn1134\margtsxn1134\margbsxn1134\pgdscnxt0 Standard;}} -{\*\pgdscno0}\paperh16837\paperw11905\margl1134\margr1134\margt1134\margb1134\sectd\sbknone\pgwsxn11905\pghsxn16837\marglsxn1134\margrsxn1134\margtsxn1134\margbsxn1134\ftnbj\ftnstart1\ftnrstcont\ftnnar\aenddoc\aftnrstcont\aftnstart1\aftnnrlc -\pard\plain \ltrpar\s1\ql\rtlch\afs32\lang255\ltrch\dbch\af3\langfe255\hich\fs32\lang2057\loch\fs32\lang2057 {\rtlch \ltrch\loch\f1\fs32\lang2057\i0\b0 Simple demo of tiRtfReport} -\par \pard\plain \ltrpar\s1\ql\rtlch\afs20\lang255\ab\ltrch\dbch\af3\langfe255\hich\fs20\lang2057\b\loch\fs20\lang2057\b -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs20\lang2057\b\loch\fs20\lang2057\b {\rtlch \ltrch\loch\f1\fs20\lang2057\i0\b This shows embedded 2008-10-17 11:55:35 (date & time) value. \line Date 2008-10-17 in decoded format: Y=2008 M=10 D=17} -\par \pard\plain \ltrpar\s1\ql\rtlch\afs20\lang255\ltrch\dbch\af3\langfe255\hich\fs20\lang2057\loch\fs20\lang2057 {\rtlch \ltrch\loch\f1\fs20\lang2057\i0\b0 If you view the report design you will notice that function parameters do not need to be escaped with the backslash symbol.} -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ab\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\b\loch\fs24\lang2057\b {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b Accessing the tiOPF framework objects} -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat4\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat4\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat4\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\clcbpat4\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Id} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Name} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Data.Id} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Data.Name} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx1264\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx4815\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\clcbpat5\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 1} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo item 1} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 1000} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo data item 1000} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 1} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 1} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 2} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 2} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx1264\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx4815\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\clcbpat5\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 2} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo item 2} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 2000} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo data item 2000} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 1} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 1} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 2} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 2} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx1264\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx4815\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\clcbpat5\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 3} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo item 3} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 3000} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo data item 3000} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 1} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 1} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 2} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 2} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 3} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 3} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx1264\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx4815\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\clcbpat5\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 4} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo item 4} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 4000} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo data item 4000} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 1} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 1} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 2} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 2} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 3} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 3} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 4} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 4} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx1264\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx4815\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\clcbpat5\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 5} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo item 5} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 5000} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo data item 5000} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 1} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 1} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 2} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 2} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 3} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 3} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx1264\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx4815\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\clcbpat5\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 6} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo item 6} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 6000} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo data item 6000} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 1} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 1} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 2} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 2} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 3} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 3} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 4} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 4} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx1264\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx4815\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\clcbpat5\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 7} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo item 7} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 7000} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo data item 7000} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 1} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 1} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 2} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 2} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx1264\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx4815\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\clcbpat5\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 8} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo item 8} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 8000} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo data item 8000} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 1} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 1} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 2} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 2} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 3} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 3} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 4} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 4} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx1264\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx4815\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\clcbpat5\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 9} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo item 9} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 9000} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo data item 9000} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 1} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 1} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 2} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 2} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx1264\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx4815\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\clcbpat5\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 10} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo item 10} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 10000} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo data item 10000} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 1} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 1} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 2} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 2} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 3} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 3} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx1264\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx4815\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\clcbpat5\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 11} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo item 11} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 11000} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo data item 11000} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 1} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 1} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 2} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 2} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 3} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 3} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx1264\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx4815\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\clcbpat5\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 12} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo item 12} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 12000} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo data item 12000} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 1} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 1} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx1264\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx4815\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\clcbpat5\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 13} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo item 13} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 13000} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo data item 13000} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 1} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 1} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 2} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 2} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx1264\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx4815\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\clcbpat5\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 14} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo item 14} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 14000} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo data item 14000} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 1} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 1} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx1264\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx4815\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\clcbpat5\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 15} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo item 15} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 15000} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo data item 15000} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 1} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 1} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 2} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 2} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 3} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 3} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 4} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 4} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx1264\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx4815\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\clcbpat5\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 16} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo item 16} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 16000} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo data item 16000} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx1264\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx4815\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\clcbpat5\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 17} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo item 17} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 17000} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo data item 17000} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 1} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 1} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 2} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 2} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 3} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 3} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 4} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 4} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx1264\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx4815\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\clcbpat5\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 18} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo item 18} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 18000} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo data item 18000} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 1} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 1} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx1264\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx4815\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\clcbpat5\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 19} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo item 19} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 19000} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo data item 19000} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 1} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 1} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx1264\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx4815\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clcbpat5\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\clcbpat5\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 20} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo item 20} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 20000} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is demo data item 20000} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 1} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 1} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \trowd\trql\trpaddft3\trpaddt55\trpaddfl3\trpaddl55\trpaddfb3\trpaddb55\trpaddfr3\trpaddr55\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx1260\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx4818\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\cellx6540\clbrdrt\brdrs\brdrw1\brdrcf1\clbrdrl\brdrs\brdrw1\brdrcf1\clbrdrb\brdrs\brdrw1\brdrcf1\clbrdrr\brdrs\brdrw1\brdrcf1\cellx9637 -\pard\intbl\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Nested items} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 2} -\cell\pard\plain \intbl\ltrpar\s9\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is nested demo item 2} -\cell\row\pard \pard\plain \ltrpar\s1\v\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 } -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Total of 20 records in the demoitems list.} -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ab\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\b\loch\fs24\lang2057\b {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b Custom function} -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 This is the result of the extra defined function: Best value is 1.5e+400} -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 If you mistype a field name you get something like this: {\b\ul\highlight8\cf7 DemoItems.Hahaha Field "Hahaha" does not exist}. This is extremely useful for detecting and solving errors in your RTF reports.} -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ab\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\b\loch\fs24\lang2057\b {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b Report Design} -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Sometimes it is necessary to make report fields hidden so that it fixes report formatting issues. To view all the Report Fields you need to tell OpenOffice to show hidden text.} -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Follow these steps to view hidden text:} -\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\f3 1.\tab}\ilvl0 \ltrpar\s1\ls0\li720\ri0\lin720\rin0\fi-360\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 Enable nonprinting characters: View | Nonprinting Characters} -\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\f3 2.\tab}\ilvl0 \ltrpar\s1\ls0\li720\ri0\lin720\rin0\fi-360\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b0 If you don't see all the fields yet (eg: between the table header and table details lines) you need to enable the show hidden text option in: Tools | Options | OpenOffice.org Writer | Formatting Aids. Then tick the "Hidden text" option in the "Display of" - section.} -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\par \pard\plain \ltrpar\s1\cf3\qc\rtlch\afs24\lang255\ab\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\b\loch\fs24\lang2057\b {\rtlch \ltrch\loch\f1\fs24\lang2057\i0\b The End!} -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\par \pard\plain \ltrpar\s1\ql\rtlch\afs24\lang255\ltrch\dbch\af3\langfe255\hich\fs24\lang2057\loch\fs24\lang2057 -\par }
\ No newline at end of file diff --git a/extras/tiopf/gui/tiCompositeMediators.pas b/extras/tiopf/gui/tiCompositeMediators.pas deleted file mode 100644 index e2637056..00000000 --- a/extras/tiopf/gui/tiCompositeMediators.pas +++ /dev/null @@ -1,856 +0,0 @@ -{ - Abstract mediating views for GUI list controls. This allows you to use - standard list components and make them object-aware. See the demo - application for usage. -} -unit tiCompositeMediators; - -{$mode objfpc}{$H+} - -interface - -uses - Classes - ,SysUtils - ,Contnrs { TObjectList } - ,gui_listview { TfpgListView } - ,gui_grid { TfpgStringGrid } - ,tiObject - ; - - -type - TtiMediatorFieldInfo = class - private - FWidth: integer; - FCaption: string; - FPropName: string; - FAlign: TAlignment; - public - property Caption : string read FCaption write FCaption; - property PropName : string read FPropName write FPropName; - property FieldWidth : integer read FWidth write FWidth; - property Alignment : TAlignment read FAlign write FAlign default taLeftJustify; - end; - - { Event object used for OnBeforeSetupField event. Is used to allow formatting - of fields before written to listview Caption or Items. } - TOnBeforeSetupField = procedure(AObject: TtiObject; - const AFieldName: string; var AValue: string) of object; - - { Composite mediator for TfpgListView } - TCompositeListViewMediator = class(TtiObject) - private - FOnBeforeSetupField: TOnBeforeSetupField; - function GetSelectedObject: TtiObject; - procedure SetSelectedObject(const AValue: TtiObject); - procedure SetShowDeleted(const AValue: Boolean); - procedure DoCreateItemMediator(AData: TtiObject); - procedure SetOnBeforeSetupField(const Value: TOnBeforeSetupField); - protected - FIsObserving: Boolean; - FDisplayNames: string; - FShowDeleted: Boolean; - FView: TfpgListView; - FModel: TtiObjectList; - FMediatorList: TObjectList; - FObserversInTransit: TList; - FSelectedObject: TtiObject; - FFieldsInfo : TStringList; - procedure ParseDisplayNames; - procedure CreateSubMediators; virtual; - procedure SetupGUIandObject; virtual; - procedure RebuildList; virtual; - function DataAndPropertyValid(const AData: TtiObject): Boolean; - public - constructor Create; override; - constructor CreateCustom(AModel: TtiObjectList; AView: TfpgListView; ADisplayNames: string; IsObserving: Boolean = True); overload; - constructor CreateCustom(AModel: TtiObjectList; AView: TfpgListView; - AOnBeforeSetupField: TOnBeforeSetupField; ADisplayNames: string; IsObserving: Boolean = True); overload; - procedure BeforeDestruction; override; - procedure Update(ASubject: TtiObject); override; - { Called from the GUI to trigger events } - procedure HandleSelectionChanged; virtual; - { Event handler to allow formatting of fields before they are written. } - property OnBeforeSetupField: TOnBeforeSetupField read FOnBeforeSetupField write SetOnBeforeSetupField; - published - property View: TfpgListView read FView; - property Model: TtiObjectList read FModel; - property DisplayNames: string read FDisplayNames; - property IsObserving: Boolean read FIsObserving; - property SelectedObject: TtiObject read GetSelectedObject write SetSelectedObject; - property ShowDeleted: Boolean read FShowDeleted write SetShowDeleted; - end; - - - { Composite mediator for TfpgStringGrid } - TCompositeStringGridMediator = class(TtiObject) - private - function GetSelectedObjected: TtiObject; - procedure SetSelectedObject(const AValue: TtiObject); - procedure SetShowDeleted(const AValue: Boolean); - procedure DoCreateItemMediator(AData: TtiObject); overload; - procedure DoCreateItemMediator(AData: TtiObject; ARowIdx : Integer); overload; - protected - FDisplayNames: string; - FIsObserving: boolean; - FShowDeleted: Boolean; - FView: TfpgStringGrid; - FModel: TtiObjectList; - FMediatorList: TObjectList; - procedure CreateSubMediators; virtual; - procedure SetupGUIandObject; virtual; - procedure RebuildStringGrid; virtual; - function DataAndPropertyValid(const AData: TtiObject): Boolean; - public - constructor CreateCustom(AModel: TtiObjectList; AGrid: TfpgStringGrid; ADisplayNames: string; IsObserving: Boolean = True); - procedure BeforeDestruction; override; - procedure Update(ASubject: TtiObject); override; - published - property View: TfpgStringGrid read FView; - property Model: TtiObjectList read FModel; - property DisplayNames: string read FDisplayNames; - property IsObserving: boolean read FIsObserving; - property ShowDeleted: Boolean read FShowDeleted write SetShowDeleted; - property SelectedObject: TtiObject read GetSelectedObjected write SetSelectedObject; - end; - - - { Used internally for sub-mediators in ListView mediator. Moved to interface - section so it can be overridden. } - TListViewListItemMediator = class(TtiObject) - private - FOnBeforeSetupField: TOnBeforeSetupField; - procedure SetOnBeforeSetupField(const Value: TOnBeforeSetupField); - protected - FModel: TtiObject; - FView: TfpgLVItem; - FDisplayNames: string; - procedure SetupFields; virtual; - public - constructor CreateCustom(AModel: TtiObject; AView: TfpgLVItem; const ADisplayNames: string; IsObserving: Boolean = True); - constructor CreateCustom(AModel: TtiObject; AView: TfpgLVItem; - AOnBeforeSetupField: TOnBeforeSetupField; const ADisplayNames: string; IsObserving: Boolean = True); overload; - procedure BeforeDestruction; override; - procedure Update(ASubject: TtiObject); override; - { Event handler to allow formatting of fields before they are written. } - property OnBeforeSetupField: TOnBeforeSetupField read FOnBeforeSetupField write SetOnBeforeSetupField; - published - property View: TfpgLVItem read FView; - property Model: TtiObject read FModel; - property DisplayNames: string read FDisplayNames; - end; - - - { Used internally for sub-mediators in StringGrid mediator. Moved to interface - section so it can be overridden. } - TStringGridRowMediator = class(TtiObject) - private - FDisplayNames: string; - FView: TfpgStringGrid; - FModel: TtiObject; - FRowIndex: Integer; - protected -// procedure SetupFields; - public - constructor CreateCustom(AModel: TtiObject; AGrid: TfpgStringGrid; ADisplayNames: string; ARowIndex: integer; IsObserving: Boolean = True); - procedure BeforeDestruction; override; - procedure Update(ASubject: TtiObject); override; - published - property Model: TtiObject read FModel; - property View: TfpgStringGrid read FView; - property DisplayNames: string read FDisplayNames; - end; - - -function tiFieldName(const AField: string): string; -function tiFieldWidth(const AField: string): integer; -function tiFieldCaption(const AField: string): string; -function tiFieldAlignment(const AField : string) : TAlignment; - -implementation - -uses - tiUtils - ,typinfo - ,tiExcept - ,tiGenericEditMediators - ; - -const - cFieldDelimiter = ';'; - cBrackets = '()'; - - -{ Helper functions } - -{ Extract the field name part from the AField string which is in the format - fieldname(width,"field caption") eg: Quantity(25,"Qty") will return: Quantity - Width and Field Caption is optional } -function tiFieldName(const AField: string): string; -begin - Result := tiToken(AField, cBrackets[1], 1); -end; - -{ Extract the width part from the AField string which is in the format - fieldname(width,"field caption") eg: Quantity(25,"Qty") will return: 25 - Width and Field Caption is optional } -function tiFieldWidth(const AField: string): integer; -var - s: string; -begin - s := tiSubStr(AField, cBrackets[1], cBrackets[2], 1); - if trim(s) = '' then - Result := 75 // default width - else - Result := StrToInt(tiToken(s, ',', 1)); -end; - -{ Extracts the alignment from the AField string which is in the format - fieldname(width,"field caption",a) where a is the alignment character. - Legal values for the alignment character are :- - < - left aligned - > - right aligned - | - centre aligned - eg: Quantity(25,"Qty",>) will return: Qty with a width of 25 and - the column will be right-aligned. Width, Field Caption and alignment - are optional } -function tiFieldAlignment(const AField : string) : TAlignment; -var - s, a : string; - lAlignChar : Char; -begin - result := taLeftJustify; - s := tiSubStr(AField, cBrackets[1], cBrackets[2], 1); - if trim(s) <> '' then - begin - a := tiToken(s, ',', 3); - if a <> '' then - begin - lAlignChar := a[1]; - Case lAlignChar Of - '<' : Result := taLeftJustify; - '>' : Result := taRightJustify; - '|' : Result := taCenter; - end; { case } - end; - end; -end; - -{ Extract the field caption part from the AField string which is in the format - fieldname(width,"field caption") eg: Quantity(25,"Qty") will return: Qty - Width and Field Caption is optional } -function tiFieldCaption(const AField: string): string; -var - s: string; - p: pchar; -begin - s := tiSubStr(AField, cBrackets[1], cBrackets[2]); - if (trim(s) = '') or (Pos(',', s) = 0) then - // It's only got a width or is blank, so we default to field name - Result := tiFieldName(AField) - else - begin - s := tiToken(s, ',', 2); - p := PChar(s); - Result := AnsiExtractQuotedStr(p, '"'); - end; -end; - - -{ TStringGridRowMediator } - -//procedure TStringGridRowMediator.SetupFields; -//begin -// {$ifdef fpc} {$Note Add the appropriate code here} {$endif} -//end; - - -constructor TStringGridRowMediator.CreateCustom(AModel: TtiObject; - AGrid: TfpgStringGrid; ADisplayNames: string; ARowIndex: integer; - IsObserving: Boolean); -begin - inherited Create; - FModel := AModel; - FView := AGrid; - FDisplayNames := ADisplayNames; - FRowIndex := ARowIndex; - - if IsObserving then - FModel.AttachObserver(self); -end; - -procedure TStringGridRowMediator.BeforeDestruction; -begin - FModel.DetachObserver(self); - FModel := nil; - inherited BeforeDestruction; -end; - -procedure TStringGridRowMediator.Update(ASubject: TtiObject); -var - i: Integer; - lField: string; - lFieldName: string; -begin - Assert(FModel = ASubject); - for i := 0 to tiNumToken(FDisplayNames, cFieldDelimiter)-1 do - begin - lField := tiToken(FDisplayNames, cFieldDelimiter, i+1); - lFieldName := tiFieldName(lField); - FView.Cells[i, FRowIndex] := FModel.PropValue[lFieldName]; - end; -end; - - -{ TListViewListItemMediator } - -constructor TListViewListItemMediator.CreateCustom(AModel: TtiObject; - AView: TfpgLVItem; AOnBeforeSetupField: TOnBeforeSetupField; - const ADisplayNames: string; IsObserving: Boolean); -begin - inherited Create; - FModel := AModel; - FView := AView; - FDisplayNames := ADisplayNames; - FOnBeforeSetupField := AOnBeforeSetupField; - - SetupFields; - - if IsObserving then - FModel.AttachObserver(self); -end; - -procedure TListViewListItemMediator.SetOnBeforeSetupField( - const Value: TOnBeforeSetupField); -begin - FOnBeforeSetupField := Value; -end; - -procedure TListViewListItemMediator.SetupFields; -var - c: integer; - lField: string; - lMemberName: string; - lValue: string; -begin - lField := tiToken(FDisplayNames, cFieldDelimiter, 1); - lMemberName := tiFieldName(lField); - lValue := FModel.PropValue[lMemberName]; - - if Assigned(FOnBeforeSetupField) then - FOnBeforeSetupField(FModel, lMemberName, lValue); - - FView.Caption := lValue; - - for c := 2 to tiNumToken(FDisplayNames, cFieldDelimiter) do - begin - lField := tiToken(FDisplayNames, cFieldDelimiter, c); - lMemberName := tiFieldName(lField); - lValue := FModel.PropValue[lMemberName]; - - if Assigned(FOnBeforeSetupField) then - FOnBeforeSetupField(FModel, lMemberName, lValue); - - FView.SubItems.Add(lValue); - end; -end; - -constructor TListViewListItemMediator.CreateCustom(AModel: TtiObject; - AView: TfpgLVItem; const ADisplayNames: string; IsObserving: Boolean); -begin - inherited Create; - FModel := AModel; - FView := AView; - FDisplayNames := ADisplayNames; - - SetupFields; - - if IsObserving then - FModel.AttachObserver(self); -end; - -procedure TListViewListItemMediator.BeforeDestruction; -begin - FModel.DetachObserver(self); - FModel := nil; - FView := nil; - inherited BeforeDestruction; -end; - -procedure TListViewListItemMediator.Update(ASubject: TtiObject); -var - c: integer; - lField: string; - lMemberName: string; - lValue: string; -begin - Assert(FModel = ASubject); - - lField := tiToken(DisplayNames, cFieldDelimiter, 1); - lMemberName := tiFieldName(lField); - lValue := FModel.PropValue[lMemberName]; - - if Assigned(FOnBeforeSetupField) then - FOnBeforeSetupField(FModel, lMemberName, lValue); - - FView.Caption := lValue; - - for c := 2 to tiNumToken(DisplayNames, cFieldDelimiter) do - begin - lField := tiToken(DisplayNames, cFieldDelimiter, c); - lMemberName := tiFieldName(lField); - lValue := FModel.PropValue[lMemberName]; - - if Assigned(FOnBeforeSetupField) then - FOnBeforeSetupField(FModel, lMemberName, lValue); - FView.SubItems[c-2] := lValue; - end; -end; - -{ TCompositeListViewMediator } - -procedure TCompositeListViewMediator.SetOnBeforeSetupField( - const Value: TOnBeforeSetupField); -begin - FOnBeforeSetupField := Value; -end; - -procedure TCompositeListViewMediator.SetSelectedObject(const AValue: TtiObject); -var - i: integer; -begin - for i := 0 to FView.Items.Count-1 do - begin - if TtiObject(FView.Items.Item[i].UserData) = AValue then - begin -// FView.Selected := FView.Items.Item[i]; - FView.ItemIndex := i; - HandleSelectionChanged; - Exit; //==> - end; - end; -end; - -function TCompositeListViewMediator.GetSelectedObject: TtiObject; -begin -// if FView.SelCount = 0 then - if FView.ItemIndex = -1 then - FSelectedObject := nil - else -// FSelectedObject := TtiObject(FView.Selected.Data); - FSelectedObject := TtiObject(FView.Items.Item[FView.ItemIndex].UserData); - result := FSelectedObject; -end; - -procedure TCompositeListViewMediator.SetShowDeleted(const AValue: Boolean); -begin - if FShowDeleted = AValue then - Exit; //==> - - BeginUpdate; - try - FShowDeleted := AValue; - RebuildList; - finally - EndUpdate; - end; -end; - -procedure TCompositeListViewMediator.DoCreateItemMediator(AData: TtiObject); -var - li: TfpgLVItem; - m: TListViewListItemMediator; -begin - DataAndPropertyValid(AData); - - { Create ListItem and Mediator } - li := TfpgLVItem.Create(FView.Items); - li.UserData := AData; - FView.Items.Add(li); - m := TListViewListItemMediator.CreateCustom(AData, li, FOnBeforeSetupField, FDisplayNames, FIsObserving); - FMediatorList.Add(m); -end; - -procedure TCompositeListViewMediator.CreateSubMediators; -var - c: integer; - lc: TfpgLVColumn; - lInfo : TtiMediatorFieldInfo; -begin - if View.Columns.Count = 0 then - begin - { Create column headers } - for c := 0 to Pred(FFieldsInfo.Count) do - begin - lInfo := TtiMediatorFieldInfo(FFieldsInfo.Objects[c]); - lc := TfpgLVColumn.Create(View.Columns); - lc.AutoSize := False; - lc.Caption := lInfo.Caption; - lc.Width := lInfo.FieldWidth; - lc.Alignment := lInfo.Alignment; - View.Columns.Add(lc); - end; - end; - FModel.ForEach(@DoCreateItemMediator, FShowDeleted); -end; - -procedure TCompositeListViewMediator.SetupGUIandObject; -begin - { Setup TfpgListView defaults } - FView.Columns.Clear; - FView.Items.Clear; -// FView.ViewStyle := vsReport; - FView.ShowHeaders := True; -// FView.RowSelect := True; -// FView.AutoSize := False; -// FView.ScrollBars := ssAutoBoth; -end; - -procedure TCompositeListViewMediator.RebuildList; -begin - { This rebuilds the whole list. Not very efficient. You can always override - this in your mediators to create a more optimised rebuild. } - View.BeginUpdate; - try - FMediatorList.Clear; - View.Columns.Clear; - View.Items.Clear; - CreateSubMediators; - finally - View.EndUpdate; - end; -end; - -function TCompositeListViewMediator.DataAndPropertyValid(const AData: TtiObject): Boolean; -var - c: integer; - lField: string; -begin - result := (FModel <> nil) and (FDisplayNames <> ''); - if not result then - Exit; //==> - - for c := 1 to tiNumToken(FDisplayNames, cFieldDelimiter) do - begin - lField := tiToken(FDisplayNames, cFieldDelimiter, c); - { WRONG!! We should test the items of the Model } - result := (IsPublishedProp(AData, tiFieldName(lField))); - if not result then - raise Exception.CreateFmt('<%s> is not a property of <%s>', - [tiFieldName(lField), AData.ClassName ]); - end; -end; - -constructor TCompositeListViewMediator.Create; -begin - inherited Create; - FObserversInTransit := TList.Create; - FFieldsInfo := TStringList.Create; -end; - -constructor TCompositeListViewMediator.CreateCustom(AModel: TtiObjectList; - AView: TfpgListView; AOnBeforeSetupField: TOnBeforeSetupField; - ADisplayNames: string; IsObserving: Boolean); -begin - Create; // don't forget this - - FModel := AModel; - FView := AView; - FMediatorList := TObjectList.Create; - FIsObserving := IsObserving; - FDisplayNames := ADisplayNames; - FShowDeleted := False; - - Assert(Assigned(AOnBeforeSetupField), 'OnBeforeSetupField not assigned'); - FOnBeforeSetupField := AOnBeforeSetupField; - - SetupGUIandObject; - - { TODO: This must be improved. If no ADisplayNames value maybe default to a - single column listview using the Caption property } - if (ADisplayNames <> '') and (tiNumToken(ADisplayNames, cFieldDelimiter) > 0) then - begin - ParseDisplayNames; - CreateSubMediators; - end; - - if IsObserving then - FModel.AttachObserver(self); - -end; - -constructor TCompositeListViewMediator.CreateCustom(AModel: TtiObjectList; - AView: TfpgListView; ADisplayNames: string; IsObserving: Boolean); -begin - Create; // don't forget this - - FModel := AModel; - FView := AView; - FMediatorList := TObjectList.Create; - FIsObserving := IsObserving; - FDisplayNames := ADisplayNames; - FShowDeleted := False; - - SetupGUIandObject; - - { TODO: This must be improved. If no ADisplayNames value, maybe default to a - single column listview using the Caption property } - if (ADisplayNames <> '') and (tiNumToken(ADisplayNames, cFieldDelimiter) > 0) then - begin - ParseDisplayNames; - CreateSubMediators; - end; - - if IsObserving then - FModel.AttachObserver(self); -end; - -procedure TCompositeListViewMediator.BeforeDestruction; -begin - FFieldsInfo.Free; - FObserversInTransit.Free; - FMediatorList.Free; - FModel.DetachObserver(self); - FModel := nil; - FView := nil; - inherited BeforeDestruction; -end; - -procedure TCompositeListViewMediator.Update(ASubject: TtiObject); -begin - Assert(FModel = ASubject); - RebuildList; -end; - -{ TODO: This is not working 100% yet. Be warned! } -procedure TCompositeListViewMediator.HandleSelectionChanged; -var - i: integer; -begin - if View.ItemIndex = -1 then - FSelectedObject := nil - else - begin - FObserversInTransit.Clear; - { If an item is already selected, assign the item's List of observers to a - temporary container. This is done so that the same observers can be - assigned to the new item. } - if Assigned(FSelectedObject) then - FObserversInTransit.Assign(FSelectedObject.ObserverList); - - // Assign Newly selected item to SelectedObject Obj. - FSelectedObject := TtiObject(View.Items.Item[View.ItemIndex].UserData); - - { If an object was selected, copy the old item's observer List - to the new item's observer List. } - if FObserversInTransit.Count > 0 then - FSelectedObject.ObserverList.Assign(FObserversInTransit); - - { Set the Observers Subject property to the selected object } - for i := 0 to FSelectedObject.ObserverList.Count-1 do - begin - TMediatorView(FSelectedObject.ObserverList.Items[i]).Subject := - FSelectedObject; - end; - - // execute the NotifyObservers event to update the observers. - FSelectedObject.NotifyObservers; - end; -end; - -procedure TCompositeListViewMediator.ParseDisplayNames; -Var - I : Integer; - lField : String; - lInfo : TtiMediatorFieldInfo; -begin - for I := 1 to tiNumToken(FDisplayNames, cFieldDelimiter) do - begin - lField := tiToken(FDisplayNames, cFieldDelimiter, I); - lInfo := TtiMediatorFieldInfo.Create; - lInfo.PropName := tiFieldName(lField); - lInfo.Caption := tiFieldCaption(lField); - lInfo.FieldWidth := tiFieldWidth(lField); - lInfo.Alignment := tiFieldAlignment(lField); - FFieldsInfo.AddObject(lInfo.Caption + '=' + tiFieldName(lField), lInfo); - end; { Loop } -end; - -{ TCompositeStringGridMediator } - -function TCompositeStringGridMediator.GetSelectedObjected: TtiObject; -begin - if FView.FocusRow = -1 then -// if FView.Selection.Top = 0 then - Result := nil - else -// Result := TtiObject(FView.Objects[1, FView.Selection.Top]); - Result := TtiObject(FView.Objects[0, FView.FocusRow]); -end; - -procedure TCompositeStringGridMediator.SetSelectedObject(const AValue: TtiObject); -var - i: integer; -begin - for i := 0 to FView.RowCount-1 do - begin - if TtiObject(FView.Objects[0, i]) = AValue then - begin - FView.FocusRow := i; - Exit; //==> - end; - end; -end; - -procedure TCompositeStringGridMediator.SetShowDeleted(const AValue: Boolean); -begin - if FShowDeleted = AValue then - Exit; //==> - - BeginUpdate; - try - FShowDeleted := AVAlue; - RebuildStringGrid; - finally - EndUpdate; - end; -end; - -procedure TCompositeStringGridMediator.DoCreateItemMediator(AData: TtiObject); -begin - DataAndPropertyValid(AData); -end; - -procedure TCompositeStringGridMediator.DoCreateItemMediator(AData: TtiObject; ARowIdx: Integer); -var - i: Integer; - lField: string; - lFieldName: string; - lMediatorView: TStringGridRowMediator; -begin - FView.Objects[0, ARowIdx] := AData; // set Object reference inside grid - for i := 0 to tiNumToken(FDisplayNames, cFieldDelimiter)-1 do - begin - lField := tiToken(FDisplayNames, cFieldDelimiter, i+1); - lFieldName := tiFieldName(lField); - FView.Cells[i, ARowIdx] := AData.PropValue[lFieldName]; // set Cell text - lMediatorView := TStringGridRowMediator.CreateCustom(AData, FView, FDisplayNames, ARowIdx, FIsObserving); - FMediatorList.Add(lMediatorView); - end; -end; - -procedure TCompositeStringGridMediator.CreateSubMediators; -var - i: integer; - lField: string; - lColumnTotalWidth: integer; -begin - lColumnTotalWidth := 0; - for i := 0 to tiNumToken(FDisplayNames, cFieldDelimiter)-1 do - begin - lField := tiToken(FDisplayNames, cFieldDelimiter, i+1); - FView.ColumnWidth[i] := tiFieldWidth(lField); - FView.ColumnTitle[i] := tiFieldCaption(lField); - - //resize the last column to fill the grid. - if i = tiNumToken(FDisplayNames, cFieldDelimiter)-1 then - FView.ColumnWidth[i] := FView.Width - (lColumnTotalWidth + 10) - else - lColumnTotalWidth := lColumnTotalWidth + FView.ColumnWidth[i] + 20; - end; - - for i := 0 to FModel.Count-1 do // loop through all items - begin - if (not FModel.Items[i].Deleted) or FShowDeleted then - DoCreateItemMediator(FModel.Items[i], i); - end; -end; - -procedure TCompositeStringGridMediator.SetupGUIandObject; -begin - //Setup default properties for the StringGrid - FView.RowSelect := True; - FView.ColumnCount := tiNumToken(FDisplayNames, cFieldDelimiter); - if FShowDeleted then - FView.RowCount := FModel.Count - else - FView.RowCount := FModel.CountNotDeleted; -end; - -procedure TCompositeStringGridMediator.RebuildStringGrid; -var - i: integer; -begin - { This rebuilds the whole list. Not very efficient. } - View.BeginUpdate; - try - SetupGUIandObject; - FMediatorList.Clear; -// for i := View.ColumnCount-1 downto 0 do -// View.DeleteColumn(i); - CreateSubMediators; - finally - View.EndUpdate; - end; -end; - -function TCompositeStringGridMediator.DataAndPropertyValid(const AData: TtiObject): Boolean; -var - i: Integer; - lField: string; -begin - Result := (FModel <> nil) and (FDisplayNames <> ''); - - if not Result then - Exit; //==> - - for i := 1 to tiNumToken(FDisplayNames, cFieldDelimiter) do - begin - lField := tiToken(FDisplayNames, cFieldDelimiter, i); - Result := IsPublishedProp(AData, tiFieldName(lField)); - - if not Result then - raise Exception.CreateFmt('<%s> is not a property of <%s>', - [tiFieldName(lField), AData.ClassName]); - end; -end; - -constructor TCompositeStringGridMediator.CreateCustom(AModel: TtiObjectList; - AGrid: TfpgStringGrid; ADisplayNames: string; IsObserving: Boolean); -begin - inherited Create; - - FModel := AModel; - FView := AGrid; - FMediatorList := TObjectList.Create; - FIsObserving := IsObserving; - FDisplayNames := ADisplayNames; - FShowDeleted := False; - - SetupGUIandObject; - if (FDisplayNames <> '') and (tiNumToken(ADisplayNames, cFieldDelimiter) > 0) then - CreateSubMediators; - - if IsObserving then - FModel.AttachObserver(Self); -end; - -procedure TCompositeStringGridMediator.BeforeDestruction; -begin - FMediatorList.Free; - if Assigned(FModel) then - FModel.DetachObserver(Self); - FModel := nil; - FView := nil; - inherited BeforeDestruction; -end; - -procedure TCompositeStringGridMediator.Update(ASubject: TtiObject); -begin - Assert(FModel = ASubject); - RebuildStringGrid; -end; - -end. - diff --git a/extras/tiopf/gui/tiDialogs.pas b/extras/tiopf/gui/tiDialogs.pas deleted file mode 100644 index 04f4d896..00000000 --- a/extras/tiopf/gui/tiDialogs.pas +++ /dev/null @@ -1,260 +0,0 @@ -unit tiDialogs; - -{$mode objfpc}{$H+} - -{ TODO: Port tiProcessing and tiEndProcessing } - -interface - -uses - Classes, - SysUtils, - Variants, - fpg_base; - - - // Call showMessage, but accepts a variant. Good for debugging. - procedure tiShowMessage(const AArray: Array of Const); overload; - procedure tiShowMessage(const AValue: variant); overload; - - - // Show the contents of a TStringList - for debugging - procedure tiShowStringList(const AStringList: TStringList; const AHeading: TfpgString = 'Show string list'); - // Show the contents of a TStrings - for debugging - procedure tiShowStrings(const AStrings: TStrings; const AHeading: TfpgString = 'Show strings'); - // Show a long string - for debugging - procedure tiShowString(const AStr: TfpgString; const AHeading: TfpgString = 'Show string'); - // Show a variant array of variants - for debugging - procedure tiShowVariant(AValue: Variant; AHeading: TfpgString = 'Show variant'); - // Show the contents of a stream - procedure tiShowStream(const AValue: TStream; const AHeading: TfpgString = 'Show stream'); - // Show a <Yes>, <No> dialog box, and return true if <Yes> was selected - function tiAppConfirmation(const AMessage: TfpgString; ATitle: TfpgString = ''): boolean; overload; - function tiAppConfirmation(const AMessage: TfpgString; const AValues: array of const): boolean; overload; - // Show a message - procedure tiAppMessage(const AMessage: TfpgString; ATitle: TfpgString = ''); - // Show a warning - procedure tiAppWarning(const AMessage: TfpgString; ATitle: TfpgString = ''); - // Show a error message - procedure tiAppError(const AMessage: TfpgString; ATitle: TfpgString = ''); - - // A type of notification window that will disappear by it self - procedure tiProcessing(const AMessage: TfpgString); - procedure tiEndProcessing; - -implementation - -uses - fpg_main, - fpg_form, - fpg_memo, - fpg_label, - fpg_dialogs, - fpg_panel, - tiGUIINI, - tiUtils; - -var - pWorkingForm: TfpgForm; - -type - TProcessingForm = class(TfpgForm) - private - {@VFD_HEAD_BEGIN: ProcessingForm} - Bevel1: TfpgBevel; - lblMessage: TfpgLabel; - {@VFD_HEAD_END: ProcessingForm} - public - procedure AfterCreate; override; - end; - -{ TProcessingForm } - -procedure TProcessingForm.AfterCreate; -begin - {%region 'Auto-generated GUI code' -fold} - {@VFD_BODY_BEGIN: ProcessingForm} - Name := 'ProcessingForm'; - SetPosition(317, 177, 400, 150); - WindowTitle := 'Processing...'; - WindowPosition := wpScreenCenter; - BackgroundColor := clHilite1; - WindowType := wtPopup; - - Bevel1 := TfpgBevel.Create(self); - with Bevel1 do - begin - Name := 'Bevel1'; - SetPosition(8, 4, 232, 80); - Align := alClient; - end; - - lblMessage := TfpgLabel.Create(Bevel1); - with lblMessage do - begin - Name := 'lblMessage'; - SetPosition(32, 28, 108, 32); - Alignment := taCenter; - FontDesc := '#Label1'; - Hint := ''; - Layout := tlCenter; - Text := '...'; - WrapText := True; - Align := alClient; - MouseCursor := mcHourGlass; - end; - - {@VFD_BODY_END: ProcessingForm} - {%endregion} -end; - - - -procedure tiShowMessage(const AArray: array of const); -const - BoolChars: array[Boolean] of Char = ('F', 'T'); -var - i: Integer; - lsLine: string; -begin - lsLine := ''; - for I := 0 to High(AArray) do begin - if lsLine <> '' then - lsLine := lsLine + Cr; - with AArray[i] do - case VType of - vtInteger: lsLine := lsLine + IntToStr(VInteger); - vtBoolean: lsLine := lsLine + BoolChars[VBoolean]; - vtChar: lsLine := lsLine + VChar; - vtExtended: lsLine := lsLine + FloatToStr(VExtended^); - vtString: lsLine := lsLine + VString^; - vtPChar: lsLine := lsLine + VPChar; - vtObject: lsLine := lsLine + VObject.ClassName; - vtClass: lsLine := lsLine + VClass.ClassName; - vtAnsiString: lsLine := lsLine + string(VAnsiString); - vtCurrency: lsLine := lsLine + CurrToStr(VCurrency^); - vtVariant: lsLine := lsLine + string(VVariant^); - vtInt64: lsLine := lsLine + IntToStr(VInt64^); - end; - end; - tiShowMessage(lsLine); -end; - -procedure tiShowMessage(const AValue: variant); -begin - ShowMessage(VarToStr(AValue)); -end; - -procedure tiShowStringList(const AStringList: TStringList; const AHeading: TfpgString); -begin - tiShowStrings(AStringList, AHeading); -end; - -procedure tiShowStrings(const AStrings: TStrings; const AHeading: TfpgString); -var - lForm: TfpgForm; - lMemo: TfpgMemo; -begin - lForm := TfpgForm.Create(nil); - lMemo := TfpgMemo.Create(lForm); - try - lForm.WindowTitle := AHeading; - lForm.Width := 300; - lForm.Height := 300; - lForm.WindowPosition := wpScreenCenter; - lForm.Name := 'FormShowStrings'; - lMemo.Lines.Assign(AStrings); - lMemo.FontDesc := 'Courier New-10'; - gGUIINI.ReadFormState(lForm); - lMemo.SetPosition(0, 0, lForm.Width, lForm.Height); - lMemo.Align := alClient; - lForm.ShowModal; - gGUIINI.WriteFormState(lForm); - finally - lForm.free; - end; -end; - -procedure tiShowString(const AStr: TfpgString; const AHeading: TfpgString); -var - lSL: TStringList; -begin - lSL := TStringList.Create; - try - lSL.Text := AStr; - tiShowStringList(lSL, AHeading); - finally - lSL.Free; - end; -end; - -procedure tiShowVariant(AValue: Variant; AHeading: TfpgString); -var - ls: string; -begin - ls := tiVariantArrayToString(AValue); - tiShowString(ls, AHeading); -end; - -procedure tiShowStream(const AValue: TStream; const AHeading: TfpgString); -var - lStringStream: TStringStream; -begin - lStringStream := TStringStream.Create(''); - try - AValue.Position := 0; - lStringStream.CopyFrom(AValue, AValue.Size); - tiShowString(lStringStream.DataString, AHeading); - finally - lStringStream.Free; - end; -end; - -function tiAppConfirmation(const AMessage: TfpgString; ATitle: TfpgString = ''): boolean; -begin - Result := TfpgMessageDialog.Question(ATitle, AMessage) = mbYes -end; - -function tiAppConfirmation(const AMessage: TfpgString; - const AValues: array of const): boolean; -begin - Result := tiAppConfirmation(Format(AMessage, AValues)); -end; - -procedure tiAppMessage(const AMessage: TfpgString; ATitle: TfpgString = ''); -begin - TfpgMessageDialog.Information(ATitle, AMessage); -end; - -procedure tiAppWarning(const AMessage: TfpgString; ATitle: TfpgString = ''); -begin - TfpgMessageDialog.Warning(ATitle, AMessage); -end; - -procedure tiAppError(const AMessage: TfpgString; ATitle: TfpgString = ''); -begin - TfpgMessageDialog.Critical(ATitle, AMessage); -end; - -procedure tiProcessing(const AMessage: TfpgString); -begin - if not Assigned(pWorkingForm) then - begin - pWorkingForm := TProcessingForm.Create(nil); - TProcessingForm(pWorkingForm).lblMessage.Text := AMessage; - pWorkingForm.Show; - end - else - TProcessingForm(pWorkingForm).lblMessage.Text := AMessage; - fpgApplication.ProcessMessages; -end; - -procedure tiEndProcessing; -begin - if Assigned(pWorkingForm) then - pWorkingForm.Close; - FreeAndNil(pWorkingForm); -end; - -end. - diff --git a/extras/tiopf/gui/tiGUIConstants.pas b/extras/tiopf/gui/tiGUIConstants.pas deleted file mode 100644 index 80a7bbf1..00000000 --- a/extras/tiopf/gui/tiGUIConstants.pas +++ /dev/null @@ -1,17 +0,0 @@ -unit tiGUIConstants; - -{$mode objfpc}{$H+} - -interface - -uses - fpg_base - ; - -const - clError = clYellow; - -implementation - -end. - diff --git a/extras/tiopf/gui/tiGUIINI.pas b/extras/tiopf/gui/tiGUIINI.pas deleted file mode 100644 index 4d13a989..00000000 --- a/extras/tiopf/gui/tiGUIINI.pas +++ /dev/null @@ -1,129 +0,0 @@ -unit tiGUIINI; - -{$mode objfpc}{$H+} - -{ TODO: When TfpgForm supports FormState property, implement the remaining functions. } - -interface -uses - tiINI - ,fpg_form - ; - -type - - TtiGuiINIFile = class(TtiINIFile) - public - procedure ReadFormState(AForm: TfpgForm; AHeight: integer = -1; AWidth: integer = -1); - procedure WriteFormState(AForm : TfpgForm); - end; - -function gGUIINI(const AFileName: string = ''): TtiGuiINIFile; - - -implementation -uses - fpg_main - ; - -var - uGuiINI : TtiGuiINIFile; - - -function gGUIINI(const AFileName: string = ''): TtiGuiINIFile; -begin - if uGuiINI = nil then - begin - uGuiINI := TtiGuiINIFile.CreateExt(AFileName); - uGuiINI.CacheUpdates := False; - end; - result := uGuiINI; -end; - -procedure TtiGuiINIFile.ReadFormState(AForm: TfpgForm; AHeight : integer = -1; AWidth : integer = -1); -var - LINISection: string; - LTop: integer; - LLeft: integer; - LHeight: integer; - LWidth: integer; -begin - Assert(AForm <> nil, 'AForm not assigned'); - LINISection := AForm.Name + 'State'; - // Read form position, -1 if not stored in registry - LTop := readInteger(LINISection, 'Top', -1); - LLeft := readInteger(LINISection, 'Left', -1); - // The form pos was found in the ini file - if (LTop <> -1) and (LLeft <> -1) then - begin - AForm.Top := readInteger(LINISection, 'Top', AForm.Top); - AForm.Left := readInteger(LINISection, 'Left', AForm.Left); - AForm.WindowPosition := wpUser; - end - else - begin // No form pos in the ini file, so default to screen center - if Assigned(fpgApplication.MainForm) and (fpgApplication.MainForm <> AForm) then - AForm.WindowPosition := wpAuto - else - AForm.WindowPosition := wpScreenCenter; - end; - - { 2008-11-20 graemeg: disabled Width and Height settings for now. It causes - major headaches, plus in most applications the forms have been designed - with specific sizes for best look and fit. The user can still adjust sizes - at runtime, they will just not be remembered. I will attend to this issue - at a later date. } - // Only set the form size if a bsSizable window - //if AForm.Sizeable then - //begin - //if AHeight = -1 then - //LHeight := AForm.Height - //else - //LHeight := AHeight; - //if AWidth = -1 then - //LWidth := AForm.Width - //else - //LWidth := AWidth; - //AForm.Height := readInteger(LINISection, 'Height', LHeight); - //AForm.Width := readInteger(LINISection, 'Width', LWidth); - //end; - - // If the form is off screen (positioned outside all monitor screens) then - // center the form on screen. - if AForm.WindowPosition = wpUser then - begin - if (AForm.Top < 0) or (AForm.Top > fpgApplication.ScreenHeight) or - (AForm.Left < 0) or (AForm.Left > fpgApplication.ScreenWidth) then - AForm.WindowPosition := wpScreenCenter; - end; -end; - -procedure TtiGuiINIFile.WriteFormState(AForm: TfpgForm); -var - LINISection: string; -begin - LINISection := AForm.Name + 'State'; - WriteInteger(LINISection, 'Top', AForm.Top); - WriteInteger(LINISection, 'Left', AForm.Left); - if AForm.Sizeable then - begin - WriteInteger(LINISection, 'Height', AForm.Height); - WriteInteger(LINISection, 'Width', AForm.Width); - end; -end; - -initialization - uGuiINI := nil; - -finalization - uGuiINI.Free; - -end. - - - - - - - - diff --git a/extras/tiopf/gui/tiGUIUtils.pas b/extras/tiopf/gui/tiGUIUtils.pas deleted file mode 100644 index 86653304..00000000 --- a/extras/tiopf/gui/tiGUIUtils.pas +++ /dev/null @@ -1,18 +0,0 @@ -unit tiGUIUtils; - -{$mode objfpc}{$H+} - -interface - -uses - Classes - ; - - // Mouse cursor routines -// function tiAutoWaitCursor: IUnknown; -// function tiAutoCursor(ACursor: TCursor = crHourglass): IUnknown; - -implementation - -end. - diff --git a/extras/tiopf/gui/tiGenericEditMediators.pas b/extras/tiopf/gui/tiGenericEditMediators.pas deleted file mode 100644 index 6e24fe2e..00000000 --- a/extras/tiopf/gui/tiGenericEditMediators.pas +++ /dev/null @@ -1,974 +0,0 @@ -(* - -Revision history: - 2005-08-17: First release by Graeme Geldenhuys (graemeg@gmail.com) - 2007-08-24: Ported the code to the fpGUI toolkit. [Graeme] - 2008-05-20: Updates due to fpGUI components now being 0-based. [Graeme] - -Purpose: - Abstract mediating view and Mediator Factory. This allows you to use - standard edit components and make them object-aware. See the demo - application for usage. - -ToDo: - * Implement a View Manager class, so we can remove the View Lists - created in each Form using mediating views. - * As soon as TfpgSpinEdit has been implemented, port the SpinEdit mediator - -*) - -unit tiGenericEditMediators; - -{$mode objfpc}{$H+} - -interface -uses - tiObject - ,Classes - ,fpgfx - ,gfx_widget - ,gui_edit - ,gui_checkbox - ,gui_label - ,gui_trackbar - ,gui_combobox - ,gui_memo - ,gui_popupcalendar - ; - -type - TMediatingViewClass = class of TMediatorView; - - { Base class to inherit from to make more customised Mediator Views. } - TMediatorView = class(TtiObject) - private - FSettingUp: Boolean; - FFieldName: string; - FSubject: TtiObject; - FEditControl: TfpgWidget; - FGuiFieldName: string; - FErrorMessage: string; - procedure TestIfValid; - protected - UseInternalOnChange: boolean; - function GetSubject: TtiObject; virtual; - { Used to setup things like the MaxLength of a edit box, etc. } - procedure SetupGUIandObject; virtual; - { Used for doing validation checks and changing the color of edit controls - in error } - procedure UpdateGuiValidStatus(pErrors: TtiObjectErrors); virtual; - function DataAndPropertyValid: Boolean; - procedure DoOnChange(Sender: TObject); virtual; - public - constructor Create; override; - constructor CreateCustom(pEditControl: TfpgWidget; pSubject: TtiObject; pFieldName: string; pGuiFieldName: string = ''); - destructor Destroy; override; - { Copies values from the edit control to the Subject } - procedure GuiToObject; virtual; - { Copies property values from the Subject to the edit control } - procedure ObjectToGui; virtual; - procedure Update(pSubject: TtiObject); override; - { This is what gets called from the edit controls OnChange event, to - trigger a update } - procedure GUIChanged; - { The object being edited or observed } - property Subject: TtiObject read GetSubject write FSubject; - { The edit control used for editing a property of the Subject } - property EditControl: TfpgWidget read FEditControl write FEditControl; - { Not being used at the moment } - property ErrorMessage: string read FErrorMessage write FErrorMessage; - class function ComponentClass: TClass; virtual; abstract; - published - { Property of the Subject being edited } - property FieldName: string read FFieldName write FFieldName; - { Property of the edit control used to get/set the new updated value } - property GuiFieldName: string read FGuiFieldName write FGuiFieldName; - end; - - - { Base class to handle TfpgEdit controls } - TMediatorEditView = class(TMediatorView) - private - function GetEditControl: TfpgEdit; - procedure SetEditControl(const AValue: TfpgEdit); - protected - procedure SetupGUIandObject; override; - procedure UpdateGuiValidStatus(pErrors: TtiObjectErrors); override; - public - constructor CreateCustom(pEditControl: TfpgWidget; pSubject: TtiObject; pFieldName: string; pGuiFieldName: string = 'Text'); reintroduce; - destructor Destroy; override; - property EditControl: TfpgEdit read GetEditControl write SetEditControl; - class function ComponentClass: TClass; override; - end; - - - { Base class to handle TfpgCheckBox controls } - TMediatorCheckBoxView = class(TMediatorView) - private - function GetEditControl: TfpgCheckBox; - procedure SetEditControl(const AValue: TfpgCheckBox); - protected - procedure UpdateGuiValidStatus(pErrors: TtiObjectErrors); override; - public - property EditControl: TfpgCheckBox read GetEditControl write SetEditControl; - class function ComponentClass: TClass; override; - end; - - - { Base class to handle TfpgLabel controls } - TMediatorStaticTextView = class(TMediatorView) - private - function GetEditControl: TfpgLabel; - procedure SetEditControl(const AValue: TfpgLabel); - protected - procedure SetupGUIandObject; override; - public - property EditControl: TfpgLabel read GetEditControl write SetEditControl; - class function ComponentClass: TClass; override; - end; - - - { Base class to handle TSpinEdit controls } -{ - TMediatorSpinEditView = class(TMediatorView) - private - function GetEditControl: TSpinEdit; - procedure OnLostFocus(Sender: TObject); - procedure SetEditControl(const AValue: TSpinEdit); - protected - procedure SetupGUIandObject; override; - procedure UpdateGuiValidStatus(pErrors: TtiObjectErrors); override; - public - property EditControl: TSpinEdit read GetEditControl write SetEditControl; - procedure GuiToObject; override; - class function ComponentClass: TClass; override; - end; -} - - { Base class to handle TfpgTrackBar controls } - TMediatorTrackBarView = class(TMediatorView) - private - function GetEditControl: TfpgTrackBar; - procedure SetEditControl(const AValue: TfpgTrackBar); - public - property EditControl: TfpgTrackBar read GetEditControl write SetEditControl; - class function ComponentClass: TClass; override; - end; - - - { Base class to handle TfpgComboBox controls } - TMediatorComboBoxView = class(TMediatorView) - private - function GetEditControl: TfpgComboBox; - procedure SetEditControl(const AValue: TfpgComboBox); - protected - procedure UpdateGuiValidStatus(pErrors: TtiObjectErrors); override; - public - property EditControl: TfpgComboBox read GetEditControl write SetEditControl; - procedure ObjectToGui; override; - class function ComponentClass: TClass; override; - end; - - - { TComboBox observing a list and setting a Object property } - TMediatorDynamicComboBoxView = class(TMediatorComboBoxView) - private - FList: TtiObjectList; - FExternalOnChange: TNotifyEvent; - procedure SetList(const AValue: TtiObjectList); - procedure InternalListRefresh; - protected - procedure SetOnChangeActive(AValue: Boolean); virtual; - procedure SetupGUIandObject; override; - public - constructor CreateCustom(pList: TtiObjectList; pEditControl: TfpgWidget; pSubject: TtiObject; pFieldName: string); reintroduce; - destructor Destroy; override; - procedure GuiToObject; override; - procedure ObjectToGui; override; - procedure RefreshList; virtual; - property List: TtiObjectList read FList write SetList; - end; - - - { Base class to handle TfpgMemo controls } - TMediatorMemoView = class(TMediatorView) - private - function GetEditControl: TfpgMemo; - procedure SetEditControl(const AValue: TfpgMemo); - protected - procedure SetupGUIandObject; override; - public - property EditControl: TfpgMemo read GetEditControl write SetEditControl; - procedure ObjectToGui; override; - procedure GuiToObject; override; - class function ComponentClass: TClass; override; - end; - - - { Base class to handle TfpgCalendarCombo controls } - TMediatorCalendarComboView = class(TMediatorView) - private - function GetEditControl: TfpgCalendarCombo; - procedure SetEditControl(const AValue: TfpgCalendarCombo); - public - property EditControl: TfpgCalendarCombo read GetEditControl write SetEditControl; - class function ComponentClass: TClass; override; - end; - - - { Data class for mapping a name to a class } - TMediatorViewMapping = class(TObject) - private - FMediatingViewClass: TMediatingViewClass; - FName: string; - public - constructor CreateExt(pName: String; pMediatingClass: TMediatingViewClass); - property Name: string read FName write FName; - property MediatingViewClass: TMediatingViewClass read FMediatingViewClass write FMediatingViewClass; - end; - - - { This is a parameter object, instead of a whole bunch of single parameters } - TMGMEditLink = class(TObject) - private - FEditControl: TfpgWidget; - FEditObject: TtiObject; - FObjectEditProperty: string; - FControlEditProperty: string; - public - property EditControl: TfpgWidget read FEditControl write FEditControl; - property EditObject: TtiObject read FEditObject write FEditObject; - property ObjectEditProperty: string read FObjectEditProperty write FObjectEditProperty; - property ControlEditProperty: string read FControlEditProperty write FControlEditProperty; - end; - - - { Factory class to register and create your mediating views } - TMediatorFactory = class(TObject) - private - MappingList: TStringList; - function FindMediatorClass(pSubject: TtiObject; pComponentClass: TClass; pFieldName: string): TMediatingViewClass; - function GetMediatorClass(pSubject: TtiObject; pComponentClass: TClass; pFieldName: string): TMediatingViewClass; - public - constructor Create; - destructor Destroy; override; - function CreateMediator(pComponent: TfpgWidget; pSubject: TtiObject; pFieldName: String; pGuiFieldName: string): TMediatorView; overload; - function CreateMediator(pEditLink: TMGMEditLink): TMediatorView; overload; -// function FindMediator(pComponent: TControl): TMediatorView; - procedure RegisterMediatorClass(FieldName: string; MediatorClass: TMediatingViewClass); - end; - - - { Simple singelton for the Factory } - function gMediatorFactory: TMediatorFactory; - - -implementation -uses - SysUtils - ,TypInfo - ,tiExcept - ,gui_dialogs // for TfpgMessageDialog - ,tiGUIConstants // for error color - ,gfxbase // for predefined colors - ; - -var - uMediatorFactory: TMediatorFactory; - - -const - cErrorListHasNotBeenAssigned = 'List has not been assigned'; - - -function gMediatorFactory: TMediatorFactory; -begin - if not Assigned(uMediatorFactory) then - uMediatorFactory := TMediatorFactory.Create; - result := uMediatorFactory; -end; - - -{ TMediatorView } - -constructor TMediatorView.Create; -begin - inherited; - FSettingUp := True; - UseInternalOnChange := True; -end; - -constructor TMediatorView.CreateCustom(pEditControl: TfpgWidget; pSubject: TtiObject; pFieldName: string; pGuiFieldName: string); -begin - Create; - FSubject := pSubject; - FFieldName := pFieldName; - FGuiFieldName := pGuiFieldName; - FEditControl := pEditControl; - FSubject.AttachObserver(self); - SetupGUIandObject; - - // I prefer to do this once in the form after all mediator are created. -// FSubject.NotifyObservers; - FSettingUp := False; -end; - -destructor TMediatorView.Destroy; -begin - if Assigned(FSubject) then - FSubject.DetachObserver(self); - inherited Destroy; -end; - -procedure TMediatorView.GUIChanged; -begin - if not FSettingUp then - begin - GuiToObject; - TestIfValid; - end; -end; - -procedure TMediatorView.UpdateGuiValidStatus(pErrors: TtiObjectErrors); -begin - { These lines reset the EditControl in the case of no errors, but will be - further implemented by a concrete class } - EditControl.Hint := ''; -end; - -function TMediatorView.DataAndPropertyValid: Boolean; -begin - result := (FSubject <> nil) and (FFieldName <> ''); - if not result then - Exit; //==> - - result := (IsPublishedProp(FSubject, FFieldName)); - - if not result then - raise Exception.CreateFmt('<%s> is not a property of <%s>', - [FFieldName, FSubject.ClassName ]); - -// EditControl.ReadOnly := ReadOnly or IsPropReadOnly; -end; - -procedure TMediatorView.DoOnChange(Sender: TObject); -begin - GUIChanged; -end; - -procedure TMediatorView.TestIfValid; -var - Errors: TtiObjectErrors; -begin - Errors := TtiObjectErrors.Create; - try - Subject.IsValid(Errors); - UpdateGuiValidStatus(Errors); // always execute this as it also resets EditControl - finally - Errors.Free; - end; -end; - -procedure TMediatorView.Update(pSubject: TtiObject); -begin - inherited; - ObjectToGui; - TestIfValid; -end; - -function TMediatorView.GetSubject: TtiObject; -begin - Result := FSubject; -end; - -procedure TMediatorView.GuiToObject; -begin - Subject.PropValue[FieldName] := TypInfo.GetPropValue(FEditControl, GuiFieldName); -end; - -procedure TMediatorView.ObjectToGui; -begin - TypInfo.SetPropValue(FEditControl, GuiFieldName, Subject.PropValue[FieldName]); -end; - -procedure TMediatorView.SetupGUIandObject; -begin - { do nothing here } -end; - - -{ TMediatorFactory } - -constructor TMediatorFactory.Create; -begin - MappingList := TStringList.Create; -end; - -function TMediatorFactory.CreateMediator(pComponent: TfpgWidget; pSubject: TtiObject; - pFieldName: string; pGuiFieldName: string): TMediatorView; -var - MediatorClass: TMediatingViewClass; -begin - if not Assigned(pComponent) then - raise Exception.Create('TMediatorFactory.CreateMediator: pComponent is not assigned'); - if not Assigned(pSubject) then - raise Exception.Create('TMediatorFactory.CreateMediator: pSubject is not assigned'); - - MediatorClass := GetMediatorClass( - pSubject, - pComponent.ClassType, - pFieldName ); - result := MediatorClass.CreateCustom( - pComponent, - pSubject, - pFieldName, - pGuiFieldName ); - pSubject.AttachObserver( result ); -end; - -function TMediatorFactory.CreateMediator(pEditLink: TMGMEditLink): TMediatorView; -var - MediatorClass: TMediatingViewClass; -begin - MediatorClass := GetMediatorClass( - pEditLink.EditObject, - pEditLink.EditControl.ClassType, - pEditLink.ObjectEditProperty ); - result := MediatorClass.CreateCustom( - pEditLink.EditControl, - pEditLink.EditObject, - pEditLink.ObjectEditProperty, - pEditLink.ControlEditProperty ); - pEditLink.EditObject.AttachObserver( Result ); -end; - - -destructor TMediatorFactory.Destroy; -var - i: integer; -begin - for i := 0 to MappingList.Count -1 do - TObject(MappingList.Objects[i]).Free; - MappingList.Free; - inherited; -end; - - -function TMediatorFactory.FindMediatorClass(pSubject: TtiObject; pComponentClass: TClass; pFieldName: string): TMediatingViewClass; -const - cName = '%s.%s.%s'; { Subject Classname, FieldName, Edit control name } -var - i: Integer; - lName: string; -begin - { Get the name formatting correct } - lName := Format(cName, [UpperCase(pSubject.ClassName), UpperCase(pFieldName), UpperCase(pComponentClass.ClassName)]); - { Does the Type exist in the list? } - i := MappingList.IndexOf(lName); - if i <> -1 then - Result := TMediatorViewMapping(MappingList.Objects[i]).MediatingViewClass - else - Result := nil; -end; - - -function TMediatorFactory.GetMediatorClass(pSubject: TtiObject; pComponentClass: TClass; pFieldName: string): TMediatingViewClass; -begin - Result := FindMediatorClass(pSubject, pComponentClass, pFieldName); - if not Assigned(Result) then - raise Exception.Create('No mediator registered for:' + LineEnding + - ' Component: ' + pComponentClass.ClassName + LineEnding + - ' FieldName: ' + pSubject.ClassName + '.' + pFieldName); -end; - - -procedure TMediatorFactory.RegisterMediatorClass(FieldName: string; MediatorClass: TMediatingViewClass); -const - cName = '%s.%s'; -var - lName: String; - i: Integer; - lMapping: TMediatorViewMapping; -begin - lName := Format(cName, [UpperCase(FieldName), UpperCase(MediatorClass.ComponentClass.ClassName)]); - { Does the Medator mapping already exist? } - i := MappingList.IndexOf( lName ); - if i <> -1 then - begin { If yes, notify the user } - { We cannot raise an exception as this will be called in the Initialization - section of a unit. FPC's exception handling may not have been loaded yet! } - TfpgMessageDialog.Information('', - 'Registering a duplicate Mediator View Type <' + FieldName + '> with ' + ClassName); - end - else - begin { If no, then add it to the list } - lMapping := TMediatorViewMapping.CreateExt( lName, MediatorClass ); - MappingList.AddObject( lName, lMapping ); - end; -end; - - -{ TMediatorEditView } - -function TMediatorEditView.GetEditControl: TfpgEdit; -begin - Result := TfpgEdit(FEditControl); -end; - -procedure TMediatorEditView.SetEditControl(const AValue: TfpgEdit); -begin - FEditControl := AValue; -end; - -procedure TMediatorEditView.SetupGUIandObject; -begin - inherited SetupGUIandObject; -end; - -procedure TMediatorEditView.UpdateGuiValidStatus(pErrors: TtiObjectErrors); -var - oError: TtiObjectError; -begin - inherited UpdateGuiValidStatus(pErrors); - - oError := pErrors.FindByErrorProperty(FieldName); - if oError <> nil then - begin - EditControl.BackgroundColor := clError; - EditControl.Hint := oError.ErrorMessage; - end - else - begin - EditControl.BackgroundColor := clBoxColor; - EditControl.Hint := ''; - end; -end; - -constructor TMediatorEditView.CreateCustom(pEditControl: TfpgWidget; - pSubject: TtiObject; pFieldName: string; pGuiFieldName: string); -begin - inherited; -end; - -destructor TMediatorEditView.Destroy; -begin - if Assigned(EditControl.OnChange) then - EditControl.OnChange := nil; - inherited Destroy; -end; - -class function TMediatorEditView.ComponentClass: TClass; -begin - Result := TfpgEdit; -end; - - -{ TMediatorSpinEditView} -(* -class function TMediatorSpinEditView.ComponentClass: TClass; -begin - Result := TSpinEdit; -end; - - -procedure TMediatorSpinEditView.GuiToObject; -begin - { Control is busy clearing the value before replacing it with what the user - typed. } - if (TSpinEdit(EditControl).Text = '') then - Exit; //==> - - { continue as normal } - inherited; -end; - -function TMediatorSpinEditView.GetEditControl: TSpinEdit; -begin - Result := TSpinEdit(FEditControl); -end; - -procedure TMediatorSpinEditView.OnLostFocus(Sender: TObject); -begin - if (TSpinEdit(EditControl).Text = '') then - begin - { Default the EditControl to a valid value } - TSpinEdit(EditControl).Value := 0; - GUIChanged; - end; -end; - -procedure TMediatorSpinEditView.SetEditControl(const AValue: TSpinEdit); -begin - FEditControl := AValue; -end; - - -procedure TMediatorSpinEditView.SetupGUIandObject; -begin - inherited; - TSpinEdit(EditControl).Text := ''; - TSpinEdit(EditControl).OnExit := OnLostFocus; -end; - -procedure TMediatorSpinEditView.UpdateGuiValidStatus(pErrors: TtiObjectErrors); -var - oError: TtiObjectError; -begin - inherited UpdateGuiValidStatus(pErrors); - - oError := pErrors.FindByErrorProperty(FieldName); - if oError <> nil then - begin - EditControl.Color := clError; - EditControl.Hint := oError.ErrorMessage; - end - else - begin - EditControl.Color := ColorToRGB(clWindow); - EditControl.Hint := ''; - end; -end; -*) - -{ TMediatorTrackBarView} - -function TMediatorTrackBarView.GetEditControl: TfpgTrackBar; -begin - Result := TfpgTrackBar(FEditControl); -end; - -procedure TMediatorTrackBarView.SetEditControl(const AValue: TfpgTrackBar); -begin - FEditControl := AValue; -end; - -class function TMediatorTrackBarView.ComponentClass: TClass; -begin - Result := TfpgTrackBar; -end; - - -{ TMediatorComboBoxView } - -class function TMediatorComboBoxView.ComponentClass: TClass; -begin - Result := TfpgComboBox; -end; - -function TMediatorComboBoxView.GetEditControl: TfpgComboBox; -begin - result := TfpgComboBox(FEditControl); -end; - -procedure TMediatorComboBoxView.SetEditControl(const AValue: TfpgComboBox); -begin - FEditControl := AValue; -end; - -procedure TMediatorComboBoxView.UpdateGuiValidStatus(pErrors: TtiObjectErrors); -var - oError: TtiObjectError; -begin - inherited UpdateGuiValidStatus(pErrors); - - oError := pErrors.FindByErrorProperty(FieldName); - if oError <> nil then - begin - EditControl.BackgroundColor := clError; - EditControl.Hint := oError.ErrorMessage; - end - else - begin - EditControl.BackgroundColor := clBoxColor; - EditControl.Hint := ''; - end; -end; - -procedure TMediatorComboBoxView.ObjectToGui; -begin - EditControl.FocusItem := - EditControl.Items.IndexOf(Subject.PropValue[FieldName]); -end; - - -{ TMediatorMemoView } - -class function TMediatorMemoView.ComponentClass: TClass; -begin - Result := TfpgMemo; -end; - -procedure TMediatorMemoView.GuiToObject; -begin - Subject.PropValue[FieldName] := EditControl.Lines.Text; -end; - -procedure TMediatorMemoView.ObjectToGui; -begin - EditControl.Lines.Text := Subject.PropValue[FieldName]; -end; - -function TMediatorMemoView.GetEditControl: TfpgMemo; -begin - Result := TfpgMemo(FEditControl); -end; - -procedure TMediatorMemoView.SetEditControl(const AValue: TfpgMemo); -begin - FEditControl := AValue; -end; - -procedure TMediatorMemoView.SetupGUIandObject; -begin - inherited; - EditControl.Lines.Clear; -// EditControl.ScrollBars := ssVertical; -// EditControl.WordWrap := True; -end; - - -{ TMediatorViewMapping } - -constructor TMediatorViewMapping.CreateExt(pName: String; pMediatingClass: TMediatingViewClass); -begin - Create; - Name := pName; - MediatingViewClass := pMediatingClass; -end; - - -{ TMediatorDynamicComboBoxView } - -procedure TMediatorDynamicComboBoxView.SetList(const AValue: TtiObjectList); -begin - if FList = AValue then - Exit; //==> - FList := AValue; - InternalListRefresh; -end; - -procedure TMediatorDynamicComboBoxView.InternalListRefresh; -var - lItems: TStrings; - i: Integer; -begin - lItems := EditControl.Items; - lItems.Clear; - EditControl.Text := ''; - - if (FList = nil) or - (FList.Count < 1) or - (SameText(FFieldName, EmptyStr)) then - Exit; //==> - - try - for i := 0 to FList.Count - 1 do - begin - lItems.Add(FList.Items[i].Caption); - end; - except - on E: Exception do - raise Exception.CreateFmt('Error adding list items to combobox ' + - 'Message: %s, Item Property Name: %s', - [E.message, FFieldName]); - end; - - ObjectToGui; -end; - -procedure TMediatorDynamicComboBoxView.SetOnChangeActive(AValue: Boolean); -begin - if AValue then - begin - if not UseInternalOnChange then - EditControl.OnChange := FExternalOnChange - else - EditControl.OnChange := @DoOnChange; - end - else - begin - if not UseInternalOnChange then - FExternalOnChange := EditControl.OnChange; - EditControl.OnChange := nil; - end; -end; - -procedure TMediatorDynamicComboBoxView.SetupGUIandObject; -begin - inherited SetupGUIandObject; - - if UseInternalOnChange then - EditControl.OnChange := @DoOnChange; // default OnChange event handler - - EditControl.Enabled := (FList.Count > 0); -end; - -constructor TMediatorDynamicComboBoxView.CreateCustom(pList: TtiObjectList; - pEditControl: TfpgWidget; pSubject: TtiObject; pFieldName: string); -begin - Create; - FGuiFieldName := 'Text'; // TfpgComboBox defaults to Text property - - FSubject := pSubject; - FFieldName := pFieldName; - FEditControl := pEditControl; - - if Assigned(EditControl.OnChange) then - UseInternalOnChange := False; - - { This will fire a refresh } - List := pList; - - FSubject.AttachObserver(self); - SetupGUIandObject; - - // I prefer to do this once in the form after all mediator are created. -// FSubject.NotifyObservers; - FSettingUp := False; -end; - -destructor TMediatorDynamicComboBoxView.Destroy; -begin - FList := nil; - inherited Destroy; -end; - -procedure TMediatorDynamicComboBoxView.GuiToObject; -var - lValue: TtiObject; - lPropType: TTypeKind; -begin - if not DataAndPropertyValid then - Exit; //==> - if EditControl.FocusItem < 0 then - Exit; //==> - - lValue := TtiObject(FList.Items[EditControl.FocusItem]); - - lPropType := typinfo.PropType(Subject, FieldName); - if lPropType = tkClass then - typinfo.SetObjectProp(Subject, FieldName, lValue) - else - raise EtiOPFProgrammerException.Create('Error property type not a Class'); -end; - -procedure TMediatorDynamicComboBoxView.ObjectToGui; -var - i: Integer; - lValue: TtiObject; - lPropType: TTypeKind; -begin - SetOnChangeActive(false); - - // Set the index only (We're assuming the item is present in the list) - EditControl.FocusItem := -1; - if FSubject = nil then - Exit; //==> - - if not Assigned(FList) then - raise EtiOPFProgrammerException.Create(cErrorListHasNotBeenAssigned); - - lPropType := typinfo.PropType(Subject, FieldName); - if lPropType = tkClass then - lValue := TtiObject(typinfo.GetObjectProp(Subject, FieldName)) - else - raise Exception.Create('Property is not a class type!'); - - for i := 0 to FList.Count - 1 do - if FList.Items[i] = lValue then - begin - EditControl.FocusItem := i; - Break; //==> - end; - - SetOnChangeActive(true); -end; - -procedure TMediatorDynamicComboBoxView.RefreshList; -begin - InternalListRefresh; -end; - -{ TMediatorCheckBoxView } - -function TMediatorCheckBoxView.GetEditControl: TfpgCheckBox; -begin - Result := TfpgCheckBox(FEditControl); -end; - -procedure TMediatorCheckBoxView.SetEditControl(const AValue: TfpgCheckBox); -begin - FEditControl := AValue; -end; - -procedure TMediatorCheckBoxView.UpdateGuiValidStatus(pErrors: TtiObjectErrors); -var - oError: TtiObjectError; -begin - inherited UpdateGuiValidStatus(pErrors); - - oError := pErrors.FindByErrorProperty(FieldName); - if oError <> nil then - begin - EditControl.BackgroundColor := clError; - EditControl.Hint := oError.ErrorMessage; - end - else - begin - EditControl.BackgroundColor := clWindowBackground; - EditControl.Hint := ''; - end; -end; - -class function TMediatorCheckBoxView.ComponentClass: TClass; -begin - Result := TfpgCheckBox; -end; - -{ TMediatorStaticTextView } - -function TMediatorStaticTextView.GetEditControl: TfpgLabel; -begin - Result := TfpgLabel(FEditControl); -end; - -procedure TMediatorStaticTextView.SetEditControl(const AValue: TfpgLabel); -begin - FEditControl := AValue; -end; - -procedure TMediatorStaticTextView.SetupGUIandObject; -begin - inherited SetupGUIandObject; - EditControl.Text := ''; -end; - -class function TMediatorStaticTextView.ComponentClass: TClass; -begin - Result := TfpgLabel; -end; - -{ TMediatorCalendarComboView } - -function TMediatorCalendarComboView.GetEditControl: TfpgCalendarCombo; -begin - Result := TfpgCalendarCombo(FEditControl); -end; - -procedure TMediatorCalendarComboView.SetEditControl(const AValue: TfpgCalendarCombo); -begin - FEditControl := AValue; -end; - -class function TMediatorCalendarComboView.ComponentClass: TClass; -begin - Result := TfpgCalendarCombo; -end; - - -initialization -finalization - gMediatorFactory.Free; - -end. - diff --git a/extras/tiopf/gui/tiGenericListMediators.pas b/extras/tiopf/gui/tiGenericListMediators.pas deleted file mode 100644 index faa8de95..00000000 --- a/extras/tiopf/gui/tiGenericListMediators.pas +++ /dev/null @@ -1,583 +0,0 @@ -(* - -Revision history: - - 2005-09-01: First release by Graeme Geldenhuys (graemeg@gmail.com) - 2007-08-27: Ported the code to the fpGUI toolkit. [Graeme] - 2008-05-20: Updates due to fpGUI components now being 0-based. [Graeme] - - -Purpose: - Abstract mediating views for GUI list controls. This allows you to use - standard list components and make them object-aware. See the demo - application for usage. - -ToDo: - * Unit tests - * More refactoring - * Implement a View Manager class, so we can remove the View Lists - created in each Form using mediating views. - * TfpgListView mediator implementation - I first need to double check how - far the TfpgListView control itself has been implemented. - -*) - -unit tiGenericListMediators; - -{$mode objfpc}{$H+} - -interface -uses - tiObject - ,tiGenericEditMediators - ,gfx_widget - ,gui_listbox - ,gui_combobox - ,gui_listview - ,gui_menu - ,Classes - ; - - -type - { Used so we know what needs updating, the Internal List, or just the - Selected Object. } - TUpdateMode = (umSelectedObject, umObjectList); - - - { Abstract class that observes a list object } - - TListMediator = class(TtiObject) - private - FObjectList: TtiObjectList; - FControl: TfpgWidget; - FSelectedObject: TtiObject; - FShowDeleted: Boolean; - procedure SetShowDeleted(const Value: Boolean); - protected - FObserversInTransit: TList; - FUpdateMode: TUpdateMode; - FPopupMenu: TfpgPopupMenu; - procedure SetSelectedObject(const Value: TtiObject); virtual; - function GetModel: TtiObjectList; virtual; - procedure SetModel(const Value: TtiObjectList); virtual; - function GetView: TfpgWidget; virtual; - procedure SetView(const Value: TfpgWidget); virtual; - procedure RebuildList; virtual; abstract; - { Used to setup things like the MaxLength of a edit box, etc. } - procedure SetupGUIandObject; virtual; - procedure BuildPopupMenu; virtual; - public - constructor Create; override; - constructor CreateCustom(pObjectList: TtiObjectList; pView: TfpgWidget); virtual; - destructor Destroy; override; - procedure Update(pSubject: TtiObject); override; - { Called from GUI to trigger events } - procedure HandleDeleteItem; virtual; - procedure HandleListChanged; virtual; - procedure HandleSelectionChanged; virtual; abstract; - procedure MenuItemAddClick(Sender: TObject); virtual; - procedure MenuItemEditClick(Sender: TObject); virtual; - procedure MenuItemDeleteClick(Sender: TObject); virtual; - // - property SelectedObject: TtiObject read FSelectedObject write SetSelectedObject; - property ShowDeleted: Boolean read FShowDeleted write SetShowDeleted; - property Model: TtiObjectList read GetModel write SetModel; - property View: TfpgWidget read GetView; - end; - - - { Observes a list object - TfpgListBox } - - TListBoxMediator = class(TListMediator) - private - OldPos: Integer; - NewPos: Integer; - protected - procedure SetSelectedObject(const Value: TtiObject); override; - function GetView: TfpgListBox; reintroduce; - procedure RebuildList; override; - procedure SaveBookmark; - procedure RestoreBookmark; - public - procedure HandleSelectionChanged; override; - published - property View: TfpgListBox read GetView; - end; - - - { Observes a list object - TfpgComboBox } - - TComboBoxMediator = class(TListMediator) - protected - procedure SetSelectedObject(const Value: TtiObject); override; - function GetView: TfpgComboBox; reintroduce; - procedure RebuildList; override; - public - procedure HandleSelectionChanged; override; - published - property View: TfpgComboBox read GetView; - end; - - - { Observes a list object - TListView } -(* - TListViewMediator = class(TListMediator) - protected - function GetView: TfpgListView; reintroduce; - procedure RebuildList; override; - public - procedure HandleSelectionChanged; override; - published - property View: TfpgListView read GetView; - end; -*) - -implementation -uses - SysUtils - ; - - -{ TListBoxMediator } - -procedure TListBoxMediator.SetSelectedObject(const Value: TtiObject); -var - i: integer; -begin - inherited SetSelectedObject(Value); - - if Value = nil then - begin - View.FocusItem := -1; - Exit; //==> - end; - - for i := 0 to Model.Count-1 do - begin - if Value.OID.AsString = Model.Items[i].OID.AsString then - begin - View.FocusItem := i; - Break; //==> - end; - end; -end; - -function TListBoxMediator.GetView: TfpgListBox; -begin - result := TfpgListBox(inherited GetView); -end; - -procedure TListBoxMediator.HandleSelectionChanged; -var - i: integer; -begin - if View.FocusItem = -1 then - FSelectedObject := nil - else - begin - { If an item is already selected, assign the item's List of observers to a - temporary container. This is done so that the same observers can be - assigned to the new item. } - if Assigned(FSelectedObject) then - FObserversInTransit.Assign(FSelectedObject.ObserverList); - - // Assign Newly selected item to SelectedObject Obj. - FSelectedObject := TtiObject(View.Items.Objects[View.FocusItem]); - - { If an object was selected, copy the old item's observer List - to the new item's observer List. } - if FObserversInTransit.Count > 0 then - FSelectedObject.ObserverList.Assign(FObserversInTransit); - - { set the observers's Subject property to the selected object } - for i := 0 to FSelectedObject.ObserverList.Count-1 do - begin - TMediatorView(FSelectedObject.ObserverList.Items[i]).Subject := - FSelectedObject; - end; - - // execute the NotifyObservers event to update the observers. - FSelectedObject.NotifyObservers; - end; -end; - - -procedure TListBoxMediator.RebuildList; -var - i: Integer; - ptr: TNotifyEvent; - selected: integer; -begin - selected := -1; - if (Model.CountNotDeleted) >= View.FocusItem+1 then - begin - selected := View.FocusItem; - end; - - ptr := View.OnChange; - View.OnChange := nil; - View.BeginUpdate; - try - View.Items.Clear; - for i := 0 to Model.Count-1 do - begin - if (not Model.Items[i].Deleted) or - (ShowDeleted and Model.Items[i].Deleted) then - begin - View.Items.AddObject(Model.Items[i].Caption, Model.Items[i]); - end; - end; - if Model.CountNotDeleted > 0 then - begin - if selected = -1 then - selected := 0; - View.FocusItem := selected; - end; - finally - View.EndUpdate; - View.Update; - View.OnChange := ptr; - HandleSelectionChanged; - end; -end; - - -procedure TListBoxMediator.RestoreBookmark; -begin - if OldPos > View.Items.Count-1 then - NewPos := View.Items.Count-1 - else - NewPos := OldPos; - View.FocusItem := NewPos; - HandleSelectionChanged; -end; - -procedure TListBoxMediator.SaveBookmark; -begin - OldPos := View.FocusItem; -end; - - -{ TComboBoxMediator } - -procedure TComboBoxMediator.SetSelectedObject(const Value: TtiObject); -var - i: integer; -begin - inherited SetSelectedObject(Value); - if Value = nil then - begin - View.FocusItem := -1; - Exit; //==> - end; - - for i := 0 to Model.Count-1 do - begin - if Value = Model.Items[i] then - begin - View.FocusItem := i; - exit; //==> - end; - end; -end; - -function TComboBoxMediator.GetView: TfpgComboBox; -begin - result := TfpgComboBox(inherited GetView); -end; - - -procedure TComboBoxMediator.HandleSelectionChanged; -var - i: integer; -begin - if View.FocusItem = -1 then - SelectedObject := nil - else - begin - if Assigned(SelectedObject) then - FObserversInTransit.Assign(SelectedObject.ObserverList); - - SelectedObject := TtiObject(View.Items.Objects[View.FocusItem]); - - if FObserversInTransit.Count > 0 then - SelectedObject.ObserverList.Assign(FObserversInTransit); - - for i := 0 to SelectedObject.ObserverList.Count-1 do - begin - TMediatorView(SelectedObject.ObserverList.Items[i]).Subject := - SelectedObject; - end; - - SelectedObject.NotifyObservers; - end; -end; - - -procedure TComboBoxMediator.RebuildList; -var - i: Integer; - ptr: TNotifyEvent; - selected: integer; -begin - selected := -1; - if Model.CountNotDeleted >= View.FocusItem+1 then - selected := View.FocusItem; - - ptr := View.OnChange; - View.OnChange := nil; - View.Items.BeginUpdate; - try - View.Items.Clear; - for i := 0 to Model.Count-1 do - begin - if (not Model.Items[i].Deleted) or - (ShowDeleted and Model.Items[i].Deleted) then - begin - View.Items.AddObject( Model.Items[i].Caption, Model.Items[i] ); - end; - end; - if Model.CountNotDeleted > 0 then - begin - if selected = -1 then - selected := 0; - View.FocusItem := selected; - end; - finally - View.Items.EndUpdate; - View.FocusItem := 0; - View.OnChange := ptr; - HandleSelectionChanged; - end; -end; - - -{ TListViewMediator } - -(* -function TListViewMediator.GetView: TfpgListView; -begin - result := TfpgListView(inherited GetView); -end; - - -procedure TListViewMediator.HandleSelectionChanged; -var - i: integer; -begin - if not Assigned(View.Selected) then - SelectedObject := nil - else - begin - if Assigned(SelectedObject) then // and Assigned(SelectedObject.ObserverList) - FObserversInTransit.Assign( SelectedObject.ObserverList); - - SelectedObject := TtiObject(View.Selected.Data); - - if FObserversInTransit.Count > 0 then - SelectedObject.ObserverList.Assign(FObserversInTransit); - - for i := 0 to SelectedObject.ObserverList.Count - 1 do - begin - TMediatorView(SelectedObject.ObserverList.Items[i]).Subject := - SelectedObject; - end; - - SelectedObject.NotifyObservers; - end; -end; - - -procedure TListViewMediator.RebuildList; -var - i: Integer; - lItem: TListItem; - ptr: TLVChangeEvent; -begin - ptr := View.OnChange; - View.OnChange := nil; - {$IFDEF FPC} - View.BeginUpdate; - {$ELSE} - View.Items.BeginUpdate; - {$ENDIF} - try - View.Items.Clear; - for i := 0 to Pred(Model.Count) do - begin - if (not Model.Items[i].Deleted) or - (ShowDeleted and Model.Items[i].Deleted) then - begin - lItem := View.Items.Add; - lItem.Caption := Model.Items[i].Caption; - lItem.Data := Model.Items[i]; - end; - end; - if Model.CountNotDeleted > 0 then - begin - SelectedObject := Model.Items[0]; - View.Selected := View.Items[0]; - end; - finally - {$IFDEF FPC} - View.EndUpdate; - {$ELSE} - View.Items.EndUpdate; - {$ENDIF} - View.OnChange := ptr; - HandleSelectionChanged; - end; -end; -*) - -{ TListMediator } - -procedure TListMediator.BuildPopupMenu; -begin - FPopupMenu := TfpgPopupMenu.Create(View); - FPopupMenu.AddMenuItem('Add', '', @MenuItemAddClick); - FPopupMenu.AddMenuItem('Edit', '', @MenuItemEditClick); - FPopupMenu.AddMenuItem('Delete', '', @MenuItemDeleteClick); -end; - - -constructor TListMediator.Create; -begin - inherited; - FObserversInTransit := TList.Create; - FShowDeleted := False; - { This is under construction. } - FUpdateMode := umObjectList; -end; - - -constructor TListMediator.CreateCustom(pObjectList: TtiObjectList; pView: TfpgWidget); -begin - Create; - Model := pObjectList; - FControl := pView; - BuildPopupMenu; - Model.AttachObserver(self); - SetupGUIandObject; - - // I prefer to do this once in the form after all mediator are created. - Model.NotifyObservers; -end; - - -destructor TListMediator.Destroy; -begin - FObserversInTransit.Free; - Model.DetachObserver(self); - inherited; -end; - - -function TListMediator.GetModel: TtiObjectList; -begin - Result := FObjectList; -end; - - -function TListMediator.GetView: TfpgWidget; -begin - Result := FControl; -end; - - -procedure TListMediator.HandleDeleteItem; -begin - if not Assigned(SelectedObject) then - Exit; //==> - - BeginUpdate; - try - SelectedObject.Deleted := True; - RebuildList; - finally - EndUpdate; - end; -end; - - -procedure TListMediator.HandleListChanged; -begin - BeginUpdate; - try - RebuildList; - finally - EndUpdate; - end; -end; - - -procedure TListMediator.MenuItemAddClick(Sender: TObject); -begin - { do nothing here } -end; - - -procedure TListMediator.MenuItemDeleteClick(Sender: TObject); -begin - { do nothing here } -end; - - -procedure TListMediator.MenuItemEditClick(Sender: TObject); -begin - { do nothing here } -end; - - -procedure TListMediator.SetModel(const Value: TtiObjectList); -begin - FObjectList := Value; -// if FObjectList.Count > 0 then -// FSelectedObject := FObjectList.Items[0]; -end; - - -procedure TListMediator.SetSelectedObject(const Value: TtiObject); -begin - FSelectedObject := Value; -end; - - -procedure TListMediator.SetShowDeleted(const Value: Boolean); -begin - BeginUpdate; - try - FShowDeleted := Value; - RebuildList; - finally - EndUpdate; - end; -end; - - -procedure TListMediator.SetView(const Value: TfpgWidget); -begin - FControl := Value; -end; - - -procedure TListMediator.SetupGUIandObject; -begin - { Do nothing. Can be implemented in decendant classes. } -end; - - -procedure TListMediator.Update(pSubject: TtiObject); -begin - BeginUpdate; - try -// inherited Update(pSubject); - RebuildList; - finally - EndUpdate - end; -end; - - -end. diff --git a/extras/tiopf/gui/tiListMediators.pas b/extras/tiopf/gui/tiListMediators.pas deleted file mode 100644 index a89e32df..00000000 --- a/extras/tiopf/gui/tiListMediators.pas +++ /dev/null @@ -1,780 +0,0 @@ -{ - Abstract mediating views for GUI list controls. This allows you to use - standard list components and make them object-aware. See the demo - application for usage. -} -unit tiListMediators; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, - SysUtils, - tiBaseMediator, - fpg_listview, - fpg_grid, - fpg_listbox, - tiObject; - -type - { Composite mediator for TfpgListView } - TtiListViewMediatorView = class(TtiCustomListMediatorView) - private - FObserversInTransit: TList; - protected - function GetSelectedObject: TtiObject; override; - procedure SetSelectedObject(const AValue: TtiObject); override; - procedure CreateColumns; override; - function DoCreateItemMediator(AData: TtiObject; ARowIdx: integer): TtiListItemMediator; override; - procedure DoDeleteItemMediator(AIndex: Integer; AMediator: TtiListItemMediator); override; - procedure SetupGUIandObject; override; - procedure ClearList; override; - procedure RebuildList; override; - procedure SetActive(const AValue: Boolean); override; - public - constructor CreateCustom(AModel: TtiObjectList; AView: TfpgListView; ADisplayNames: string; AIsObserving: Boolean = True); overload; - constructor CreateCustom(AModel: TtiObjectList; AView: TfpgListView; AOnBeforeSetupField: TtiOnBeforeSetupField; ADisplayNames: string; AIsObserving: Boolean = True); overload; - class function ComponentClass: TClass; override; - constructor Create; override; - destructor Destroy; override; - function View: TfpgListView; reintroduce; - procedure HandleSelectionChanged; override; - function GetObjectFromItem(AItem: TfpgLVItem): TtiObject; - end; - - - { Composite mediator for TfpgStringGrid } - TtiStringGridMediatorView = class(TtiCustomListMediatorView) - private - function DoCreateItemMediator(AData: TtiObject; ARowIdx: integer): TtiListItemMediator; override; - procedure DoDeleteItemMediator(AIndex: Integer; AMediator: TtiListItemMediator); override; - protected - function GetSelectedObject: TtiObject; override; - procedure SetSelectedObject(const AValue: TtiObject); override; - procedure CreateColumns; override; - procedure SetupGUIandObject; override; - procedure ClearList; override; - procedure RebuildList; override; - procedure SetActive(const AValue: Boolean); override; - public - constructor CreateCustom(AModel: TtiObjectList; AGrid: TfpgStringGrid; ADisplayNames: string; AIsObserving: Boolean = True); reintroduce; overload; - destructor Destroy; override; - class function ComponentClass: TClass; override; - function GetObjectFromRow(ARow: Integer): TtiObject; - function View: TfpgStringGrid; reintroduce; - end; - - - { Used internally for sub-mediators in ListView mediator. Moved to interface - section so it can be overridden. } - TtiListViewListItemMediator = class(TtiListItemMediator) - private - FView: TfpgLVItem; - procedure SetupFields; virtual; - public - constructor CreateCustom(AModel: TtiObject; AView: TfpgLVItem; const AFieldsInfo: TtiMediatorFieldInfoList; IsObserving: Boolean = True); reintroduce; overload; - constructor CreateCustom(AModel: TtiObject; AView: TfpgLVItem; AOnBeforeSetupField: TtiOnBeforeSetupField; const AFieldsInfo: TtiMediatorFieldInfoList; IsObserving: Boolean = True); reintroduce; overload; - procedure BeforeDestruction; override; - procedure Update(ASubject: TtiObject); override; - published - property View: TfpgLVItem read FView; - end; - - - { Used internally for sub-mediators in StringGrid mediator. Moved to interface - section so it can be overridden. } - TtiStringGridRowMediator = class(TtiListItemMediator) - private - FView: TfpgStringGrid; - FRowIndex: integer; - public - constructor CreateCustom(AModel: TtiObject; AGrid: TfpgStringGrid; const AFieldsInfo: TtiMediatorFieldInfoList; ARowIndex: integer; IsObserving: Boolean = True); - procedure Update(ASubject: TtiObject); override; - published - property View: TfpgStringGrid read FView; - property RowIndex: integer read FRowIndex; - end; - - - { Composite mediator for TfpgListBox } - TtiListBoxListMediatorView = class(TtiCustomListMediatorView) - private - function DoCreateItemMediator(AData: TtiObject; ARowIdx: integer): TtiListItemMediator; override; - procedure DoDeleteItemMediator(AIndex: Integer; AMediator: TtiListItemMediator); override; - protected - function GetSelectedObject: TtiObject; override; - procedure SetSelectedObject(const AValue: TtiObject); override; - procedure CreateColumns; override; - procedure ClearList; override; - procedure RebuildList; override; - procedure SetupGUIandObject; override; - public - constructor CreateCustom(AModel: TtiObjectList; AListBox: TfpgListBox; ADisplayNames: string; AIsObserving: Boolean = True); reintroduce; overload; - destructor Destroy; override; - class function ComponentClass: TClass; override; - function GetObjectFromRow(ARow: Integer): TtiObject; - function View: TfpgListBox; reintroduce; - end; - - { Used internally for sub-mediators in ListBox mediator. Moved to interface - section so it can be overridden. } - TtiListBoxItemMediator = class(TtiListItemMediator) - private - FView: TfpgListBox; - FRowIndex: integer; - public - constructor CreateCustom(AModel: TtiObject; AListBox: TfpgListBox; const AFieldsInfo: TtiMediatorFieldInfoList; ARowIndex: integer; IsObserving: Boolean = True); - procedure Update(ASubject: TtiObject); override; - published - property View: TfpgListBox read FView; - property RowIndex: integer read FRowIndex; - end; - - -procedure RegisterFallBackListMediators; - - -implementation - -uses - tiRTTI; - - -procedure RegisterFallBackListMediators; -begin - gMediatorManager.RegisterMediator(TtiListViewMediatorView, TtiObjectList); - gMediatorManager.RegisterMediator(TtiStringGridMediatorView, TtiObjectList); - gMediatorManager.RegisterMediator(TtiListBoxListMediatorView, TtiObjectList); -end; - -{ TtiListViewMediatorView } - -procedure TtiListViewMediatorView.SetSelectedObject(const AValue: TtiObject); -var - i: integer; -begin - for i := 0 to View.Items.Count - 1 do - if TtiObject(View.Items.Item[i].UserData) = AValue then - begin - View.ItemIndex := i; - HandleSelectionChanged; {$Note Is this line required?} - Exit; //==> - end; -end; - -function TtiListViewMediatorView.GetSelectedObject: TtiObject; -begin - Result := GetObjectFromItem(View.Items.Item[View.ItemIndex]); -end; - -function TtiListViewMediatorView.DoCreateItemMediator(AData: TtiObject; ARowIdx: integer): TtiListItemMediator; -var - li: TfpgLVItem; -begin - DataAndPropertyValid(AData); - { Create ListItem and Mediator } - View.BeginUpdate; - try - li := TfpgLVItem.Create(View.Items); - View.Items.Add(li); - Result := TtiListViewListItemMediator.CreateCustom(AData, li, OnBeforeSetupField, FieldsInfo, Active); - li.UserData := Result; - MediatorList.Add(Result); - finally - View.EndUpdate; - end; -end; - -procedure TtiListViewMediatorView.DoDeleteItemMediator(AIndex: Integer; AMediator: TtiListItemMediator); -begin - View.Items.Delete(View.Items.IndexOf(TtiListViewListItemMediator(AMediator).View)); - inherited DoDeleteItemMediator(AIndex, AMediator); -end; - -procedure TtiListViewMediatorView.CreateColumns; -var - c: integer; - lc: TfpgLVColumn; - lInfo: TtiMediatorFieldInfo; -begin - if (View.Columns.Count<>FieldsInfo.Count) then - View.Columns.Clear; - if View.Columns.Count = 0 then - begin - for c := 0 to FieldsInfo.Count-1 do - begin - lInfo := FieldsInfo[c]; - lc := TfpgLVColumn.Create(View.Columns); - lc.AutoSize := False; - lc.Caption := lInfo.Caption; - lc.Width := lInfo.FieldWidth; -// lc.CaptionAlignment:= lInfo.Alignment; - lc.Alignment := lInfo.Alignment; - lc.Resizable := True; - View.Columns.Add(lc); - end; - end; -end; - -procedure TtiListViewMediatorView.SetupGUIandObject; -begin - { Setup TfpgListView defaults } - View.Columns.Clear; - View.Items.Clear; - // FView.ViewStyle := vsReport; - View.ShowHeaders := True; - // FView.RowSelect := True; - // FView.AutoSize := False; - // FView.ScrollBars := ssAutoBoth; -end; - -procedure TtiListViewMediatorView.ClearList; -begin - MediatorList.Clear; - if View <> nil then - View.Items.Clear; -end; - -procedure TtiListViewMediatorView.RebuildList; -begin - View.BeginUpdate; - try - CreateColumns; - CreateSubMediators; - finally - View.EndUpdate; - end; -end; - -procedure TtiListViewMediatorView.SetActive(const AValue: Boolean); -begin - inherited SetActive(AValue); - if not AValue then - ClearList; -end; - -constructor TtiListViewMediatorView.CreateCustom(AModel: TtiObjectList; AView: TfpgListView; AOnBeforeSetupField: TtiOnBeforeSetupField; ADisplayNames: string; AIsObserving: Boolean); -begin - Create; // don't forget this - OnBeforeSetupField := AOnBeforeSetupField; - DisplayNames := ADisplayNames; // Will call ParseDisplaynames. - Subject := AModel; - SetView(AView); // Will call SetupGUIandObject; - CreateSubMediators; - Active := AIsObserving; // Will attach/Detach -end; - -class function TtiListViewMediatorView.ComponentClass: TClass; -begin - Result := TfpgListView; -end; - -constructor TtiListViewMediatorView.Create; -begin - inherited Create; - FObserversInTransit := TList.Create; -end; - -constructor TtiListViewMediatorView.CreateCustom(AModel: TtiObjectList; AView: TfpgListView; ADisplayNames: string; AIsObserving: Boolean); -begin - CreateCustom(AModel, AView, nil, ADisplayNames, AIsObserving); -end; - -destructor TtiListViewMediatorView.Destroy; -begin - IsObserving := False; - FObserversInTransit.Free; - inherited Destroy; -end; - -function TtiListViewMediatorView.View: TfpgListView; -begin - Result := TfpgListView(inherited View); -end; - -procedure TtiListViewMediatorView.HandleSelectionChanged; -var - i: integer; -begin - if View.ItemIndex = -1 then - SelectedObject := nil - else - begin - FObserversInTransit.Clear; - { If an item is already selected, assign the item's List of observers to a - temporary container. This is done so that the same observers can be - assigned to the new item. } - if Assigned(SelectedObject) then - FObserversInTransit.Assign(SelectedObject.ObserverList); - - // Assign Newly selected item to SelectedObject Obj. - SelectedObject := TtiObject(View.Items.Item[View.ItemIndex].UserData); - - { If an object was selected, copy the old item's observer List - to the new item's observer List. } - if FObserversInTransit.Count > 0 then - SelectedObject.ObserverList.Assign(FObserversInTransit); - - { Set the Observers Subject property to the selected object } - for i := 0 to SelectedObject.ObserverList.Count - 1 do - TtiMediatorView(SelectedObject.ObserverList.Items[i]).Subject := - SelectedObject; - - // execute the NotifyObservers event to update the observers. - SelectedObject.NotifyObservers; - end; -end; - -function TtiListViewMediatorView.GetObjectFromItem(AItem: TfpgLVItem): TtiObject; -begin - if (AItem = nil) or (AItem.UserData = nil) then - Result := nil - else - Result := TtiListItemMediator(AItem.UserData).Model; -end; - - -{ TtiListViewListItemMediator } - -procedure TtiListViewListItemMediator.SetupFields; -var - c: integer; - lMemberName: string; - lValue: string; -begin - lMemberName := FFieldsInfo[0].PropName; - lValue := tiGetProperty(Model, lMemberName); - if Assigned(OnBeforeSetupField) then - OnBeforeSetupField(Model, lMemberName, lValue); - FView.Caption := lValue; - for c := 1 to FFieldsInfo.Count - 1 do - begin - lMemberName := FFieldsInfo[c].PropName; - lValue := tiGetProperty(Model, lMemberName); - if Assigned(OnBeforeSetupField) then - OnBeforeSetupField(Model, lMemberName, lValue); - FView.SubItems.Add(lValue); - end; -end; - -constructor TtiListViewListItemMediator.CreateCustom(AModel: TtiObject; AView: TfpgLVItem; const AFieldsInfo: TtiMediatorFieldInfoList; IsObserving: Boolean); -begin - CreateCustom(AModel, AView, nil, AFieldsInfo, IsObserving); -end; - -constructor TtiListViewListItemMediator.CreateCustom(AModel: TtiObject; AView: TfpgLVItem; AOnBeforeSetupField: TtiOnBeforeSetupField; const AFieldsInfo: TtiMediatorFieldInfoList; IsObserving: Boolean); -begin - inherited Create; - Model := AModel; - FView := AView; - FFieldsInfo := AFieldsInfo; - OnBeforeSetupField := AOnBeforeSetupField; - SetupFields; - Active := IsObserving; // Will attach -end; - -procedure TtiListViewListItemMediator.BeforeDestruction; -begin - Model.DetachObserver(self); - Model := nil; - FView := nil; - inherited BeforeDestruction; -end; - -procedure TtiListViewListItemMediator.Update(ASubject: TtiObject); -var - c: integer; - lMemberName: string; - lValue: string; -begin - Assert(Model = ASubject); - - lMemberName := FFieldsInfo[0].PropName; - lValue := tiGetProperty(Model, lMemberName); - if Assigned(OnBeforeSetupField) then - OnBeforeSetupField(Model, lMemberName, lValue); - - FView.Caption := lValue; - - for c := 1 to FFieldsInfo.Count - 1 do - begin - lMemberName := FFieldsInfo[c].PropName; - lValue := Model.PropValue[lMemberName]; - if Assigned(OnBeforeSetupField) then - OnBeforeSetupField(Model, lMemberName, lValue); - FView.SubItems[c - 1] := lValue; - end; -end; - - -{ TtiStringGridMediatorView } - -function TtiStringGridMediatorView.GetSelectedObject: TtiObject; -begin - Result := GetObjectFromRow(View.FocusRow); -end; - -procedure TtiStringGridMediatorView.SetSelectedObject(const AValue: TtiObject); -var - i: integer; - o: TObject; -begin - for i := 0 to View.RowCount - 1 do - begin - o := View.Objects[0, i]; - if Assigned(o) and (TtiListItemMediator(o).Model = AValue) then - begin - View.FocusRow := i; - Exit; //==> - end; - end; { for } -end; - -function TtiStringGridMediatorView.DoCreateItemMediator(AData: TtiObject; ARowIdx: integer): TtiListItemMediator; -var - i: integer; - lFieldName: string; -begin - View.BeginUpdate; - try - if ARowIdx = View.RowCount then // In case of add notification - View.RowCount := View.RowCount+1; - for i := 0 to FieldsInfo.Count - 1 do - begin - lFieldName := FieldsInfo[i].PropName; - View.Cells[i, ARowIdx] := tiGetProperty(AData, lFieldName); // set Cell text - end; - Result := TtiStringGridRowMediator.CreateCustom(AData, View, FieldsInfo, ARowIdx, Active); - View.Objects[0, ARowIdx] := Result; // set Object reference inside grid. It used to be AData. - MediatorList.Add(Result); - finally - View.EndUpdate; - end; -end; - -procedure TtiStringGridMediatorView.DoDeleteItemMediator(AIndex: Integer; AMediator: TtiListItemMediator); -begin - View.DeleteRow(AIndex); - inherited DoDeleteItemMediator(AIndex, AMediator); -end; - -procedure TtiStringGridMediatorView.CreateColumns; -var - i: integer; - lColumnTotalWidth: integer; - lGridNonContentWidth: integer; - lLastColumnWidth: integer; -begin - lColumnTotalWidth := 0; - // Grid is 2px border left + right, 1px col gridline separator, 15px vertical scrollbar width - lGridNonContentWidth := 2 + 2 + (FieldsInfo.Count - 1) + 15; - for i := 0 to FieldsInfo.Count - 1 do - begin - View.ColumnWidth[i] := FieldsInfo[i].FieldWidth; - View.ColumnTitle[i] := FieldsInfo[i].Caption; - View.Columns[i].Alignment := FieldsInfo[i].Alignment; - //resize the last column to fill the grid. - if i = FieldsInfo.Count - 1 then - begin - if View.Width > (lColumnTotalWidth + lGridNonContentWidth) then - begin - lLastColumnWidth := View.Width - (lColumnTotalWidth + lGridNonContentWidth); - if lLastColumnWidth > FieldsInfo[i].FieldWidth then { only go bigger, not smaller } - View.ColumnWidth[i] := lLastColumnWidth; - end; - end - else - lColumnTotalWidth := lColumnTotalWidth + View.ColumnWidth[i]; - end; -end; - -procedure TtiStringGridMediatorView.SetupGUIandObject; -begin - //Setup default properties for the StringGrid - View.RowSelect := True; - View.ColumnCount := FieldsInfo.Count; - if ShowDeleted then - View.RowCount := Model.Count - else - View.RowCount := Model.CountNotDeleted; -end; - -procedure TtiStringGridMediatorView.ClearList; -begin - MediatorList.Clear; - if View <> nil then - View.RowCount := 0; { Don't call View.Clear because then the Header is gone too } -end; - -procedure TtiStringGridMediatorView.RebuildList; -begin -// writeln('--- TStringGridMediator.RebuildList'); - { This rebuilds the whole list. Not very efficient. } - View.BeginUpdate; - try - SetupGUIandObject; - MediatorList.Clear; - CreateSubMediators; - finally - View.EndUpdate; - end; -end; - -procedure TtiStringGridMediatorView.SetActive(const AValue: Boolean); -begin - inherited SetActive(AValue); - if not AValue then - ClearList; -end; - -constructor TtiStringGridMediatorView.CreateCustom(AModel: TtiObjectList; AGrid: TfpgStringGrid; ADisplayNames: string; AIsObserving: Boolean); -begin - inherited Create; - DisplayNames := ADisplayNames; - Subject := AModel; - SetView(AGrid); - CreateSubMediators; - IsObserving := AIsObserving; -end; - -destructor TtiStringGridMediatorView.Destroy; -begin - IsObserving := False; - inherited Destroy; -end; - -class function TtiStringGridMediatorView.ComponentClass: TClass; -begin - Result := TfpgStringGrid; -end; - -function TtiStringGridMediatorView.GetObjectFromRow(ARow: Integer): TtiObject; -var - O: TObject; -begin - if View.RowCount = 0 then - begin - Result := nil; - Exit; - end; - - if ARow = -1 then - Result := nil - else - begin - O := View.Objects[0, ARow]; - if O <> nil then - Result := TtiListItemMediator(O).Model - else - Result := nil; - end; -end; - -function TtiStringGridMediatorView.View: TfpgStringGrid; -begin - Result := TfpgStringGrid(inherited View); -end; - - -{ TtiStringGridRowMediator } - -constructor TtiStringGridRowMediator.CreateCustom(AModel: TtiObject; AGrid: TfpgStringGrid; const AFieldsInfo: TtiMediatorFieldInfoList; ARowIndex: integer; IsObserving: Boolean); -begin - inherited Create; - Model := AModel; - FView := AGrid; - FFieldsInfo := AFieldsInfo; - FRowIndex := ARowIndex; - Active := IsObserving; // Will attach -end; - -procedure TtiStringGridRowMediator.Update(ASubject: TtiObject); -var - i: integer; - lFieldName: string; - lValue: string; -begin - Assert(Model = ASubject); - for i := 0 to FFieldsInfo.Count - 1 do - begin - lFieldName := FFieldsInfo[I].PropName; - lValue := tiGetProperty(Model, lFieldName); - if Assigned(OnBeforeSetupField) then - OnBeforeSetupField(Model, lFieldName, lValue); - FView.Cells[i, FRowIndex] := lValue; - end; -end; - - -{ TtiListBoxListMediatorView } - -function TtiListBoxListMediatorView.DoCreateItemMediator(AData: TtiObject; ARowIdx: integer): TtiListItemMediator; -var - i: integer; - lFieldName: string; -begin - View.BeginUpdate; - try - if FieldsInfo.Count > 0 then // only take the first field it if exists - begin - lFieldName := FieldsInfo[0].PropName; - View.Items.Add(tiGetProperty(AData, lFieldName)); // set Cell text - end - else - View.Items.Add(AData.Caption); // the default fallback - - Result := TtiListBoxItemMediator.CreateCustom(AData, View, FieldsInfo, ARowIdx, Active); - View.Items.Objects[ARowIdx] := Result; // set Object reference inside grid. It used to be AData. - MediatorList.Add(Result); - finally - View.EndUpdate; - end; -end; - -procedure TtiListBoxListMediatorView.DoDeleteItemMediator(AIndex: Integer; AMediator: TtiListItemMediator); -begin - View.Items.Delete(AIndex); - inherited DoDeleteItemMediator(AIndex, AMediator); -end; - -function TtiListBoxListMediatorView.GetSelectedObject: TtiObject; -begin - Result := GetObjectFromRow(View.FocusItem); -end; - -procedure TtiListBoxListMediatorView.SetSelectedObject(const AValue: TtiObject); -var - i: integer; - o: TObject; -begin - for i := 0 to View.ItemCount - 1 do - begin - o := View.Items.Objects[i]; - if Assigned(o) and (TtiListItemMediator(o).Model = AValue) then - begin - View.FocusItem := i; - Exit; //==> - end; - end; { for } -// inherited SetSelectedObject(AValue); -end; - -procedure TtiListBoxListMediatorView.CreateColumns; -begin - // do nothing - we don't support columns -end; - -procedure TtiListBoxListMediatorView.ClearList; -begin - MediatorList.Clear; - if View <> nil then - View.Items.Clear; -end; - -procedure TtiListBoxListMediatorView.RebuildList; -begin - { This rebuilds the whole list. Not very efficient. } - View.BeginUpdate; - try - SetupGUIandObject; - MediatorList.Clear; -// CreateColumns; - CreateSubMediators; - finally - View.EndUpdate; - end; -end; - -procedure TtiListBoxListMediatorView.SetupGUIandObject; -begin - inherited SetupGUIandObject; - View.Items.Clear; -end; - -constructor TtiListBoxListMediatorView.CreateCustom(AModel: TtiObjectList; - AListBox: TfpgListBox; ADisplayNames: string; AIsObserving: Boolean); -begin - inherited Create; - DisplayNames := ADisplayNames; - Subject := AModel; - SetView(AListBox); - CreateSubMediators; - IsObserving := AIsObserving; -end; - -destructor TtiListBoxListMediatorView.Destroy; -begin - IsObserving := False; - inherited Destroy; -end; - -class function TtiListBoxListMediatorView.ComponentClass: TClass; -begin - Result := TfpgListView; -end; - -function TtiListBoxListMediatorView.GetObjectFromRow(ARow: Integer): TtiObject; -var - O: TObject; -begin - if View.ItemCount = 0 then - begin - Result := nil; - Exit; - end; - - if ARow = -1 then - Result := nil - else - begin - O := View.Items.Objects[ARow]; - if O <> nil then - Result := TtiListItemMediator(O).Model - else - Result := nil; - end; -end; - -function TtiListBoxListMediatorView.View: TfpgListBox; -begin - Result := TfpgListBox(inherited View); -end; - -{ TtiListBoxItemMediator } - -constructor TtiListBoxItemMediator.CreateCustom(AModel: TtiObject; AListBox: TfpgListBox; - const AFieldsInfo: TtiMediatorFieldInfoList; ARowIndex: integer; IsObserving: Boolean); -begin - inherited Create; - Model := AModel; - FView := AListBox; - FFieldsInfo := AFieldsInfo; - FRowIndex := ARowIndex; - Active := IsObserving; // Will attach -end; - -procedure TtiListBoxItemMediator.Update(ASubject: TtiObject); -var - i: integer; - lFieldName: string; - lValue: string; - s: string; -begin - Assert(Model = ASubject); - s := ''; - for i := 0 to FFieldsInfo.Count - 1 do - begin - lFieldName := FFieldsInfo[I].PropName; - lValue := tiGetProperty(Model, lFieldName); - if Assigned(OnBeforeSetupField) then - OnBeforeSetupField(Model, lFieldName, lValue); - s := s + ', ' + lValue; - end; - FView.Items[FRowIndex] := s; -// inherited Update(ASubject); -end; - -end. - diff --git a/extras/tiopf/gui/tiLogToGUI.pas b/extras/tiopf/gui/tiLogToGUI.pas deleted file mode 100644 index 5b2d2a6e..00000000 --- a/extras/tiopf/gui/tiLogToGUI.pas +++ /dev/null @@ -1,321 +0,0 @@ -{ - Log to a window above the application's main form, but only if - the -lv parameter is passed on the command line - - This in normally controlled by the tiLogReg unit. - - *** NOTE *** - * If you application doesn't terminate when you activated LogToGUI, it probably - means a TThread.WaitFor deadlock occured. In that case, call ReleaseLog() - after fpgApplication.Run in you project's *.lpr file. - * Alternatively, the LogToGUI form was accidentaly set as Application.MainForm, - because it was the first form created. -} -unit tiLogToGUI; - -{$mode objfpc}{$H+} - -interface -uses - Classes, - SysUtils, - fpg_widget, - fpg_form, - fpg_memo, - fpg_menu, - fpg_panel, - fpg_button, - fpg_main, - tiLog; - -type - TtiLogToGUI = class(TtiLogToCacheAbs) - private - FForm: TfpgForm; - FMemoLog: TfpgMemo; - FToolBar: TfpgBevel; - FPopupMenu: TfpgPopupMenu; - FViewLogMenuItem: TfpgMenuItem; - function GetFormParent: TfpgWidget; - procedure SetFormParent(const AValue: TfpgWidget); - function CreateForm: TfpgForm; - procedure FormClearMenuItemClick(Sender: TObject); - procedure FormWordWrapMenuItemClick(Sender: TObject); - procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); - procedure FormLogLevelButtonClick(Sender: TObject); - procedure DoViewLogFile(Sender: TObject); - procedure DoOnPopup(Sender: TObject); - procedure WriteToMemo(const AMessage: string); - protected - procedure WriteToOutput; override; - procedure WorkingListToOutput; override; - procedure SetSevToLog(const AValue: TtiSevToLog); override; - public - constructor Create; override; - destructor Destroy; override; - property FormParent: TfpgWidget read GetFormParent; // write SetFormParent; - procedure Log(const ADateTime, AThreadID, AMessage: string; ASeverity: TtiLogSeverity); override; - end; - - -implementation -uses - fpg_base, - tiUtils, - tiCommandLineParams, - tiDialogs; - - -{ TtiLogToGUI } - -constructor TtiLogToGUI.Create; -begin - // GUI output must be synchronized with the main thread. - inherited CreateSynchronized; - FForm := CreateForm; - ThrdLog.Resume; -end; - -destructor TtiLogToGUI.Destroy; -begin - if Assigned(FForm) then - FForm.Free; - FForm := nil; - inherited Destroy; -end; - -function TtiLogToGUI.CreateForm: TfpgForm; -var - lMenuItem: TfpgMenuItem; - lLogSev: TtiLogSeverity; - lToolButton: TfpgButton; - x: integer; -begin - FForm := TfpgForm.Create(fpgApplication); - FForm.WindowPosition := wpUser; - FForm.Top := 10; - FForm.Left := 10; - FForm.Height := 150; - FForm.Width := fpgApplication.ScreenWidth - 20; - FForm.WindowTitle := 'Application event log - ' + ApplicationName; - FForm.OnCloseQuery := @FormCloseQuery; - - FPopupMenu := TfpgPopupMenu.Create(FForm); - FPopupMenu.Name := 'PopupMenu'; - FPopupMenu.BeforeShow := @DoOnPopup; - - FToolBar := TfpgBevel.Create(FForm); - FToolBar.Name := 'ToolBar'; - FToolBar.SetPosition(0, 0, FForm.Width, 30); - FToolbar.Shape := bsSpacer; - FToolBar.Align := alTop; - FToolBar.TabOrder := 1; - - FMemoLog := TfpgMemo.Create(FForm); - FMemoLog.Name := 'MemoLog'; - FMemoLog.Top := 29; - FMemoLog.Align := alClient; - FMemoLog.FontDesc := '#Edit2'; // monospaced font - FMemoLog.PopupMenu := FPopupMenu; -// FMemoLog.ReadOnly := True; -// FMemoLog.ScrollBars := ssBoth; - FMemoLog.TabOrder := 0; -// FMemoLog.WordWrap := False; - FMemoLog.Lines.Clear; - - { Setup popup menu items} - FViewLogMenuItem := FPopupMenu.AddMenuItem('View log file', '', @DoViewLogFile); - FViewLogMenuItem.Name := 'Viewlogfile1'; - lMenuItem := FPopupMenu.AddMenuItem('-', '', nil); - lMenuItem.Name := 'N1'; - lMenuItem := FPopupMenu.AddMenuItem('Clear', '', @FormClearMenuItemClick); - lMenuItem.Name := 'ClearMenuItem'; - lMenuItem := FPopupMenu.AddMenuItem('Word wrap', '', @FormWordWrapMenuItemClick); - lMenuItem.Name := 'WordWrapMenuItem'; - lMenuItem.Enabled := False; - - { Setup severity toolbar buttons } - x := 1; - for lLogSev := Low(TtiLogSeverity) to High(TtiLogSeverity) do - begin - lToolButton := TfpgButton.Create(FToolBar); - lToolButton.SetPosition(x, 1, 50, 28); - lToolButton.Text := cTILogSeverityStrings[lLogSev]; - lToolButton.Tag := Ord(lLogSev); - lToolButton.AllowAllUp := True; // enables toggle button mode - lToolButton.GroupIndex := Ord(lLogSev) + 1; // enables toggle button mode - lToolButton.Down := lLogSev in GLog.SevToLog; - lToolButton.OnClick := @FormLogLevelButtonClick; - lToolButton.Focusable := False; - Inc(x, 51); - end; - - Result := FForm; -end; - -function TtiLogToGUI.GetFormParent: TfpgWidget; -begin - result := FForm.Parent; -end; - -procedure TtiLogToGUI.Log(const ADateTime, AThreadID, AMessage: string; ASeverity: TtiLogSeverity); -begin - if Terminated then - Exit; //==> - if not FForm.HasHandle then - FForm.Show; - inherited Log(ADateTime, AThreadID, AMessage, ASeverity); -end; - -procedure TtiLogToGUI.SetFormParent(const AValue: TfpgWidget); -begin - {$Note This is untested!!! } - FForm.Parent := AValue; - FForm.Align := alClient; - FForm.WindowAttributes := FForm.WindowAttributes + [waBorderless]; -// FForm.BorderStyle := bsNone; -end; - -procedure TtiLogToGUI.SetSevToLog(const AValue: TtiSevToLog); -var - i: integer; - lLogSev: TtiLogSeverity; -begin - // Let parent perform important task(s) - inherited; - // All we do here is reflect any changes to LogSeverity in the visual controls - for i := 0 to FToolBar.ComponentCount - 1 do - begin - lLogSev := TtiLogSeverity(FToolBar.Components[i].Tag); - if FToolBar.Components[i] is TfpgButton then - TfpgButton(FToolBar.Components[i]).Down := lLogSev in AValue; - end; -end; - -procedure TtiLogToGUI.WriteToMemo(const AMessage: string); -var - i: integer; - LLine: string; - LCount: integer; -begin - LCount := tiNumToken(AMessage, CrLf); - if LCount = 1 then - FMemoLog.Lines.Add(tiTrimTrailingWhiteSpace(AMessage)) - else - for i := 1 to LCount do - begin - LLine := tiTrimTrailingWhiteSpace(tiToken(AMessage, CrLf, i)); - FMemoLog.Lines.Add(LLine); - end; -end; - -procedure TtiLogToGUI.WriteToOutput; -begin - if not ThrdLog.Terminated then - inherited WriteToOutput; -end; - -procedure TtiLogToGUI.WorkingListToOutput; -var - i: integer; - LLogEvent: TtiLogEvent; - LPosStart: integer; - LPosEnd: integer; -const - ciMaxLineCount = 200; -begin - if WorkingList.Count > (ciMaxLineCount * 2) then - begin - FMemoLog.Lines.Clear; - LPosStart := WorkingList.Count - 1 - ciMaxLineCount; - LPosEnd := WorkingList.Count - 1; - end - else - begin - if FMemoLog.Lines.Count > ciMaxLineCount then - begin - for i := 0 to ciMaxLineCount div 2 do - FMemoLog.Lines.Delete(0); - //{$IFDEF MSWINDOWS} - //SendMessage(FMemoLog.handle, WM_VSCROLL, SB_Bottom, 0); - //{$ENDIF MSWINDOWS} - { TODO : Keep bottom line of Memo visible by scrolling } - end; - LPosStart := 0; - LPosEnd := WorkingList.Count - 1; - end; - - for i := LPosStart to LPosEnd do - begin - if ThrdLog.Terminated then - Break; //==> - LLogEvent := TtiLogEvent(WorkingList.Items[i]); - WriteToMemo(LLogEvent.AsLeftPaddedString); - end; -end; - -procedure TtiLogToGUI.FormClearMenuItemClick(Sender: TObject); -begin - FMemoLog.Lines.Clear; -end; - -procedure TtiLogToGUI.FormWordWrapMenuItemClick(Sender: TObject); -begin - //FMemoLog.WordWrap := not FMemoLog.WordWrap; - //FWordWrapMenuItem.Checked := FMemoLog.WordWrap; - //if FMemoLog.WordWrap then - //FMemoLog.ScrollBars := ssVertical - //else - //FMemoLog.ScrollBars := ssBoth; -end; - -procedure TtiLogToGUI.FormCloseQuery(Sender: TObject; var CanClose: Boolean); -begin - CanClose := False; -end; - -procedure TtiLogToGUI.FormLogLevelButtonClick(Sender: TObject); -var - lLogSev: TtiLogSeverity; - lLogChecked: boolean; -begin - if not (Sender is TfpgButton) then - Exit; //==> - - lLogSev := TtiLogSeverity(TfpgWidget(Sender).Tag); - lLogChecked := TfpgButton(Sender).Down; - if lLogChecked then - GLog.SevToLog := GLog.SevToLog + [lLogSev] - else - GLog.SevToLog := GLog.SevToLog - [lLogSev]; -end; - -procedure TtiLogToGUI.DoViewLogFile(Sender: TObject); -var - sl: TStringList; -begin - if (GLog.LogToFileName <> '') and - (FileExists(GLog.LogToFileName)) then - begin - sl := TStringList.Create; - try - sl.LoadFromFile(GLog.LogToFilename); - tiShowStringList(sl, GLog.LogToFilename); -// tiEditFile(GLog.LogToFileName); - finally - sl.Free; - end; - end; -end; - -procedure TtiLogToGUI.DoOnPopup(Sender: TObject); -begin - { If we are logging to file as well, then enable the menu option } - FViewLogMenuItem.Enabled := - (GLog.LogToFileName <> '') and - (FileExists(GLog.LogToFileName)); -end; - - -end. - diff --git a/extras/tiopf/gui/tiMediators.pas b/extras/tiopf/gui/tiMediators.pas deleted file mode 100644 index 685a72b0..00000000 --- a/extras/tiopf/gui/tiMediators.pas +++ /dev/null @@ -1,1221 +0,0 @@ -{ - Purpose: - Abstract mediating view and Mediator Factory. This allows you to use - standard edit components and make them object-aware. See the demo - application for usage. -} - -unit tiMediators; - -{$mode objfpc}{$H+} - -interface -uses - tiObject - ,Classes - ,tiBaseMediator - ,fpg_base // for predefined colors - ,fpg_main - ,fpg_widget - ,fpg_edit - ,fpg_checkbox - ,fpg_label - ,fpg_trackbar - ,fpg_combobox - ,fpg_memo - ,fpg_popupcalendar - ,fpg_spinedit - ,fpg_listbox - ; - -type - { Base class to handle TfpgWidget controls } - TtiControlMediatorView = class(TtiMediatorView) - private - FViewColor: TfpgColor; - FViewHint: TfpgString; - FViewErrorColor: TfpgColor; - FEditControl: TfpgEdit; - procedure SetViewErrorColor(const AValue: TfpgColor); - protected - function GetCurrentControlColor: TfpgColor; virtual; - procedure UpdateGuiValidStatus(pErrors: TtiObjectErrors); override; - public - constructor Create; override; - property ViewErrorColor: TfpgColor read FViewErrorColor write SetViewErrorColor; - procedure SetView(const AValue: TComponent); override; - function View: TfpgWidget; reintroduce; - class function ComponentClass: TClass; override; - end; - - - { Base class to handle TfpgBaseEdit controls (TfpgEdit, TfpgNumericEdit, ...) } - TtiBaseEditMediatorView = class(TtiControlMediatorView) - private - FControlReadOnlyColor: TfpgColor; - procedure SetControlReadOnlyColor(const AValue: TfpgColor); - protected - function GetCurrentControlColor: TfpgColor; override; - procedure SetupGUIandObject; override; - procedure SetObjectUpdateMoment(const AValue: TtiObjectUpdateMoment); override; - public - constructor Create; override; - destructor Destroy; override; - property ControlReadOnlyColor: TfpgColor read FControlReadOnlyColor write SetControlReadOnlyColor; - function View: TfpgBaseEdit; reintroduce; - class function ComponentClass: TClass; override; - end; - - - { Base class to handle TfpgEdit controls } - TtiEditMediatorView = class(TtiBaseEditMediatorView) - public - function View: TfpgEdit; reintroduce; - class function ComponentClass: TClass; override; - end; - - - TtiEditIntegerMediatorView = class(TtiBaseEditMediatorView) - public - constructor Create; override; - function View: TfpgEditInteger; reintroduce; - class function ComponentClass: TClass; override; - end; - - - TtiEditFloatMediatorView = class(TtiBaseEditMediatorView) - public - constructor Create; override; - function View: TfpgEditFloat; reintroduce; - class function ComponentClass: TClass; override; - end; - - - TtiEditCurrencyMediatorView = class(TtiBaseEditMediatorView) - public - constructor Create; override; - function View: TfpgEditCurrency; reintroduce; - class function ComponentClass: TClass; override; - end; - - - { Base class to handle TfpgCheckBox controls } - TtiCheckBoxMediatorView = class(TtiControlMediatorView) - protected - procedure SetObjectUpdateMoment(const AValue: TtiObjectUpdateMoment); override; - public - constructor Create; override; - function View: TfpgCheckBox; reintroduce; - class function ComponentClass: TClass; override; - end; - - - { Base class to handle TfpgLabel controls } - TtiStaticTextMediatorView = class(TtiControlMediatorView) - protected - procedure SetupGUIandObject; override; - public - constructor Create; override; - function View: TfpgLabel; reintroduce; - class function ComponentClass: TClass; override; - end; - - - { Base class to handle TfpgSpinEdit controls } - TtiSpinEditMediatorView = class(TtiControlMediatorView) - protected - procedure SetupGUIandObject; override; - procedure SetObjectUpdateMoment(const AValue: TtiObjectUpdateMoment); override; - public - constructor Create; override; - function View: TfpgSpinEdit; reintroduce; - class function ComponentClass: TClass; override; - end; - - - { Base class to handle TfpgSpinEditFloat controls } - TtiSpinEditFloatMediatorView = class(TtiControlMediatorView) - protected - procedure SetupGUIandObject; override; - procedure SetObjectUpdateMoment(const AValue: TtiObjectUpdateMoment); override; - public - constructor Create; override; - function View: TfpgSpinEditFloat; reintroduce; - class function ComponentClass: TClass; override; - end; - - - { Base class to handle TfpgTrackBar controls } - TtiTrackBarMediatorView = class(TtiControlMediatorView) - private - procedure DoTrackBarChanged(Sender: TObject; APosition: integer); - protected - procedure SetupGUIandObject; override; - procedure SetObjectUpdateMoment(const AValue: TtiObjectUpdateMoment); override; - public - constructor Create; override; - function View: TfpgTrackBar; reintroduce; - class function ComponentClass: TClass; override; - end; - - - { Base class to handle TfpgComboBox controls } - TtiComboBoxMediatorView = class(TtiControlMediatorView) - protected - procedure DoObjectToGui; override; - procedure SetObjectUpdateMoment(const AValue: TtiObjectUpdateMoment); override; - public - constructor Create; override; - function View: TfpgComboBox; reintroduce; - class function ComponentClass: TClass; override; - end; - - - { Sets ItemIndex based on integer property } - TtiItemComboBoxMediatorView = class(TtiComboBoxMediatorView) - protected - procedure DoGUIToObject; override; - procedure DoObjectToGUI; override; - public - constructor Create; override; - end; - - - { TfpgComboBox observing a list and setting a Object property } - TtiDynamicComboBoxMediatorView = class(TtiComboBoxMediatorView) - private - FDisplayFieldName: string; - FExternalOnChange: TNotifyEvent; - function GetDisplayFieldName: string; - procedure InternalListRefresh; - protected - procedure SetListObject(const AValue: TtiObjectList); override; - procedure SetOnChangeActive(AValue: Boolean); virtual; - procedure SetupGUIandObject; override; - procedure DoGuiToObject; override; - procedure DoObjectToGui; override; - public - procedure RefreshList; virtual; - property DisplayFieldName: string read GetDisplayFieldName write FDisplayFieldName; - end; - - - { Base class to handle TfpgMemo controls } - TtiMemoMediatorView = class(TtiControlMediatorView) - protected - procedure SetupGUIandObject; override; - procedure DoObjectToGui; override; - procedure DoGuiToObject; override; - procedure SetObjectUpdateMoment(const AValue: TtiObjectUpdateMoment); override; - public - constructor Create; override; - function View: TfpgMemo; reintroduce; - class function ComponentClass: TClass; override; - end; - - - { Base class to handle TfpgCalendarCombo controls } - TtiCalendarComboMediatorView = class(TtiControlMediatorView) - protected - procedure SetupGUIandObject; override; - procedure SetObjectUpdateMoment(const AValue: TtiObjectUpdateMoment); override; - public - constructor Create; override; - function View: TfpgCalendarCombo; reintroduce; - class function ComponentClass: TClass; override; - end; - - - { Base class to handle TfpgListBox controls } - TtiListBoxMediatorView = class(TtiControlMediatorView) - protected - procedure DoObjectToGui; override; - procedure SetObjectUpdateMoment(const AValue: TtiObjectUpdateMoment); override; - public - constructor Create; override; - function View: TfpgListBox; reintroduce; - class function ComponentClass: TClass; override; - end; - - - { Sets ItemIndex based on integer property } - TtiItemListBoxMediatorView = class(TtiListBoxMediatorView) - protected - procedure DoGUIToObject; override; - procedure DoObjectToGUI; override; - public - constructor Create; override; - end; - - - { TfpgListBox observing a list and setting a Object property } - TtiDynamicListBoxMediatorView = class(TtiListBoxMediatorView) - private - FDisplayFieldName: string; - FExternalOnChange: TNotifyEvent; - function GetDisplayFieldName: string; - procedure InternalListRefresh; - protected - procedure SetListObject(const AValue: TtiObjectList); override; - procedure SetOnChangeActive(AValue: Boolean); virtual; - procedure SetupGUIandObject; override; - procedure DoGuiToObject; override; - procedure DoObjectToGui; override; - public - procedure RefreshList; virtual; - property DisplayFieldName: string read GetDisplayFieldName write FDisplayFieldName; - end; - - -// Registering generic mediators which can handle most cases by default. -procedure RegisterFallBackMediators; - - -implementation -uses - SysUtils - ,TypInfo - ,fpg_dialogs // for TfpgMessageDialog - ,tiGUIConstants // for error color - ; - -type - // Friend class to get access to protected methods - THackWidget = class(TfpgWidget); - THackBaseEdit = class(TfpgBaseEdit); - - -const - cErrorListHasNotBeenAssigned = 'List has not been assigned'; - cErrorPropertyNotClass = 'Property is not a class type!'; - cErrorAddingItemToCombobox = 'Error adding list items to combobox ' + - 'Message: %s, Item Property Name: %s'; - - -procedure RegisterFallBackMediators; -begin - gMediatorManager.RegisterMediator(TtiEditMediatorView, TtiObject, [tkSString,tkAString,tkLString,tkWString,tkUString,tkInteger,tkFloat]); - gMediatorManager.RegisterMediator(TtiEditIntegerMediatorView, TtiObject, [tkInteger]); - gMediatorManager.RegisterMediator(TtiEditFloatMediatorView, TtiObject, [tkFloat]); - gMediatorManager.RegisterMediator(TtiEditCurrencyMediatorView, TtiObject, [tkFloat]); - gMediatorManager.RegisterMediator(TtiCheckBoxMediatorView, TtiObject, [tkBool]); - gMediatorManager.RegisterMediator(TtiComboBoxMediatorView, TtiObject, [tkSString,tkAString]); - gMediatorManager.RegisterMediator(TtiItemComboBoxMediatorView, TtiObject, [tkInteger, tkEnumeration]); - gMediatorManager.RegisterMediator(TtiDynamicComboBoxMediatorView, TtiObject, [tkClass]); - gMediatorManager.RegisterMediator(TtiStaticTextMediatorView, TtiObject); - gMediatorManager.RegisterMediator(TtiTrackBarMediatorView, TtiObject, [tkInteger]); - gMediatorManager.RegisterMediator(TtiMemoMediatorView, TtiObject, [tkSString,tkAString,tkLString,tkWString,tkUString]); - gMediatorManager.RegisterMediator(TtiCalendarComboMediatorView, TtiObject, [tkFloat]); - gMediatorManager.RegisterMediator(TtiSpinEditMediatorView, TtiObject, [tkInteger]); - gMediatorManager.RegisterMediator(TtiSpinEditFloatMediatorView, TtiObject, [tkFloat]); - gMediatorManager.RegisterMediator(TtiListBoxMediatorView, TtiObject, [tkSString,tkAString]); - gMediatorManager.RegisterMediator(TtiItemListBoxMediatorView, TtiObject, [tkInteger, tkEnumeration]); - gMediatorManager.RegisterMediator(TtiDynamicListBoxMediatorView, TtiObject, [tkClass]); -end; - -{ TtiControlMediatorView } - -procedure TtiControlMediatorView.SetViewErrorColor(const AValue: TfpgColor); -begin - if AValue <> FViewErrorColor then - begin - FViewErrorColor := AValue; - TestIfValid; // Update view - end; -end; - -function TtiControlMediatorView.GetCurrentControlColor: TfpgColor; -begin - Result := fpgColorToRGB(FViewColor); -end; - -procedure TtiControlMediatorView.UpdateGuiValidStatus(pErrors: TtiObjectErrors); -var - oError: TtiObjectError; -begin - inherited UpdateGuiValidStatus(pErrors); - - oError := pErrors.FindByErrorProperty(RootFieldName); - if oError <> nil then - begin - View.BackgroundColor := ViewErrorColor; - View.Hint := oError.ErrorMessage; - end - else - begin - View.BackgroundColor := GetCurrentControlColor; - View.Hint := FViewHint; - end; -end; - -constructor TtiControlMediatorView.Create; -begin - inherited Create; - FViewErrorColor := clError; -end; - -procedure TtiControlMediatorView.SetView(const AValue: TComponent); -var - LValue: TfpgWidget; -begin - Assert((AValue = nil) or (AValue is TfpgWidget), 'Expected TfpgWidget'); - LValue := AValue as TfpgWidget; - - if LValue <> View then - begin - // Restore state of previous view - if View <> nil then - begin - View.Hint := FViewHint; - View.BackgroundColor := FViewColor; - end; - - // Preserve state of new view - if Assigned(LValue) then - begin - FViewHint := LValue.Hint; - FViewColor := LValue.BackgroundColor; - end; - end; - - inherited SetView(AValue); -end; - -function TtiControlMediatorView.View: TfpgWidget; -begin - Result := TfpgWidget(inherited View); -end; - -class function TtiControlMediatorView.ComponentClass: TClass; -begin - Result := TfpgWidget; -end; - -{ TtiBaseEditMediatorView } - -procedure TtiBaseEditMediatorView.SetControlReadOnlyColor(const AValue: TfpgColor); -begin - if AValue <> FControlReadOnlyColor then - begin - FControlReadOnlyColor := AValue; - TestIfValid; // Update view - end; -end; - -function TtiBaseEditMediatorView.GetCurrentControlColor: TfpgColor; -begin - if THackBaseEdit(View).ReadOnly then - Result := fpgColorToRGB(ControlReadOnlyColor) - else - Result := inherited GetCurrentControlColor; -end; - -procedure TtiBaseEditMediatorView.SetupGUIandObject; -var - Mi, Ma: Integer; -begin - inherited SetupGUIandObject; - if Subject.GetFieldBounds(FieldName,Mi,Ma) and (Ma>0) then - THackBaseEdit(View).MaxLength := Ma; -end; - -procedure TtiBaseEditMediatorView.SetObjectUpdateMoment(const AValue: TtiObjectUpdateMoment); -begin - inherited SetObjectUpdateMoment(AValue); - if View <> nil then - begin - if ObjectUpdateMoment in [ouOnchange,ouCustom,ouDefault] then - THackBaseEdit(View).OnChange := @DoOnChange - else - THackBaseEdit(View).OnExit := @DoOnChange; - if ObjectUpdateMoment in [ouNone] then - begin - THackbaseEdit(View).OnChange := nil; - THackbaseEdit(View).OnExit := nil; - end; - end; -end; - -constructor TtiBaseEditMediatorView.Create; -begin - inherited Create; - FControlReadOnlyColor := clWindowBackground; - GUIFieldName := 'Text'; -end; - -destructor TtiBaseEditMediatorView.Destroy; -begin - if View <> nil then - begin - if Assigned(THackBaseEdit(View).OnChange) then - THackBaseEdit(View).OnChange := nil; - end; - inherited Destroy; -end; - -function TtiBaseEditMediatorView.View: TfpgBaseEdit; -begin - Result := TfpgBaseEdit(inherited View); -end; - -class function TtiBaseEditMediatorView.ComponentClass: TClass; -begin - Result := TfpgBaseEdit; -end; - -{ TtiEditMediatorView } - -function TtiEditMediatorView.View: TfpgEdit; -begin - Result := TfpgEdit(inherited View); -end; - -class function TtiEditMediatorView.ComponentClass: TClass; -begin - Result := TfpgEdit; -end; - -{ TtiSpinEditMediatorView} - -class function TtiSpinEditMediatorView.ComponentClass: TClass; -begin - Result := TfpgSpinEdit; -end; - -procedure TtiSpinEditMediatorView.SetupGUIandObject; -var - Mi, Ma: Integer; -begin - inherited SetupGUIandObject; - if Subject.GetFieldBounds(FieldName, Mi, Ma) then - begin - View.MinValue := Mi; - View.MaxValue := Ma; - end; -end; - -procedure TtiSpinEditMediatorView.SetObjectUpdateMoment(const AValue: TtiObjectUpdateMoment); -begin - inherited SetObjectUpdateMoment(AValue); - if View <> nil then - begin - if ObjectUpdateMoment in [ouOnChange,ouCustom,ouDefault] then - View.OnChange := @DoOnChange - else - View.OnExit := @DoOnChange; - if ObjectUpdateMoment in [ouNone] then - begin - View.OnChange := nil; - View.OnExit := nil; - end; - end; -end; - -constructor TtiSpinEditMediatorView.Create; -begin - inherited Create; - GuiFieldName := 'Value'; -end; - -function TtiSpinEditMediatorView.View: TfpgSpinEdit; -begin - Result := TfpgSpinEdit(inherited View); -end; - - -{ TtiTrackBarMediatorView} - -procedure TtiTrackBarMediatorView.DoTrackBarChanged(Sender: TObject; APosition: integer); -begin - GUIChanged; -end; - -procedure TtiTrackBarMediatorView.SetupGUIandObject; -var - Mi, Ma: Integer; -begin - inherited SetupGUIandObject; - if Subject.GetFieldBounds(FieldName, Mi, Ma) then - begin - View.Min := Mi; - View.Max := Ma; - end; -end; - -procedure TtiTrackBarMediatorView.SetObjectUpdateMoment(const AValue: TtiObjectUpdateMoment); -begin - inherited SetObjectUpdateMoment(AValue); - if View <> nil then - begin - if ObjectUpdateMoment in [ouOnChange,ouCustom,ouDefault] then - View.OnChange := @DoTrackBarChanged // TfpgTrackBar has a different event signature - else - View.OnExit := @DoOnChange; - if ObjectUpdateMoment in [ouNone] then - begin - View.OnChange := nil; - View.OnExit := nil; - end; - end; -end; - -constructor TtiTrackBarMediatorView.Create; -begin - inherited; - GuiFieldName := 'Position'; -end; - -function TtiTrackBarMediatorView.View: TfpgTrackBar; -begin - Result := TfpgTrackBar(inherited View); -end; - -class function TtiTrackBarMediatorView.ComponentClass: TClass; -begin - Result := TfpgTrackBar; -end; - - -{ TtiComboBoxMediatorView } - -class function TtiComboBoxMediatorView.ComponentClass: TClass; -begin - Result := TfpgComboBox; -end; - -constructor TtiComboBoxMediatorView.Create; -begin - inherited Create; - GuiFieldName := 'Text'; -end; - -function TtiComboBoxMediatorView.View: TfpgComboBox; -begin - Result := TfpgComboBox(inherited View); -end; - -procedure TtiComboBoxMediatorView.DoObjectToGui; -begin - View.FocusItem := View.Items.IndexOf(Subject.PropValue[FieldName]); -end; - -procedure TtiComboBoxMediatorView.SetObjectUpdateMoment(const AValue: TtiObjectUpdateMoment); -begin - inherited SetObjectUpdateMoment(AValue); - if View <> nil then - begin - if ObjectUpdateMoment in [ouOnChange,ouCustom,ouDefault] then - View.OnChange := @DoOnChange - else - View.OnExit := @DoOnChange; - if ObjectUpdateMoment in [ouNone] then - begin - View.OnChange := nil; - View.OnExit := nil; - end; - end; -end; - - -{ TtiMemoMediatorView } - -class function TtiMemoMediatorView.ComponentClass: TClass; -begin - Result := TfpgMemo; -end; - -procedure TtiMemoMediatorView.DoGuiToObject; -begin - Subject.PropValue[FieldName] := Trim(View.Lines.Text); -end; - -procedure TtiMemoMediatorView.SetObjectUpdateMoment(const AValue: TtiObjectUpdateMoment); -begin - inherited SetObjectUpdateMoment(AValue); - if View <> nil then - begin - if ObjectUpdateMoment in [ouOnChange,ouCustom,ouDefault] then - View.OnChange := @DoOnChange - else - View.OnExit := @DoOnChange; - if ObjectUpdateMoment in [ouNone] then - begin - View.OnChange := nil; - View.OnExit := nil; - end; - end; -end; - -constructor TtiMemoMediatorView.Create; -begin - inherited Create; -// FControlReadOnlyColor := clWindowBackground; - GUIFieldName := 'Lines'; -end; - -function TtiMemoMediatorView.View: TfpgMemo; -begin - Result := TfpgMemo(inherited View); -end; - -procedure TtiMemoMediatorView.DoObjectToGui; -begin - View.Lines.Text := Subject.PropValue[FieldName]; -end; - -procedure TtiMemoMediatorView.SetupGUIandObject; -var - Mi, Ma: integer; -begin - inherited SetupGUIandObject; - if Subject.GetFieldBounds(FieldName,Mi,Ma) and (Ma>0) then - View.MaxLength := Ma; - View.Lines.Text := ''; -end; - - -{ TtiDynamicComboBoxMediatorView } - -procedure TtiDynamicComboBoxMediatorView.SetListObject(const AValue: TtiObjectList); -begin - inherited; - InternalListRefresh; - if Assigned(ValueList) then - View.Enabled := ValueList.Count > 0; -end; - -procedure TtiDynamicComboBoxMediatorView.InternalListRefresh; -var - lItems: TStrings; - i: Integer; -begin - lItems := View.Items; - lItems.Clear; - View.Text := ''; - - if (ValueList = nil) or - (ValueList.Count < 1) or - (SameText(FieldName, EmptyStr)) then - Exit; //==> - - try - for i := 0 to ValueList.Count - 1 do - lItems.AddObject(GetStrProp(ValueList.Items[i], DisplayFieldName), ValueList.Items[i]); - except - on E: Exception do - RaiseMediatorError(cErrorAddingItemToCombobox,[E.message, FieldName]); - end; - ObjectToGui; -end; - -function TtiDynamicComboBoxMediatorView.GetDisplayFieldName: string; -begin - Result := FDisplayFieldName; - if (Result = '') then - Result := 'Caption'; // Do not localize. -end; - -procedure TtiDynamicComboBoxMediatorView.SetOnChangeActive(AValue: Boolean); -begin - if AValue then - begin - if not UseInternalOnChange then - View.OnChange := FExternalOnChange - else - View.OnChange := @DoOnChange; - end - else - begin - if not UseInternalOnChange then - FExternalOnChange := View.OnChange; - View.OnChange := nil; - end; -end; - -procedure TtiDynamicComboBoxMediatorView.SetupGUIandObject; -begin - inherited SetupGUIandObject; - - if UseInternalOnChange then - View.OnChange := @DoOnChange; // default OnChange event handler - - {$Note As far as I can see, ValueList is always going to be nil here! - Graeme } - if ValueList <> nil then - View.Enabled := (ValueList.Count > 0); -end; - -procedure TtiDynamicComboBoxMediatorView.DoGuiToObject; -var - lValue: TtiObject; - lPropType: TTypeKind; -begin - if not DataAndPropertyValid then - Exit; //==> - if View.FocusItem < 0 then - Exit; //==> - - lValue := TtiObject(ValueList.Items[View.FocusItem]); - - lPropType := typinfo.PropType(Subject, FieldName); - if lPropType = tkClass then - typinfo.SetObjectProp(Subject, FieldName, lValue) - else - RaiseMediatorError(cErrorPropertyNotClass); -end; - -procedure TtiDynamicComboBoxMediatorView.DoObjectToGui; -var - i: Integer; - lValue: TtiObject; - lPropType: TTypeKind; -begin - SetOnChangeActive(false); - - // Set the index only (We're assuming the item is present in the list) - View.FocusItem := -1; - if Subject = nil then - Exit; //==> - - if not Assigned(ValueList) then - RaiseMediatorError(cErrorListHasNotBeenAssigned); - - lValue := nil; - lPropType := typinfo.PropType(Subject, FieldName); - if lPropType = tkClass then - lValue := TtiObject(typinfo.GetObjectProp(Subject, FieldName)) - else - RaiseMediatorError(cErrorPropertyNotClass); - - for i := 0 to ValueList.Count - 1 do - if ValueList.Items[i] = lValue then - begin - View.FocusItem := i; - Break; //==> - end; - - SetOnChangeActive(true); -end; - -procedure TtiDynamicComboBoxMediatorView.RefreshList; -begin - InternalListRefresh; -end; - - -{ TtiCheckBoxMediatorView } - -procedure TtiCheckBoxMediatorView.SetObjectUpdateMoment(const AValue: TtiObjectUpdateMoment); -begin - inherited SetObjectUpdateMoment(AValue); - if View <> nil then - begin - if ObjectUpdateMoment in [ouOnChange,ouCustom,ouDefault] then - View.OnChange := @DoOnChange - else - View.OnExit := @DoOnChange; - if ObjectUpdateMoment in [ouNone] then - begin - View.OnChange := nil; - View.OnExit := nil; - end; - end; -end; - -constructor TtiCheckBoxMediatorView.Create; -begin - inherited Create; - GuiFieldName := 'Checked'; -end; - -function TtiCheckBoxMediatorView.View: TfpgCheckBox; -begin - Result := TfpgCheckBox(inherited View); -end; - -class function TtiCheckBoxMediatorView.ComponentClass: TClass; -begin - Result := TfpgCheckBox; -end; - - -{ TtiStaticTextMediatorView } - -procedure TtiStaticTextMediatorView.SetupGUIandObject; -begin - inherited SetupGUIandObject; - View.Text := ''; -end; - -constructor TtiStaticTextMediatorView.Create; -begin - inherited Create; - GuiFieldName := 'Text'; -end; - -function TtiStaticTextMediatorView.View: TfpgLabel; -begin - Result := TfpgLabel(inherited View); -end; - -class function TtiStaticTextMediatorView.ComponentClass: TClass; -begin - Result := TfpgLabel; -end; - - -{ TtiCalendarComboMediatorView } - -procedure TtiCalendarComboMediatorView.SetupGUIandObject; -var - Mi, Ma: TDateTime; -begin -// inherited SetupGUIandObject; - if Subject.GetFieldBounds(FieldName, Mi, Ma) then - begin - View.MinDate := Mi; - View.MaxDate := Ma; - end; -end; - -procedure TtiCalendarComboMediatorView.SetObjectUpdateMoment(const AValue: TtiObjectUpdateMoment); -begin - inherited SetObjectUpdateMoment(AValue); - if View <> nil then - begin - if ObjectUpdateMoment in [ouOnChange,ouCustom,ouDefault] then - View.OnChange := @DoOnChange - else - View.OnExit := @DoOnChange; - if ObjectUpdateMoment in [ouNone] then - begin - View.OnChange := nil; - View.OnExit := nil; - end; - end; -end; - -constructor TtiCalendarComboMediatorView.Create; -begin - inherited Create; - GUIFieldName := 'DateValue'; -end; - -function TtiCalendarComboMediatorView.View: TfpgCalendarCombo; -begin - Result := TfpgCalendarCombo(inherited View); -end; - -class function TtiCalendarComboMediatorView.ComponentClass: TClass; -begin - Result := TfpgCalendarCombo; -end; - - -{ TtiItemComboBoxMediatorView } - -procedure TtiItemComboBoxMediatorView.DoGUIToObject; -begin - SetOrdProp(Subject, FieldName, View.FocusItem); -end; - -procedure TtiItemComboBoxMediatorView.DoObjectToGUI; -begin - View.FocusItem := GetOrdProp(Subject, FieldName); -end; - -constructor TtiItemComboBoxMediatorView.Create; -begin - inherited Create; - GuiFieldName := 'FocusItem'; -end; - -{ TtiSpinEditFloatMediatorView } - -procedure TtiSpinEditFloatMediatorView.SetupGUIandObject; -var - Mi, Ma: Integer; -begin - inherited SetupGUIandObject; - if Subject.GetFieldBounds(FieldName, Mi, Ma) then - begin - View.MinValue := Mi; - View.MaxValue := Ma; - end; -end; - -procedure TtiSpinEditFloatMediatorView.SetObjectUpdateMoment(const AValue: TtiObjectUpdateMoment); -begin - inherited SetObjectUpdateMoment(AValue); - if View <> nil then - begin - if ObjectUpdateMoment in [ouOnChange,ouCustom,ouDefault] then - View.OnChange := @DoOnChange - else - View.OnExit := @DoOnChange; - if ObjectUpdateMoment in [ouNone] then - begin - View.OnChange := nil; - View.OnExit := nil; - end; - end; -end; - -constructor TtiSpinEditFloatMediatorView.Create; -begin - inherited Create; - GuiFieldName := 'Value'; -end; - -function TtiSpinEditFloatMediatorView.View: TfpgSpinEditFloat; -begin - Result := TfpgSpinEditFloat(inherited View); -end; - -class function TtiSpinEditFloatMediatorView.ComponentClass: TClass; -begin - Result := TfpgSpinEditFloat; -end; - -{ TtiEditIntegerMediatorView } - -constructor TtiEditIntegerMediatorView.Create; -begin - inherited Create; - GUIFieldName := 'Value'; -end; - -function TtiEditIntegerMediatorView.View: TfpgEditInteger; -begin - Result := TfpgEditInteger(inherited View); -end; - -class function TtiEditIntegerMediatorView.ComponentClass: TClass; -begin - Result := TfpgEditInteger; -end; - -{ TtiEditFloatMediatorView } - -constructor TtiEditFloatMediatorView.Create; -begin - inherited Create; - GUIFieldName := 'Value'; -end; - -function TtiEditFloatMediatorView.View: TfpgEditFloat; -begin - Result := TfpgEditFloat(inherited View); -end; - -class function TtiEditFloatMediatorView.ComponentClass: TClass; -begin - Result := TfpgEditFloat; -end; - -{ TtiEditCurrencyMediatorView } - -constructor TtiEditCurrencyMediatorView.Create; -begin - inherited Create; - GUIFieldName := 'Value'; -end; - -function TtiEditCurrencyMediatorView.View: TfpgEditCurrency; -begin - Result := TfpgEditCurrency(inherited View); -end; - -class function TtiEditCurrencyMediatorView.ComponentClass: TClass; -begin - Result := TfpgEditCurrency; -end; - - -{ TtiDynamicListBoxMediatorView } - -function TtiDynamicListBoxMediatorView.GetDisplayFieldName: string; -begin - Result := FDisplayFieldName; - if (Result = '') then - Result := 'Caption'; // Do not localize. -end; - -procedure TtiDynamicListBoxMediatorView.InternalListRefresh; -var - lItems: TStrings; - i: Integer; -begin - lItems := View.Items; - lItems.Clear; - View.Text := ''; - - if (ValueList = nil) or - (ValueList.Count < 1) or - (SameText(FieldName, EmptyStr)) then - Exit; //==> - - try - for i := 0 to ValueList.Count - 1 do - lItems.AddObject(GetStrProp(ValueList.Items[i], DisplayFieldName), ValueList.Items[i]); - except - on E: Exception do - RaiseMediatorError(cErrorAddingItemToCombobox,[E.message, FieldName]); - end; - ObjectToGui; -end; - -procedure TtiDynamicListBoxMediatorView.SetListObject(const AValue: TtiObjectList); -begin - inherited SetListObject(AValue); - InternalListRefresh; - if Assigned(ValueList) then - View.Enabled := ValueList.Count > 0; -end; - -procedure TtiDynamicListBoxMediatorView.SetOnChangeActive(AValue: Boolean); -begin - if AValue then - begin - if not UseInternalOnChange then - View.OnChange := FExternalOnChange - else - View.OnChange := @DoOnChange; - end - else - begin - if not UseInternalOnChange then - FExternalOnChange := View.OnChange; - View.OnChange := nil; - end; -end; - -procedure TtiDynamicListBoxMediatorView.SetupGUIandObject; -begin - inherited SetupGUIandObject; - - if UseInternalOnChange then - View.OnChange := @DoOnChange; // default OnChange event handler - - {$Note As far as I can see, ValueList is always going to be nil here! - Graeme } - if ValueList <> nil then - View.Enabled := (ValueList.Count > 0); -end; - -procedure TtiDynamicListBoxMediatorView.DoGuiToObject; -var - lValue: TtiObject; - lPropType: TTypeKind; -begin - if not DataAndPropertyValid then - Exit; //==> - if View.FocusItem < 0 then - Exit; //==> - - lValue := TtiObject(ValueList.Items[View.FocusItem]); - - lPropType := typinfo.PropType(Subject, FieldName); - if lPropType = tkClass then - typinfo.SetObjectProp(Subject, FieldName, lValue) - else - RaiseMediatorError(cErrorPropertyNotClass); -end; - -procedure TtiDynamicListBoxMediatorView.DoObjectToGui; -var - i: Integer; - lValue: TtiObject; - lPropType: TTypeKind; -begin - SetOnChangeActive(false); - - // Set the index only (We're assuming the item is present in the list) - View.FocusItem := -1; - if Subject = nil then - Exit; //==> - - if not Assigned(ValueList) then - RaiseMediatorError(cErrorListHasNotBeenAssigned); - - lValue := nil; - lPropType := typinfo.PropType(Subject, FieldName); - if lPropType = tkClass then - lValue := TtiObject(typinfo.GetObjectProp(Subject, FieldName)) - else - RaiseMediatorError(cErrorPropertyNotClass); - - for i := 0 to ValueList.Count - 1 do - if ValueList.Items[i] = lValue then - begin - View.FocusItem := i; - Break; //==> - end; - - SetOnChangeActive(true); -end; - -procedure TtiDynamicListBoxMediatorView.RefreshList; -begin - InternalListRefresh; -end; - -{ TtiItemListBoxMediatorView } - -procedure TtiItemListBoxMediatorView.DoGUIToObject; -begin - SetOrdProp(Subject, FieldName, View.FocusItem); -end; - -procedure TtiItemListBoxMediatorView.DoObjectToGUI; -begin - View.FocusItem := GetOrdProp(Subject, FieldName); -end; - -constructor TtiItemListBoxMediatorView.Create; -begin - inherited Create; - GuiFieldName := 'FocusItem'; -end; - -{ TtiListBoxMediatorView } - -procedure TtiListBoxMediatorView.DoObjectToGui; -begin - View.FocusItem := View.Items.IndexOf(Subject.PropValue[FieldName]); -end; - -procedure TtiListBoxMediatorView.SetObjectUpdateMoment( - const AValue: TtiObjectUpdateMoment); -begin - inherited SetObjectUpdateMoment(AValue); - if View <> nil then - begin - if ObjectUpdateMoment in [ouOnChange,ouCustom,ouDefault] then - View.OnChange := @DoOnChange - else - View.OnExit := @DoOnChange; - if ObjectUpdateMoment in [ouNone] then - begin - View.OnChange := nil; - View.OnExit := nil; - end; - end; -end; - -constructor TtiListBoxMediatorView.Create; -begin - inherited Create; - GuiFieldName := 'Text'; -end; - -function TtiListBoxMediatorView.View: TfpgListBox; -begin - Result := TfpgListBox(inherited View); -end; - -class function TtiListBoxMediatorView.ComponentClass: TClass; -begin - Result := TfpgListBox; -end; - -end. - diff --git a/extras/tiopf/gui/tiRtfReport.pas b/extras/tiopf/gui/tiRtfReport.pas deleted file mode 100644 index 1041cd37..00000000 --- a/extras/tiopf/gui/tiRtfReport.pas +++ /dev/null @@ -1,4634 +0,0 @@ -{ - -Revision history: - 2005-07-05: First release by Marius Ellen (mariusellen@home.nl) - 2007-04-18: Ported to Free Pascal and fpGUI by Graeme Geldenhuys (graemeg@gmail.com) - -Purpose: - Create reports with RTF documents with access to dataset and framework objects. - -} - -{ TODO : Better exception handling. (saw some unexpected errors while parsing) corrupting the resulting rtf. } -{ TODO : Show errors when trying to past eof in a TtiObjectList (its now ignored) } -{ TODO : Suppress null dates (0 date are displayed as 1899-xx-xx) } - -unit tiRtfReport; - -{$mode objfpc}{$H+} -{.$I tiDefines.inc} - -interface - -uses - Classes, SysUtils, contnrs, TypInfo{, Jpeg}, - Db, Variants, tiObject, fpg_base; - -type - TtiRtfParser = class; - TRtfArgument = class; - TRtfException = class(Exception); - - TRtfClass =(RtfNothing, RtfUnknown, RtfGroup, RtfText, RtfControl, - RtfExpression, RtfBranche, RtfParseBegin, RtfParseEnd, RtfEOF); - - TRtfToken =(etNothing, etComma, etFunction, etProcedure, etParenthesis, - etADD, etSUB, etMUL, etDIV, etEQ, etNE, etGE, etLE, etGT, etLT, etNot, - etAnd, etOr, etAssign, etFieldName, etVariable, etDataset, etLitString, - etLitInt, etLitFloat, etLitDate, etLitFalse, etLitTrue); - TRtfTokenSet = set of TRtfToken; - - TRtfPictureOption =(poMetafile, poBinary); - TRtfPictureOptions = set of TRtfPictureOption; - TRtfPictureBorder =(brNone, brSingle, brDouble, brThick, brShadow, brDot, brHair); - - TColor = TfpgColor; - TPicture = TMemoryStream; // fake it until we can implement image support - - - TRtfPictureAttr = class(TObject) - private - FWidth: integer; - FHeigth: integer; - FScaleX: integer; - FScaleY: integer; - FWidthmm: Double; - FHeigthmm: Double; - FBorderWidth: integer; - FBorderColor: TColor; - FProportional: boolean; - FBorderType: TRtfPictureBorder; - procedure SetScaleX(Value: integer); - procedure SetScaleY(Value: integer); - public - constructor Create(AWidth, AHeigth: word); - //Width and height are in pixels - property Width: integer read FWidth; - property Heigth: integer read FHeigth; - //Widthmm and heightmm are in milimeters - property Widthmm: Double read FWidthmm; - property Heigthmm: Double read FHeigthmm; - //Scale from 1 to 100 - property ScaleX: integer read FScaleX write SetScaleX; - property ScaleY: integer read FScaleY write SetScaleY; - property BorderColor: TColor read FBorderColor write FBorderColor; - property BorderWidth: integer read FBorderWidth write FBorderWidth; //in points - property BorderType: TRtfPictureBorder read FBorderType write FBorderType; - property Proportional: boolean read FProportional write FProportional; - end; - - - TRtfPicturePath = procedure(var AFilename: string)of object; - TRtfFunctionExecute = procedure(AArgument: TRtfArgument)of object; - TRtfOnPictureAttr = procedure(APictureAttr: TRtfPictureAttr)of object; - TRtfArgumentEvent = procedure(APrevItem, AArgument, ANextItem: TRtfArgument)of object; - TRtfOnCreateDataset = procedure(ADatabase, AAlias, ASql: string; AArgument: TRtfArgument)of object; - - - //Basic Rtf control word - TRtfItem = class(TList) - private - FNext: TRtfItem; - FPrev: TRtfItem; - FParent: TRtfItem; - FRtfMajor: integer; - FRtfMinor: integer; - FRtfClass: TRtfClass; - FRtfTextBuf: string; - function GetItem(Index: integer): TRtfItem; - function CheckItem(AClass: TRtfClass; Major: integer): boolean; - protected - procedure Notify(Ptr: pointer; Action: TListNotification); override; - public - procedure Assign(ASource: TRtfItem); virtual; - property Next: TRtfItem read FNext; - property Prev: TRtfItem read FPrev; - property Parent: TRtfItem read FParent; - //Weak names, but it keeps the RawRtfParser simple - property RtfClass: TRtfClass read FRtfClass write FRtfClass; - property RtfMajor: integer read FRtfMajor write FRtfMajor; - property RtfMinor: integer read FRtfMinor write FRtfMinor; - property RtfTextBuf: string read FRtfTextBuf write FRtfTextBuf; - property Items[Index: integer]: TRtfItem read GetItem; default; - end; - - - //Old style Double linked list (but still usefull) - TRtfItemList = class(TObject) - private - FHead: TRtfItem; - FTail: TRtfItem; - FCount: integer; - protected - procedure dlRemove(AItem: TRtfItem; DisposeIt: boolean); - public - constructor Create; virtual; - destructor Destroy; override; - - procedure Clear; - function Add(AItem: TRtfItem): TRtfItem; - procedure SaveToStream(AStream: TStream; AColors: string); - procedure Insert(AItem: TRtfItem); {-Insert element at start of list} - procedure Delete(AItem: TRtfItem); {-Delete existing element in list, disposing of its contents} - procedure Extract(AItem: TRtfItem); {-Extract existing element from list without disposing of it} - procedure PlaceAfter(AItem, AAfter: TRtfItem); {-Place element P into list _after_ existing element L} - procedure PlaceBefore(AItem, ABefore: TRtfItem); {-Place element P into list _before_ existing element L} - - property Head: TRtfItem read FHead; {-Return TRtfItem to head of list} - property Tail: TRtfItem read FTail; {-Return TRtfItem to tail of list} - property Count: integer read FCount; - end; - - - //Variable definition - TRtfVariable = class(TObject) - private - FName: string; - FValue: variant; - FToken: TRtfToken; - public - property Name: string read FName write FName; - property Value: variant read FValue write FValue; - property Token: TRtfToken read FToken write FToken; - end; - - - TRtfVariableList = class(TObjectList) - private - function GetItem(Index: integer): TRtfVariable; - public - destructor Destroy; override; - function Find(AName: string): TRtfVariable; - function Add(AName: string; AValue: variant; AToken: TRtfToken): TRtfVariable; - property Items[Index: integer]: TRtfVariable read GetItem; default; - end; - - - //Function definition - TRtfFunction = class(TObject) - private - FMin: smallint; - FMax: smallint; - FName: string; - FToken: TRtfToken; - FOnExecute: TRtfFunctionExecute; - public - property Name: string read FName write FName; //Function name - property Min: smallint read FMin write FMin; //Function minimal parameters - property Max: smallint read FMax write FMax; //Function maximal parameters - property Token: TRtfToken read FToken write FToken; //Function type (=weak name) - property OnExecute: TRtfFunctionExecute read FOnExecute write FOnExecute; - end; - - - TRtfFunctionList = class(TObjectList) - private - function GetItem(Index: integer): TRtfFunction; - public - function Find(AName: string): TRtfFunction; - function Add(ATokenType: TRtfToken; AName: string; AMin, AMax: smallint; AOnexecute: TRtfFunctionExecute): TRtfFunction; - property Items[Index: integer]: TRtfFunction read GetItem; default; - end; - - - //Dataset defintion (Simply a wrap around the TDataset compatible and framework objects) - TRtfDataset = class(TObjectList) - private - FName: string; - FDataset: TObject; - FParent: TRtfDataset; - FTableIndex: integer; - FFreeDataset: boolean; - function GetItem(Index: integer): TRtfDataset; - function ResolveNestedFields(ATable: TRtfDataset; AName: string; var AFieldName: string): TRtfDataset; - protected - procedure Notify(Ptr: pointer; Action: TListNotification); override; - public - destructor Destroy; override; - function Find(AName: string): TRtfDataset; overload; - function Find(AName: string; out AFieldName: string): TRtfDataset; overload; - function Add(ADataset: TObject; AName: string; AFreeDataset: boolean = false): TRtfDataset; - property Items[Index: integer]: TRtfDataset read GetItem; default; - - procedure Open; - procedure Next; - procedure Prior; - procedure First; - procedure Last; - function Eof: boolean; - function Bof: boolean; - function IsEmpty: boolean; - function RecordCount: integer; - - property Parent: TRtfDataset read FParent; - property Name: string read FName write FName; //TableName - property FreeDataset: boolean read FFreeDataset; - property Dataset: TObject read FDataset write FDataset; - property TableIndex: integer read FTableIndex write FTableIndex; //Record index - end; - - - //Argument definition (For evaluating of expressions) - TRtfArgument = class(TObjectList) - private - FValue: variant; - FParent: TRtfArgument; - FToken: TRtfToken; - FParam: integer; - FParser: TtiRtfParser; - procedure ResolveVariable; - procedure EvaluateExpression; - function GetItem(Index: integer): TRtfArgument; - function Add(AArgument: TRtfArgument): TRtfArgument; overload; - function Add(AValue: variant; ATokenType: TRtfToken): TRtfArgument; overload; - procedure Walk(ATokenset: TRtfTokenSet; AExecproc: TRtfArgumentEvent); - procedure EvaluateAssign(APrevItem, AArgument, ANextItem: TRtfArgument); - procedure EvaluateComparison(APrevItem, AArgument, ANextItem: TRtfArgument); - procedure EvaluateUnaryBinary(APrevItem, AArgument, ANextItem: TRtfArgument); - protected - procedure Notify(Ptr: pointer; Action: TListNotification); override; - //Dataset stuff - procedure ResolveFieldName; - function GetPicture(APicture: TPicture): string; - procedure GetGraphicsValue(ADataset: TRtfDataset; AFieldName: string); - procedure ResolveFieldValue(ADataset: TRtfDataset; AFieldName: string); - procedure GetPictureData(ABuffer: pointer; ALength: cardinal; var Result: string); - public - constructor Create(AParser: TtiRtfParser); overload; - procedure Evaluate; - function Check(AParam: integer; ATokens: TRtfTokenSet): boolean; overload; - function Check(ATokens: array of TRtfTokenSet): boolean; overload; - procedure ParseExpression(AExpression: string); virtual; - - property Parser: TtiRtfParser read FParser; - property Parent: TRtfArgument read FParent; //Parent argument list - property Value: variant read FValue write FValue; //Argument value - property Param: integer read FParam write FParam; //Just for Scan(Dataset) - property Token: TRtfToken read FToken write FToken; //Argument type - property Items[Index: integer]: TRtfArgument read GetItem; default; - end; - - - //Color definition - TRtfColor = class(TObject) - private - FBlue: integer; - FRed: integer; - FGreen: integer; - function GetAsString: string; - public - property Red: integer read FRed write FRed; - property Green: integer read FGreen write FGreen; - property Blue: integer read FBlue write FBlue; - property AsString: string read GetAsString; - end; - - - TRtfColorList = class(TObjectlist) - private - function GetItem(Index: integer): TRtfColor; - function GetAsString: string; - public - property AsString: string read GetAsString; - procedure Clear; override; - function UseColor(AColor: TColor): integer; overload; - function Add(ARed, AGreen, ABlue: integer): integer; - function Find(ARed, AGreen, ABlue: integer): integer; - function UseColor(ARed, AGreen, ABlue: integer): integer; overload; - property Items[Index: integer]: TRtfColor read GetItem; default; - end; - - - //Parser definition - TtiRtfParser = class(TObject) - private - FBoolTrue: string; - FBoolFalse: string; - FHlpItems: TRtfItem; - TmpItems: TObjectlist; - FDatasets: TRtfDataset; - FRtfItems: TRtfItemList; - FErrorBackColor: TColor; - FErrorForeColor: TColor; - FRawItems: TRtfItemList; - FColorList: TRtfColorList; - FFunctions: TRtfFunctionList; - FVariables: TRtfVariableList; - FOnPicturePath: TRtfPicturePath; - FOnPictureAttr: TRtfOnPictureAttr; - FOnEvalutate: TRtfFunctionExecute; - FPictureOptions: TRtfPictureOptions; - FOnCreateDataset: TRtfOnCreateDataset; - procedure PreParse; - procedure Parse(AItems: TRtfItem); - procedure ParseExpression(AItem: TRtfItem); - function AddToRtfItems(AItem: TRtfItem): TRtfItem; - function SkipParagraph(AItem: TRtfItem): TRtfItem; - procedure UdfDateTimeTo(AArgument: TRtfArgument; AFormat: string); - protected - procedure AddFunctions; virtual; - procedure UdfDummy(AArgument: TRtfArgument); - - //routines for date time - procedure UdfNow(AArgument: TRtfArgument); - procedure UdfDate(AArgument: TRtfArgument); - procedure UdfTime(AArgument: TRtfArgument); - procedure UdfYear(AArgument: TRtfArgument); - procedure UdfMonth(AArgument: TRtfArgument); - procedure UdfDay(AArgument: TRtfArgument); - procedure UdfShortDayName(AArgument: TRtfArgument); - procedure UdfShortMonthName(AArgument: TRtfArgument); - procedure UdfLongDayName(AArgument: TRtfArgument); - procedure UdfLongMonthName(AArgument: TRtfArgument); - { year as string } - procedure UdfSYear(AArgument: TRtfArgument); - { month as string } - procedure UdfSMonth(AArgument: TRtfArgument); - { day as string } - procedure UdfSDay(AArgument: TRtfArgument); - { string to date } - procedure UdfStod(AArgument: TRtfArgument); - { date to string } - procedure UdfDtoS(AArgument: TRtfArgument); - procedure UdfDateToStr(AArgument: TRtfArgument); - procedure UdfTimeToStr(AArgument: TRtfArgument); - procedure UdfDateTimeToStr(AArgument: TRtfArgument); - procedure UdfStrToDate(AArgument: TRtfArgument); - procedure UdfStrToTime(AArgument: TRtfArgument); - procedure UdfStrToDateTime(AArgument: TRtfArgument); - - //routines for strings, int, float etc. - procedure UdfInt(AArgument: TRtfArgument); - procedure UdfStr(AArgument: TRtfArgument); - procedure UdfVal(AArgument: TRtfArgument); - procedure UdfChr(AArgument: TRtfArgument); - procedure UdfNul(AArgument: TRtfArgument); - procedure UdfFrac(AArgument: TRtfArgument); - procedure UdfEmpty(AArgument: TRtfArgument); - procedure UdfPadr(AArgument: TRtfArgument); - procedure UdfPadl(AArgument: TRtfArgument); - procedure UdfLower(AArgument: TRtfArgument); - procedure UdfUpper(AArgument: TRtfArgument); - procedure UdfTrunc(AArgument: TRtfArgument); - procedure UdfRound(AArgument: TRtfArgument); - procedure UdfTrim(AArgument: TRtfArgument); - procedure UdfPower(AArgument: TRtfArgument); - procedure UdfIntPower(AArgument: TRtfArgument); - procedure UdfTrimLeft(AArgument: TRtfArgument); - procedure UdfTrimRight(AArgument: TRtfArgument); - procedure UdfSubStr(AArgument: TRtfArgument); - procedure UdfIntToStr(AArgument: TRtfArgument); - procedure UdfStrToInt(AArgument: TRtfArgument); - procedure UdfFloatToStr(AArgument: TRtfArgument); - procedure UdfStrToFloat(AArgument: TRtfArgument); - procedure UdfFormatFloat(AArgument: TRtfArgument); - procedure UdfFBool(AArgument: TRtfArgument); - - //routines for conditinals - procedure UdfIf(AArgument: TRtfArgument); - procedure UdfIif(AArgument: TRtfArgument); - - //routines for datasets - procedure UdfDataset(AArgument: TRtfArgument); - procedure UdfScan(AArgument: TRtfArgument); - procedure UdfBof(AArgument: TRtfArgument); - procedure UdfEof(AArgument: TRtfArgument); - procedure UdfNext(AArgument: TRtfArgument); - procedure UdfPrior(AArgument: TRtfArgument); - procedure UdfFirst(AArgument: TRtfArgument); - procedure UdfLast(AArgument: TRtfArgument); - procedure UdfOpen(AArgument: TRtfArgument); - procedure UdfIsEmpty(AArgument: TRtfArgument); - procedure UdfRecordCount(AArgument: TRtfArgument); - - //misch routines - procedure UdfPicture(AArgument: TRtfArgument); - procedure UdfDbPicture(AArgument: TRtfArgument); - public - constructor Create; virtual; - destructor Destroy; override; - - procedure Clear; - procedure Execute; virtual; - - procedure LoadFromFile(AFilename: string); - procedure LoadFromString(AString: string); - procedure LoadFromStream(AStream: TMemoryStream); - procedure LoadFromBuffer(ABuffer: pchar; ASize: integer); - - function SaveToString: string; - procedure SaveToFile(AFileName: string); - procedure SaveToStream(AStream: TMemoryStream); - - function AddVariable(AName: string; AValue: variant; AToken: TRtfToken): TRtfVariable; - function AddDataset(ATable: TObject; AName: string; AFreeDataset: boolean = false): TRtfDataset; - function AddFunction(AName: string; ATokenType: TRtfToken; AMin, AMax: smallint; AOnexecute: TRtfFunctionExecute): TRtfFunction; - - - //these should all be hidden in component style - property RawItems: TRtfItemList read FRawItems; - property HlpItems: TRtfItem read FHlpItems; - property RtfItems: TRtfItemList read FRtfItems; - property Datasets: TRtfDataset read FDatasets; - property Functions: TRtfFunctionList read FFunctions; - property Variables: TRtfVariableList read FVariables; - property ColorList: TRtfColorList read FColorList; - property OnEvalutate: TRtfFunctionExecute read FOnEvalutate write FOnEvalutate; //For debug only - published - property BoolTrue: string read FBoolTrue write FBoolTrue; - property BoolFalse: string read FBoolFalse write FBoolFalse; - property ErrorForeColor: TColor read FErrorForeColor write FErrorForeColor default clRed; - property ErrorBackColor: TColor read FErrorBackColor write FErrorBackColor default clYellow; - property PictureOptions: TRtfPictureOptions read FPictureOptions write FPictureOptions default[poMetafile, poBinary]; - - property OnPicturePath: TRtfPicturePath read FOnPicturePath write FOnPicturePath; - property OnPictureAttr: TRtfOnPictureAttr read FOnPictureAttr write FOnPictureAttr; - property OnCreateDataset: TRtfOnCreateDataset read FOnCreateDataset write FOnCreateDataset; - end; - -implementation - -uses - math // IntPower() function - ,fpg_main // fpgApplication.HandleExeception() - ; - -resourcestring - rsNotImplemented = 'Not implemented'; - rsInvalidDateConstant = 'Invalid date constant'; - rsInvalidTimeConstant = 'Invalid time constant'; - rsInvalidDateSeparator = 'Invalid date separator'; - rsInvalidTimeSeparator = 'Invalid time separator'; - rsInvalidDateTimeConstant = 'Invalid date/time constant'; - rsInvalidExpressionCharacter = 'Invalid expression character "%s"'; - rsUnterminatedStringConstant = 'Unterminated string constant'; - rsToManyClosingParenthesis = 'Unexpected parenthesis'; - rsExpectedClosingParenthesis = 'Missing closing parenthesis'; - rsUnexpectedParameterType = 'Unexpected parameter type'; - -type - TRtfKey = record - RtfKMajor: integer; - RtfKMinor: integer; - RtfKStr: string; - end; - - - TRawRtfParser = class(TObject) - private - APtr, AEnd: pchar; - APushedChar: char; - FRtfMajor: integer; - FRtfMinor: integer; - FRtfTextBuf: string; - AParseItem: TRtfItem; - FRtfClass: TRtfClass; - FColorTable: TRtfItem; - RawItems: TRtfItemList; - procedure RtfHook; - procedure GetRtfToken; - function GetRtfChar: char; - protected - property RtfClass: TRtfClass read FRtfClass; - property RtfMajor: integer read FRtfMajor; - property RtfMinor: integer read FRtfMinor; - property RtfTextBuf: string read FRtfTextBuf; - public - procedure Execute(ARawItems: TRtfItemList; ARtfPtr: pchar; ARtfSize: integer); - - property ColorTable: TRtfItem read FColorTable; - end; - - - -const - {@indent off} - //Control class major numbers - //RtfVersion = 01; - //RtfDefFont = 02; - //RtfCharSet = 03; - RtfDestination = 04; - //RtfFontFamily = 05; - //RtfColorName = 06; - RtfSpecialChar = 07; - //RtfStyleAttr = 08; - //RtfDocAttr = 09; - //RtfSectAttr = 10; - //RtfTblAttr = 11; - RtfParAttr = 12; - //RtfCharAttr = 13; - //RtfPictAttr = 14; - //RtfNeXTGrAttr = 15; - //RtfFieldAttr = 16; - //RtfTOCAttr = 17; - //RtfPosAttr = 18; - - //RtfExpression major numbers - RtfNormalExpression = 1; - RtfIfExpression = 2; - RtfThenExpression = 3; - RtfElseExpression = 4; - RtfEndifExpression = 5; - RtfScan = 6; - RtfScanEntry = 7; - RtfScanFooter = 8; - RtfScanEnd = 9; - - //Group class major numbers - RtfBeginGroup = 01; - RtfEndGroup = 02; - - //Control class minor numbers - {RtfAnsiCharSet = 0; - RtfMacCharSet = 1; - RtfPcCharSet = 2; - RtfPcaCharSet = 3;} - - - //Destination attributes minor numbers - {RtfPict = 0; - RtfNeXTGraphic = 1; - RtfFootnote = 2; - RtfHeader = 3; - RtfHeaderLeft = 4; - RtfHeaderRight = 5; - RtfHeaderFirst = 6; - RtfFooter = 7; - RtfFooterLeft = 8; - RtfFooterRight = 9; - RtfFooterFirst = 10; - RtfFNSep = 11; - RtfFNContSep = 12; - RtfFNContNotice = 13;} - RtfInfo = 14; - RtfStyleSheet = 15; - RtfFontTbl = 16; - RtfColorTbl = 17; - RtfField = 18; - {RtfFieldInst = 19; - RtfFieldResult = 20; - RtfIndex = 21; - RtfIndexBold = 22; - RtfIndexItalic = 23; - RtfIndexText = 24; - RtfIndexRange = 25; - RtfTOC = 26; - RtfBookmarkStart = 27; - RtfBookmarkEnd = 28; - RtfITitle = 29; - RtfISubject = 30; - RtfIAuthor = 31; - RtfIOperator = 32; - RtfIKeywords = 33; - RtfIComment = 34; - RtfIVersion = 35; - RtfIDoccomm = 36;} - - //Fonts minor numbers - {RtfFFNil = 0; - RtfFFRoman = 1; - RtfFFSwiss = 2; - RtfFFModern = 3; - RtfFFScript = 4; - RtfFFDecor = 5; - RtfFFTech = 6;} - - //Color attributes minor numbers - {RtfRed = 0; - RtfGreen = 1; - RtfBlue = 2;} - - //Style attributes minor numbers - {RtfBasedOn = 0; - RtfNext = 1;} - - //Special characters minor numbers - {RtfCurHeadPage = 0; - RtfCurFNote = 1; - RtfCurHeadPict = 2; - RtfCurHeadDate = 3; - RtfCurHeadTime = 4;} - RtfFormula = 5; - RtfNoBrkSpace = 6; - RtfNoReqHyphen = 7; - RtfNoBrkHyphen = 8; - {RtfPage = 9; - RtfLine = 10;} - RtfPar = 11; - {RtfSect = 12;} - RtfTab = 13; - {RtfCell = 14; - RtfRow = 15; - RtfCurAnnot = 16; - RtfAnnotation = 17; - RtfAnnotID = 18; - RtfCurAnnotRef = 19; - RtfFNoteSep = 20; - RtfFNoteCont = 21; - RtfColumn = 22;} - RtfOptDest = 23; - {RtfIIntVersion = 24; - RtfICreateTime = 25; - RtfIRevisionTime = 26; - RtfIPrintTime = 27; - RtfIBackupTime = 28; - RtfIEditTime = 29; - RtfIYear = 30; - RtfIMonth = 31; - RtfIDay = 32; - RtfIHour = 33; - RtfIMinute = 34; - RtfINPages = 35; - RtfINWords = 36; - RtfINChars = 37; - RtfIIntID = 38;} - RtflQuote = 39; - RtfrQuote = 40; - RtflDblQuote = 41; - RtfrDblQuote = 42; - - - //Document atributes minor numbers - {RtfPaperWidth = 0; - RtfPaperHeight = 1; - RtfLeftMargin = 2; - RtfRightMargin = 3; - RtfTopMargin = 4; - RtfBottomMargin = 5; - RtfFacingPage = 6; - RtfGutterWid = 7; - RtfDefTab = 8; - RtfWidowCtrl = 9; - RtfHyphHotZone = 10; - RtfFNoteEndSect = 11; - RtfFNoteEndDoc = 12; - RtfFNoteText = 13; - RtfFNoteBottom = 14; - RtfFNoteStart = 15; - RtfFNoteRestart = 16; - RtfPageStart = 17; - RtfLineStart = 18; - RtfLandscape = 19; - RtfFracWidth = 20; - RtfNextFile = 21; - RtfTemplate = 22; - RtfMakeBackup = 23; - RtfRtfDefault = 24; - RtfRevisions = 25; - RtfMirrorMargin = 26; - RtfRevDisplay = 27; - RtfRevBar = 28;} - - //Sector attributes minor numbers - {RtfSectDef = 0; - RtfNoBreak = 1; - RtfColBreak = 2; - RtfPageBreak = 3; - RtfEvenBreak = 4; - RtfOddBreak = 5; - RtfPageStarts = 6; - RtfPageCont = 7; - RtfPageRestart = 8; - RtfPageDecimal = 9; - RtfPageURoman = 10; - RtfPageLRoman = 11; - RtfPageULetter = 12; - RtfPageLLetter = 13; - RtfPageNumLeft = 14; - RtfPageNumTop = 15; - RtfHeaderY = 16; - RtfFooterY = 17; - RtfLineModulus = 18; - RtfLineDist = 19; - RtfLineStarts = 20; - RtfLineRestart = 21; - RtfLineRestartPg = 22; - RtfLineCont = 23; - RtfTopVAlign = 24; - RtfBottomVAlign = 25; - RtfCenterVAlign = 26; - RtfJustVAlign = 27; - RtfColumns = 28; - RtfColumnSpace = 29; - RtfColumnLine = 30; - RtfENoteHere = 31; - RtfTitleSpecial = 32;} - - //Table attributes minor numbers - {RtfCellBordBottom = 0; - RtfCellBordTop = 1; - RtfCellBordLeft = 2; - RtfCellBordRight = 3; - RtfRowDef = 4; - RtfRowLeft = 5; - RtfRowRight = 6; - RtfRowCenter = 7; - RtfRowGapH = 8; - RtfRowHt = 9; - RtfRowLeftEdge = 10; - RtfCellPos = 11; - RtfMergeRngFirst = 12; - RtfMergePrevious = 13;} - - //Paragrapgh attributes minor numbers - RtfParDef = 0; - {RtfStyleNum = 1; - RtfQuadLeft = 2; - RtfQuadRight = 3; - RtfQuadJust = 4; - RtfQuadCenter = 5; - RtfFirstIndent = 6; - RtfLeftIndent = 7; - RtfRightIndent = 8; - RtfSpaceBefore = 9; - RtfSpaceAfter = 10; - RtfSpaceBetween = 11; - RtfInTable = 12; - RtfKeep = 13; - RtfKeepNext = 14; - RtfSideBySide = 15; - RtfPBBefore = 16; - RtfNoLineNum = 17; - RtfTabPos = 18; - RtfTabRight = 19; - RtfTabCenter = 20; - RtfTabDecimal = 21; - RtfTabBar = 22; - RtfBorderTop = 23; - RtfBorderBottom = 24; - RtfBorderLeft = 25; - RtfBorderRight = 26; - RtfBorderBox = 27; - RtfBorderBar = 28; - RtfBorderBetween = 29; - RtfBorderSingle = 30; - RtfBorderThick = 31; - RtfBorderShadow = 32; - RtfBorderDouble = 33; - RtfBorderDot = 34; - RtfBorderHair = 35; - RtfBorderSpace = 36; - RtfLeaderDot = 37; - RtfLeaderHyphen = 38; - RtfLeaderUnder = 39; - RtfLeaderThick = 40;} - - //Character attributes minor numbers - {RtfPlain = 0; - RtfBold = 1; - RtfItalic = 2; - RtfStrikeThru = 3; - RtfOutline = 4; - RtfShadow = 5; - RtfSmallCaps = 6; - RtfAllCaps = 7; - RtfInvisible = 8; - RtfFontNum = 9; - RtfFontSize = 10; - RtfExpand = 11; - RtfUnderline = 12; - RtfWUnderline = 13; - RtfDUnderline = 14; - RtfDbUnderline = 15; - RtfNoUnderline = 16; - RtfSuperScript = 17; - RtfSubScript = 18; - RtfRevised = 19; - RtfForeColor = 20; - RtfBackColor = 21; - RtfGray = 22; } - - //Picture attributes minor numbers - {RtfMacQD = 0; - RtfWinMetafile = 1; - RtfWinBitmap = 2; - RtfPicWid = 3; - RtfPicHt = 4; - RtfPicGoalWid = 5; - RtfPicGoalHt = 6; - RtfPicScaleX = 7; - RtfPicScaleY = 8; - RtfPicScaled = 9; - RtfPicCropTop = 10; - RtfPicCropBottom = 11; - RtfPicCropLeft = 12; - RtfPicCropRight = 13; - RtfPixelBits = 14; - RtfBitmapPlanes = 15; - RtfBitmapWid = 16; - RtfPicBinary = 17;} - - // - {RtfNeXTGWidth = 0; - RtfNeXTGHeight = 1;} - - //Field attributes minor numbers - {RtfFieldDirty = 0; - RtfFieldEdited = 1; - RtfFieldLocked = 2; - RtfFieldPrivate = 3;} - - //Toc attributes minor numbers - {RtfTOCType = 0; - RtfTOCLevel = 1;} - - //Position attributes minor numbers - {RtfPosX = 0; - RtfPosXCenter = 1; - RtfPosXInside = 2; - RtfPosXLeft = 3; - RtfPosXOutSide = 4; - RtfPosXRight = 5; - RtfPosY = 6; - RtfPosYInline = 7; - RtfPosYTop = 8; - RtfPosYCenter = 9; - RtfPosYBottom = 10; - RtfAbsWid = 11; - RtfTextDist = 12; - RtfRPosMargV = 13; - RtfRPosPageV = 14; - RtfRPosMargH = 15; - RtfRPosPageH = 16; - RtfRPosColH = 17;} - -const - //A reduced set of control words - RtfKey: array[0..15]of TRtfKey = - ( - (RtfKMajor: RtfParAttr; RtfKMinor: RtfParDef; RtfKStr: '\pard' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfPar; RtfKStr: '\par' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfTab; RtfKStr: '\tab' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtflQuote; RtfKStr: '\lquote' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfrQuote; RtfKStr: '\rquote' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtflQuote; RtfKStr: '\'+Chr(39)+'91'), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfrQuote; RtfKStr: '\'+Chr(39)+'92'), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtflDblQuote; RtfKStr: '\ldblquote' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfrDblQuote; RtfKStr: '\rdblquote' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtflDblQuote; RtfKStr: '\'+Chr(39)+'93'), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfrDblQuote; RtfKStr: '\'+Chr(39)+'94'), - (RtfKMajor: RtfDestination; RtfKMinor: RtfInfo; RtfKStr: '\info' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfStyleSheet; RtfKStr: '\stylesheet' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfFontTbl; RtfKStr: '\fonttbl' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfColorTbl; RtfKStr: '\colortbl' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfField; RtfKStr: '\field' ) - ); - - { You could also add the following (but i don't need all that): - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfCurHeadPict; RtfKStr: '\chpict' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfCurHeadDate; RtfKStr: '\chdate' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfCurHeadTime; RtfKStr: '\chtime' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfCurHeadPage; RtfKStr: '\chpgn' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfCurFNote; RtfKStr: '\chftn' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfCurAnnotRef; RtfKStr: '\chatn' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfFNoteSep; RtfKStr: '\chftnsep' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfFNoteCont; RtfKStr: '\chftnsepc' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfCell; RtfKStr: '\cell' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfRow; RtfKStr: '\row' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfSect; RtfKStr: '\sect' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfPage; RtfKStr: '\page' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfColumn; RtfKStr: '\column' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfLine; RtfKStr: '\line' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfIIntVersion; RtfKStr: '\vern' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfICreateTime; RtfKStr: '\creatim' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfIRevisionTime; RtfKStr: '\revtim' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfIPrintTime; RtfKStr: '\printim' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfIBackupTime; RtfKStr: '\buptim' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfIEditTime; RtfKStr: '\edmins' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfIYear; RtfKStr: '\yr' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfIMonth; RtfKStr: '\mo' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfIDay; RtfKStr: '\dy' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfIHour; RtfKStr: '\hr' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfIMinute; RtfKStr: '\min' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfINPages; RtfKStr: '\nofpages' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfINWords; RtfKStr: '\nofwords' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfINChars; RtfKStr: '\nofchars' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfIIntID; RtfKStr: '\id' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfPict; RtfKStr: '\pict' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfNeXTGraphic; RtfKStr: '\nextgraphic' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfFootnote; RtfKStr: '\footnote' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfHeader; RtfKStr: '\header' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfHeaderLeft; RtfKStr: '\headerl' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfHeaderRight; RtfKStr: '\headerr' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfHeaderFirst; RtfKStr: '\headerf' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfFooter; RtfKStr: '\footer' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfFooterLeft; RtfKStr: '\footerl' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfFooterRight; RtfKStr: '\footerr' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfFooterFirst; RtfKStr: '\footerf' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfFNSep; RtfKStr: '\ftnsep' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfFNContSep; RtfKStr: '\ftnsepc' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfFNContNotice; RtfKStr: '\ftncn' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfAnnotation; RtfKStr: '\annotation' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfAnnotID; RtfKStr: '\atnid' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfFieldInst; RtfKStr: '\fldinst' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfFieldResult; RtfKStr: '\fldrslt' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfIndex; RtfKStr: '\xe' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfIndexBold; RtfKStr: '\bxe' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfIndexItalic; RtfKStr: '\ixe' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfIndexText; RtfKStr: '\txe' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfIndexRange; RtfKStr: '\rxe' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfTOC; RtfKStr: '\tc' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfBookmarkStart; RtfKStr: '\bkmkstart' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfBookmarkEnd; RtfKStr: '\bkmkend' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfITitle; RtfKStr: '\title' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfISubject; RtfKStr: '\subject' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfIAuthor; RtfKStr: '\author' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfIOperator; RtfKStr: '\operator' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfIKeywords; RtfKStr: '\keywords' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfIComment; RtfKStr: '\comment' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfIVersion; RtfKStr: '\version' ), - (RtfKMajor: RtfDestination; RtfKMinor: RtfIDoccomm; RtfKStr: '\doccomm' ), - (RtfKMajor: RtfVersion; RtfKMinor: - 1; RtfKStr: '\rtf' ), - (RtfKMajor: RtfDefFont; RtfKMinor: - 1; RtfKStr: '\deff' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfStyleNum; RtfKStr: '\s' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfQuadLeft; RtfKStr: '\ql' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfQuadRight; RtfKStr: '\qr' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfQuadJust; RtfKStr: '\qj' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfQuadCenter; RtfKStr: '\qc' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfFirstIndent; RtfKStr: '\fi' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfLeftIndent; RtfKStr: '\li' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfRightIndent; RtfKStr: '\ri' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfSpaceBefore; RtfKStr: '\sb' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfSpaceAfter; RtfKStr: '\sa' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfSpaceBetween; RtfKStr: '\sl' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfInTable; RtfKStr: '\intbl' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfKeep; RtfKStr: '\keep' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfKeepNext; RtfKStr: '\keepn' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfSideBySide; RtfKStr: '\sbys' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfPBBefore; RtfKStr: '\pagebb' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfNoLineNum; RtfKStr: '\noline' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfTabPos; RtfKStr: '\tx' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfTabRight; RtfKStr: '\tqr' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfTabCenter; RtfKStr: '\tqc' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfTabDecimal; RtfKStr: '\tqdec' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfTabBar; RtfKStr: '\tb' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfBorderTop; RtfKStr: '\brdrt' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfBorderBottom; RtfKStr: '\brdrb' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfBorderLeft; RtfKStr: '\brdrl' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfBorderRight; RtfKStr: '\brdrr' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfBorderBar; RtfKStr: '\bar' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfBorderBox; RtfKStr: '\box' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfBorderBetween; RtfKStr: '\brdrbtw' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfBorderSingle; RtfKStr: '\brdrs' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfBorderThick; RtfKStr: '\brdrth' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfBorderShadow; RtfKStr: '\brdrsh' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfBorderDouble; RtfKStr: '\brdrdb' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfBorderDot; RtfKStr: '\brdrdot' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfBorderHair; RtfKStr: '\brdrhair' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfLeaderDot; RtfKStr: '\tldot' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfLeaderHyphen; RtfKStr: '\tlhyph' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfLeaderUnder; RtfKStr: '\tlul' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfLeaderThick; RtfKStr: '\tlth' ), - (RtfKMajor: RtfParAttr; RtfKMinor: RtfBorderSpace; RtfKStr: '\brsp' ), - (RtfKMajor: RtfTblAttr; RtfKMinor: RtfCellBordBottom; RtfKStr: '\clbrdrb' ), - (RtfKMajor: RtfTblAttr; RtfKMinor: RtfCellBordTop; RtfKStr: '\clbrdrt' ), - (RtfKMajor: RtfTblAttr; RtfKMinor: RtfCellBordLeft; RtfKStr: '\clbrdrl' ), - (RtfKMajor: RtfTblAttr; RtfKMinor: RtfCellBordRight; RtfKStr: '\clbrdrr' ), - (RtfKMajor: RtfTblAttr; RtfKMinor: RtfRowDef; RtfKStr: '\trowd' ), - (RtfKMajor: RtfTblAttr; RtfKMinor: RtfRowLeft; RtfKStr: '\trql' ), - (RtfKMajor: RtfTblAttr; RtfKMinor: RtfRowRight; RtfKStr: '\trqr' ), - (RtfKMajor: RtfTblAttr; RtfKMinor: RtfRowCenter; RtfKStr: '\trqc' ), - (RtfKMajor: RtfTblAttr; RtfKMinor: RtfRowGapH; RtfKStr: '\trgaph' ), - (RtfKMajor: RtfTblAttr; RtfKMinor: RtfRowHt; RtfKStr: '\trrh' ), - (RtfKMajor: RtfTblAttr; RtfKMinor: RtfRowLeftEdge; RtfKStr: '\trleft' ), - (RtfKMajor: RtfTblAttr; RtfKMinor: RtfCellPos; RtfKStr: '\cellx' ), - (RtfKMajor: RtfTblAttr; RtfKMinor: RtfMergeRngFirst; RtfKStr: '\clmgf' ), - (RtfKMajor: RtfTblAttr; RtfKMinor: RtfMergePrevious; RtfKStr: '\clmrg' ), - (RtfKMajor: RtfTOCAttr; RtfKMinor: RtfTOCType; RtfKStr: '\tcf' ), - (RtfKMajor: RtfTOCAttr; RtfKMinor: RtfTOCLevel; RtfKStr: '\tcl' ), - (RtfKMajor: RtfFontFamily; RtfKMinor: RtfFFNil; RtfKStr: '\fnil' ), - (RtfKMajor: RtfFontFamily; RtfKMinor: RtfFFRoman; RtfKStr: '\froman' ), - (RtfKMajor: RtfFontFamily; RtfKMinor: RtfFFSwiss; RtfKStr: '\fswiss' ), - (RtfKMajor: RtfFontFamily; RtfKMinor: RtfFFModern; RtfKStr: '\fmodern' ), - (RtfKMajor: RtfFontFamily; RtfKMinor: RtfFFScript; RtfKStr: '\fscript' ), - (RtfKMajor: RtfFontFamily; RtfKMinor: RtfFFDecor; RtfKStr: '\fdecor' ), - (RtfKMajor: RtfFontFamily; RtfKMinor: RtfFFTech; RtfKStr: '\ftech' ), - (RtfKMajor: RtfCharSet; RtfKMinor: RtfMacCharSet; RtfKStr: '\mac' ), - (RtfKMajor: RtfCharSet; RtfKMinor: RtfAnsiCharSet; RtfKStr: '\ansi' ), - (RtfKMajor: RtfCharSet; RtfKMinor: RtfPcCharSet; RtfKStr: '\pc' ), - (RtfKMajor: RtfCharSet; RtfKMinor: RtfPcaCharSet; RtfKStr: '\pca' ), - (RtfKMajor: RtfCharAttr; RtfKMinor: RtfPlain; RtfKStr: '\plain' ), - (RtfKMajor: RtfCharAttr; RtfKMinor: RtfBold; RtfKStr: '\b' ), - (RtfKMajor: RtfCharAttr; RtfKMinor: RtfItalic; RtfKStr: '\i' ), - (RtfKMajor: RtfCharAttr; RtfKMinor: RtfStrikeThru; RtfKStr: '\strike' ), - (RtfKMajor: RtfCharAttr; RtfKMinor: RtfOutline; RtfKStr: '\outl' ), - (RtfKMajor: RtfCharAttr; RtfKMinor: RtfShadow; RtfKStr: '\shad' ), - (RtfKMajor: RtfCharAttr; RtfKMinor: RtfSmallCaps; RtfKStr: '\scaps' ), - (RtfKMajor: RtfCharAttr; RtfKMinor: RtfAllCaps; RtfKStr: '\caps' ), - (RtfKMajor: RtfCharAttr; RtfKMinor: RtfInvisible; RtfKStr: '\v' ), - (RtfKMajor: RtfCharAttr; RtfKMinor: RtfFontNum; RtfKStr: '\f' ), - (RtfKMajor: RtfCharAttr; RtfKMinor: RtfFontSize; RtfKStr: '\fs' ), - (RtfKMajor: RtfCharAttr; RtfKMinor: RtfExpand; RtfKStr: '\expnd' ), - (RtfKMajor: RtfCharAttr; RtfKMinor: RtfUnderline; RtfKStr: '\ul' ), - (RtfKMajor: RtfCharAttr; RtfKMinor: RtfWUnderline; RtfKStr: '\ulw' ), - (RtfKMajor: RtfCharAttr; RtfKMinor: RtfDUnderline; RtfKStr: '\uld' ), - (RtfKMajor: RtfCharAttr; RtfKMinor: RtfDbUnderline; RtfKStr: '\uldb' ), - (RtfKMajor: RtfCharAttr; RtfKMinor: RtfNoUnderline; RtfKStr: '\ulnone' ), - (RtfKMajor: RtfCharAttr; RtfKMinor: RtfSuperScript; RtfKStr: '\up' ), - (RtfKMajor: RtfCharAttr; RtfKMinor: RtfSubScript; RtfKStr: '\dn' ), - (RtfKMajor: RtfCharAttr; RtfKMinor: RtfRevised; RtfKStr: '\revised' ), - (RtfKMajor: RtfCharAttr; RtfKMinor: RtfForeColor; RtfKStr: '\cf' ), - (RtfKMajor: RtfCharAttr; RtfKMinor: RtfBackColor; RtfKStr: '\cb' ), - (RtfKMajor: RtfCharAttr; RtfKMinor: RtfGray; RtfKStr: '\gray' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfFormula; RtfKStr: '\|' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfNoBrkSpace; RtfKStr: '\~' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfNoReqHyphen; RtfKStr: '\-' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfNoBrkHyphen; RtfKStr: '\_' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfOptDest; RtfKStr: '\*' ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfPar; RtfKstr: #10 ), - (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfPar; RtfKstr: #13 ), - (RtfKMajor: RtfPosAttr; RtfKMinor: RtfPosX; RtfKStr: '\posx' ), - (RtfKMajor: RtfPosAttr; RtfKMinor: RtfPosXCenter; RtfKStr: '\posxc' ), - (RtfKMajor: RtfPosAttr; RtfKMinor: RtfPosXInside; RtfKStr: '\posxi' ), - (RtfKMajor: RtfPosAttr; RtfKMinor: RtfPosXLeft; RtfKStr: '\posxl' ), - (RtfKMajor: RtfPosAttr; RtfKMinor: RtfPosXOutSide; RtfKStr: '\posxo' ), - (RtfKMajor: RtfPosAttr; RtfKMinor: RtfPosXRight; RtfKStr: '\posxr' ), - (RtfKMajor: RtfPosAttr; RtfKMinor: RtfPosY; RtfKStr: '\posy' ), - (RtfKMajor: RtfPosAttr; RtfKMinor: RtfPosYInline; RtfKStr: '\posyil' ), - (RtfKMajor: RtfPosAttr; RtfKMinor: RtfPosYTop; RtfKStr: '\posyt' ), - (RtfKMajor: RtfPosAttr; RtfKMinor: RtfPosYCenter; RtfKStr: '\posyc' ), - (RtfKMajor: RtfPosAttr; RtfKMinor: RtfPosYBottom; RtfKStr: '\posyb' ), - (RtfKMajor: RtfPosAttr; RtfKMinor: RtfAbsWid; RtfKStr: '\absw' ), - (RtfKMajor: RtfPosAttr; RtfKMinor: RtfTextDist; RtfKStr: '\dxfrtext' ), - (RtfKMajor: RtfPosAttr; RtfKMinor: RtfRPosMargV; RtfKStr: '\pvmrg' ), - (RtfKMajor: RtfPosAttr; RtfKMinor: RtfRPosPageV; RtfKStr: '\pvpg' ), - (RtfKMajor: RtfPosAttr; RtfKMinor: RtfRPosMargH; RtfKStr: '\phmrg' ), - (RtfKMajor: RtfPosAttr; RtfKMinor: RtfRPosPageH; RtfKStr: '\phpg' ), - (RtfKMajor: RtfPosAttr; RtfKMinor: RtfRPosColH; RtfKStr: '\phcol' ), - (RtfKMajor: RtfSectAttr; RtfKMinor: RtfSectDef; RtfKStr: '\sectd' ), - (RtfKMajor: RtfSectAttr; RtfKMinor: RtfNoBreak; RtfKStr: '\sbknone' ), - (RtfKMajor: RtfSectAttr; RtfKMinor: RtfColBreak; RtfKStr: '\sbkcol' ), - (RtfKMajor: RtfSectAttr; RtfKMinor: RtfPageBreak; RtfKStr: '\sbkpage' ), - (RtfKMajor: RtfSectAttr; RtfKMinor: RtfEvenBreak; RtfKStr: '\sbkeven' ), - (RtfKMajor: RtfSectAttr; RtfKMinor: RtfOddBreak; RtfKStr: '\sbkodd' ), - (RtfKMajor: RtfSectAttr; RtfKMinor: RtfPageCont; RtfKStr: '\pgncont' ), - (RtfKMajor: RtfSectAttr; RtfKMinor: RtfPageStarts; RtfKStr: '\pgnstarts' ), - (RtfKMajor: RtfSectAttr; RtfKMinor: RtfPageRestart; RtfKStr: '\pgnrestart' ), - (RtfKMajor: RtfSectAttr; RtfKMinor: RtfPageDecimal; RtfKStr: '\pgndec' ), - (RtfKMajor: RtfSectAttr; RtfKMinor: RtfPageURoman; RtfKStr: '\pgnucrm' ), - (RtfKMajor: RtfSectAttr; RtfKMinor: RtfPageLRoman; RtfKStr: '\pgnlcrm' ), - (RtfKMajor: RtfSectAttr; RtfKMinor: RtfPageULetter; RtfKStr: '\pgnucltr' ), - (RtfKMajor: RtfSectAttr; RtfKMinor: RtfPageLLetter; RtfKStr: '\pgnlcltr' ), - (RtfKMajor: RtfSectAttr; RtfKMinor: RtfPageNumLeft; RtfKStr: '\pgnx' ), - (RtfKMajor: RtfSectAttr; RtfKMinor: RtfPageNumTop; RtfKStr: '\pgny' ), - (RtfKMajor: RtfSectAttr; RtfKMinor: RtfHeaderY; RtfKStr: '\headery' ), - (RtfKMajor: RtfSectAttr; RtfKMinor: RtfFooterY; RtfKStr: '\footery' ), - (RtfKMajor: RtfSectAttr; RtfKMinor: RtfLineModulus; RtfKStr: '\linemod' ), - (RtfKMajor: RtfSectAttr; RtfKMinor: RtfLineDist; RtfKStr: '\linex' ), - (RtfKMajor: RtfSectAttr; RtfKMinor: RtfLineStarts; RtfKStr: '\linestarts' ), - (RtfKMajor: RtfSectAttr; RtfKMinor: RtfLineRestart; RtfKStr: '\linerestart' ), - (RtfKMajor: RtfSectAttr; RtfKMinor: RtfLineRestartPg; RtfKStr: '\lineppage' ), - (RtfKMajor: RtfSectAttr; RtfKMinor: RtfLineCont; RtfKStr: '\linecont' ), - (RtfKMajor: RtfSectAttr; RtfKMinor: RtfTopVAlign; RtfKStr: '\vertalt' ), - (RtfKMajor: RtfSectAttr; RtfKMinor: RtfBottomVAlign; RtfKStr: '\vertal' ), - (RtfKMajor: RtfSectAttr; RtfKMinor: RtfCenterVAlign; RtfKStr: '\vertalc' ), - (RtfKMajor: RtfSectAttr; RtfKMinor: RtfJustVAlign; RtfKStr: '\vertalj' ), - (RtfKMajor: RtfSectAttr; RtfKMinor: RtfColumns; RtfKStr: '\cols' ), - (RtfKMajor: RtfSectAttr; RtfKMinor: RtfColumnSpace; RtfKStr: '\colsx' ), - (RtfKMajor: RtfSectAttr; RtfKMinor: RtfColumnLine; RtfKStr: '\linebetcol' ), - (RtfKMajor: RtfSectAttr; RtfKMinor: RtfENoteHere; RtfKStr: '\endnhere' ), - (RtfKMajor: RtfSectAttr; RtfKMinor: RtfTitleSpecial; RtfKStr: '\titlepg' ) - (RtfKMajor: RtfFieldAttr; RtfKMinor: RtfFieldDirty; RtfKStr: '\flddirty' ), - (RtfKMajor: RtfFieldAttr; RtfKMinor: RtfFieldEdited; RtfKStr: '\fldedit' ), - (RtfKMajor: RtfFieldAttr; RtfKMinor: RtfFieldLocked; RtfKStr: '\fldlock' ), - (RtfKMajor: RtfFieldAttr; RtfKMinor: RtfFieldPrivate; RtfKStr: '\fldpriv' ), - (RtfKMajor: RtfDocAttr; RtfKMinor: RtfPaperWidth; RtfKStr: '\paperw' ), - (RtfKMajor: RtfDocAttr; RtfKMinor: RtfPaperHeight; RtfKStr: '\paperh' ), - (RtfKMajor: RtfDocAttr; RtfKMinor: RtfLeftMargin; RtfKStr: '\margl' ), - (RtfKMajor: RtfDocAttr; RtfKMinor: RtfRightMargin; RtfKStr: '\margr' ), - (RtfKMajor: RtfDocAttr; RtfKMinor: RtfTopMargin; RtfKStr: '\margt' ), - (RtfKMajor: RtfDocAttr; RtfKMinor: RtfBottomMargin; RtfKStr: '\margb' ), - (RtfKMajor: RtfDocAttr; RtfKMinor: RtfFacingPage; RtfKStr: '\facingp' ), - (RtfKMajor: RtfDocAttr; RtfKMinor: RtfGutterWid; RtfKStr: '\gutter' ), - (RtfKMajor: RtfDocAttr; RtfKMinor: RtfDefTab; RtfKStr: '\deftab' ), - (RtfKMajor: RtfDocAttr; RtfKMinor: RtfWidowCtrl; RtfKStr: '\widowctrl' ), - (RtfKMajor: RtfDocAttr; RtfKMinor: RtfHyphHotZone; RtfKStr: '\hyphhotz' ), - (RtfKMajor: RtfDocAttr; RtfKMinor: RtfFNoteEndSect; RtfKStr: '\endnotes' ), - (RtfKMajor: RtfDocAttr; RtfKMinor: RtfFNoteEndDoc; RtfKStr: '\enddoc' ), - (RtfKMajor: RtfDocAttr; RtfKMinor: RtfFNoteBottom; RtfKStr: '\ftnbj' ), - (RtfKMajor: RtfDocAttr; RtfKMinor: RtfFNoteText; RtfKStr: '\ftntj' ), - (RtfKMajor: RtfDocAttr; RtfKMinor: RtfFNoteStart; RtfKStr: '\ftnstart' ), - (RtfKMajor: RtfDocAttr; RtfKMinor: RtfFNoteRestart; RtfKStr: '\ftnrestart' ), - (RtfKMajor: RtfDocAttr; RtfKMinor: RtfPageStart; RtfKStr: '\pgnstart' ), - (RtfKMajor: RtfDocAttr; RtfKMinor: RtfLineStart; RtfKStr: '\linestart' ), - (RtfKMajor: RtfDocAttr; RtfKMinor: RtfLandscape; RtfKStr: '\landscape' ), - (RtfKMajor: RtfDocAttr; RtfKMinor: RtfFracWidth; RtfKStr: '\fracwidth' ), - (RtfKMajor: RtfDocAttr; RtfKMinor: RtfNextFile; RtfKStr: '\nextfile' ), - (RtfKMajor: RtfDocAttr; RtfKMinor: RtfTemplate; RtfKStr: '\template' ), - (RtfKMajor: RtfDocAttr; RtfKMinor: RtfMakeBackup; RtfKStr: '\makeback' ), - (RtfKMajor: RtfDocAttr; RtfKMinor: RtfRtfDefault; RtfKStr: '\defformat' ), - (RtfKMajor: RtfDocAttr; RtfKMinor: RtfRevisions; RtfKStr: '\revisions' ), - (RtfKMajor: RtfDocAttr; RtfKMinor: RtfMirrorMargin; RtfKStr: '\margmirror' ), - (RtfKMajor: RtfDocAttr; RtfKMinor: RtfRevDisplay; RtfKStr: '\revprop' ), - (RtfKMajor: RtfDocAttr; RtfKMinor: RtfRevBar; RtfKStr: '\revbar' ), - (RtfKMajor: RtfStyleAttr; RtfKMinor: RtfBasedOn; RtfKStr: '\sbasedon' ), - (RtfKMajor: RtfStyleAttr; RtfKMinor: RtfNext; RtfKStr: '\snext' ), - (RtfKMajor: RtfColorName; RtfKMinor: RtfRed; RtfKStr: '\red' ), - (RtfKMajor: RtfColorName; RtfKMinor: RtfGreen; RtfKStr: '\green' ), - (RtfKMajor: RtfColorName; RtfKMinor: RtfBlue; RtfKStr: '\blue' ), - (RtfKMajor: RtfPictAttr; RtfKMinor: RtfMacQD; RtfKStr: '\macpict' ), - (RtfKMajor: RtfPictAttr; RtfKMinor: RtfWinMetafile; RtfKStr: '\wmetafile' ), - (RtfKMajor: RtfPictAttr; RtfKMinor: RtfWinBitmap; RtfKStr: '\wbitmap' ), - (RtfKMajor: RtfPictAttr; RtfKMinor: RtfPicWid; RtfKStr: '\picw' ), - (RtfKMajor: RtfPictAttr; RtfKMinor: RtfPicHt; RtfKStr: '\pich' ), - (RtfKMajor: RtfPictAttr; RtfKMinor: RtfPicGoalWid; RtfKStr: '\picwgoal' ), - (RtfKMajor: RtfPictAttr; RtfKMinor: RtfPicGoalWid; RtfKStr: '\picwGoal' ), - (RtfKMajor: RtfPictAttr; RtfKMinor: RtfPicGoalHt; RtfKStr: '\pichgoal' ), - (RtfKMajor: RtfPictAttr; RtfKMinor: RtfPicGoalHt; RtfKStr: '\pichGoal' ), - (RtfKMajor: RtfPictAttr; RtfKMinor: RtfPicScaleX; RtfKStr: '\picscalex' ), - (RtfKMajor: RtfPictAttr; RtfKMinor: RtfPicScaleY; RtfKStr: '\picscaley' ), - (RtfKMajor: RtfPictAttr; RtfKMinor: RtfPicScaled; RtfKStr: '\picscaled' ), - (RtfKMajor: RtfPictAttr; RtfKMinor: RtfPicCropTop; RtfKStr: '\piccropt' ), - (RtfKMajor: RtfPictAttr; RtfKMinor: RtfPicCropBottom; RtfKStr: '\piccropb' ), - (RtfKMajor: RtfPictAttr; RtfKMinor: RtfPicCropLeft; RtfKStr: '\piccropl' ), - (RtfKMajor: RtfPictAttr; RtfKMinor: RtfPicCropRight; RtfKStr: '\piccropr' ), - (RtfKMajor: RtfPictAttr; RtfKMinor: RtfPixelBits; RtfKStr: '\wbmbitspixel' ), - (RtfKMajor: RtfPictAttr; RtfKMinor: RtfBitmapPlanes; RtfKStr: '\wbmplanes' ), - (RtfKMajor: RtfPictAttr; RtfKMinor: RtfBitmapWid; RtfKStr: '\wbmwidthbytes'), - (RtfKMajor: RtfPictAttr; RtfKMinor: RtfPicBinary; RtfKStr: '\bin' ), - (RtfKMajor: RtfNeXTGrAttr; RtfKMinor: RtfNeXTGWidth; RtfKStr: '\width' ), - (RtfKMajor: RtfNeXTGrAttr; RtfKMinor: RtfNeXTGHeight; RtfKStr: '\height' ), - } - {@indent on} - -const - TRtfAnyType: TRtfTokenSet =[etDataset..etLitTrue]; - -function ExtractFieldName(const Fields: string; var Pos: integer): string; -var i: integer; -begin - i := Pos; - while(i <= Length(Fields))and(Fields[i] <> '.')do Inc(i); - Result := Trim(Copy(Fields, Pos, i - Pos)); - if(i <= Length(Fields))and(Fields[i] = '.') - then Inc(i); - Pos := i; -end; - -function Pwr(const Base, Exponent: Double): Double; -begin - if Exponent = 0.0 then - Result := 1.0 { n**0 = 1 } - else if(Base = 0.0)and(Exponent > 0.0) then - Result := 0.0 { 0**n = 0, n > 0 } - else if (Frac(Exponent) = 0.0) and (Abs(Exponent) <= MaxInt) then - Result := IntPower(Base, integer(Trunc(Exponent))) - else - Result := Exp(Exponent * Ln(Base)) -end; - -{ TRtfPictureAttr } - -constructor TRtfPictureAttr.Create(AWidth, AHeigth: word); -begin - inherited Create; - FScaleX := 100; - FScaleY := 100; - FWidth := AWidth; - FHeigth := AHeigth; - FWidthmm := AWidth * 0.264596930676; - FHeigthmm := AHeigth * 0.264596930676; - - FBorderWidth := 0; - FBorderType := brNone; - FBorderColor := clBlack; - FProportional := true; -end; - -procedure TRtfPictureAttr.SetScaleX(Value: integer); -var - AScale: Double; -begin - if Value < 1 then - Value := 1 - else if Value > 100 then - Value := 100; - AScale := Double(Value) / FScaleX; - FScaleX := Value; - FWidth := Round(FWidth * AScale); - FWidthmm := FWidthmm * AScale; - if FProportional then - begin - FScaleY := Round(FScaleY * AScale); - FHeigth := Round(FHeigth * AScale); - FHeigthmm := FHeigthmm * AScale; - end; -end; - -procedure TRtfPictureAttr.SetScaleY(Value: integer); -var - AScale: Double; -begin - if Value < 1 then - Value := 1 - else if Value > 100 then - Value := 100; - AScale := Double(Value) / FScaleY; - FScaleY := Value; - FHeigth := Round(FHeigth * AScale); - FHeigthmm := FHeigthmm * AScale; - if FProportional then - begin - FScaleX := Round(FScaleX * AScale); - FWidth := Round(FWidth * AScale); - FWidthmm := FWidthmm * AScale; - end; -end; - - -{ TRtfItem } - -procedure TRtfItem.Assign(ASource: TRtfItem); -begin - RtfClass := ASource.RtfClass; - RtfMajor := ASource.RtfMajor; - RtfMinor := ASource.RtfMinor; - RtfTextBuf := ASource.RtfTextBuf; -end; - -function TRtfItem.CheckItem(AClass: TRtfClass; Major: integer): boolean; -begin - Result :=(RtfClass = AClass)and(RtfMajor = Major); -end; - -function TRtfItem.GetItem(Index: integer): TRtfItem; -begin - Result := TRtfItem(inherited Items[Index]); -end; - -procedure TRtfItem.Notify(Ptr: pointer; Action: TListNotification); -begin - inherited; - case Action of - lnAdded: TRtfItem(Ptr).FParent := Self; - lnExtracted: TRtfItem(Ptr).FParent := nil; - end; -end; - -{ TRtfItemList } - -constructor TRtfItemList.Create; -//Initialize an empty list -begin - inherited Create; -end; - -destructor TRtfItemList.Destroy; -{-Destroy a list} -var n: TRtfItem; - p: TRtfItem; -begin - n := FTail; - while n <> nil do begin - {Get TRtfItem to previous node} - p := n.FPrev; - {Deallocate and destroy this node} - n.Free; - {Do the previous node} - n := p; - end; - FTail := nil; - FHead := nil; - FCount := 0; - inherited Destroy; -end; - -function TRtfItemList.Add(AItem: TRtfItem): TRtfItem; -{-Add element to end of list} -begin - Result := AItem; - {Exit for bad input} - if AItem = nil - then Exit; - AItem.FPrev := FTail; - AItem.FNext := nil; - if FHead = nil then begin - {Special case for first node} - FHead := AItem; - FTail := AItem; - end else begin - {Add at end of existing list} - FTail.FNext := AItem; - FTail := AItem; - end; - Inc(FCount); -end; - -procedure TRtfItemList.Insert(AItem: TRtfItem); -{-Insert element at start of list} -begin - {Exit for bad input} - if AItem = nil - then Exit; - AItem.FPrev := nil; - AItem.FNext := FHead; - if FHead = nil - then FTail := AItem {Special case for first node} - else FHead.FPrev := AItem; {Add at start of existing list} - FHead := AItem; - Inc(FCount); -end; - -procedure TRtfItemList.PlaceAfter(AItem: TRtfItem; AAfter: TRtfItem); -{-Place element P into list _after_ existing element L} -begin - {Exit for bad input} - if(AItem = nil)or(AItem = AAfter) - then Exit; - if AAfter = nil - then Insert(AItem) - else if AAfter = FTail - then Add(AItem) - else begin - AItem.FPrev := AAfter; - AItem.FNext := AAfter.FNext; - AAfter.FNext.FPrev := AItem; - AAfter.FNext := AItem; - Inc(FCount); - end; -end; - -procedure TRtfItemList.PlaceBefore(AItem, ABefore: TRtfItem); -{-Place element P into list _before_ existing element L} -begin - {Exit for bad input} - if(AItem = nil)or(AItem = ABefore) - then Exit; - if(ABefore = nil)or(ABefore = Head) - then Insert(AItem) {Place the new element at the start of the list} - else begin - {Patch in the new element} - AItem.FNext := ABefore; - AItem.FPrev := ABefore.FPrev; - ABefore.FPrev.FNext := AItem; - ABefore.FPrev := AItem; - Inc(FCount); - end; -end; - -procedure TRtfItemList.dlRemove(AItem: TRtfItem; DisposeIt: boolean); -{-Delete existing node from list, optionally disposing of it} -var This: TRtfItem; -begin - {Exit for bad input} - if(AItem = nil)or(FCount = 0) - then Exit; - - This := AItem; - with This do begin - {Fix pointers of surrounding nodes} - if FNext <> nil - then FNext.FPrev := FPrev; - if FPrev <> nil - then FPrev.FNext := FNext; - end; - - {Fix head and tail of list} - if FTail = This - then FTail := FTail.FPrev; - if FHead = This - then FHead := FHead.FNext; - - Dec(FCount); - if DisposeIt - then This.Free; -end; - -procedure TRtfItemList.Extract(AItem: TRtfItem); -{-Extract existing element from list without disposing of it} -begin - dlRemove(AItem, false); -end; - -procedure TRtfItemList.Delete(AItem: TRtfItem); -{-Delete an existing node, disposing of its contents} -begin - dlRemove(AItem, true); -end; - -procedure TRtfItemList.Clear; -begin - while Assigned(FHead)do begin - dlRemove(FHead, true); - end; -end; - -procedure TRtfItemList.SaveToStream(AStream: TStream; AColors: string); -var AItem: TRtfItem; - ALine: string; -begin - AItem := Head; - while Assigned(AItem)do begin - if AItem.CheckItem(RtfControl, RtfDestination)and(AItem.RtfMinor = RtfColorTbl) - then ALine := Format('\colortbl;%s}',[AColors]) - else ALine := AItem.RtfTextBuf; - if ALine <> '' - then AStream.Write(ALine[1], Length(ALine)); - AItem := AItem.Next; - end; -end; - -{ TRawRtfParser } - -procedure TRawRtfParser.RtfHook; -//Build a tree from the rtf-code tokens -var AItem: TRtfItem; - - - function NewItem(AText: string): TRtfItem; - begin - Result := TRtfItem.Create; - Result.RtfClass := RtfClass; - Result.RtfMajor := RtfMajor; - Result.RtfMinor := RtfMinor; - Result.RtfTextBuf := AText; - end; -begin - case RtfClass of - RtfParseBegin: begin - if Assigned(AParseItem) then begin - //Then close it - AParseItem := nil; - AItem := RawItems.Add(NewItem('')); - AItem.RtfClass := RtfParseEnd; - end else begin - //Otherwise open an item - AParseItem := RawItems.Add(NewItem('')); - AParseItem.RtfClass := RtfParseBegin; - end; - end; - RtfControl: begin - if(RtfMajor = RtfDestination)and(RtfMinor = RtfColorTbl) - then FColorTable := RawItems.Add(NewItem(RtfTextBuf)) - else RawItems.Add(NewItem(RtfTextBuf)); - end; - RtfText: begin - if RawItems.Tail.RtfClass = RtfClass - then RawItems.Tail.RtfTextBuf := RawItems.Tail.RtfTextBuf + RtfTextBuf - else RawItems.Add(NewItem(RtfTextBuf)); - end; - RtfGroup, RtfUnknown: begin - if RawItems.Tail.RtfClass in[RtfGroup, RtfUnknown] - then RawItems.Tail.RtfTextBuf := RawItems.Tail.RtfTextBuf + RtfTextBuf - else RawItems.Add(NewItem(RtfTextBuf)); - RawItems.Tail.RtfClass := RtfUnknown; //Dont use these for compares - end; - end; -end; - -function TRawRtfParser.GetRtfChar: char; -begin - if APtr >= AEnd - then Result := #0 - else begin - Result := APtr^; - Inc(APtr); - end; -end; - -procedure TRawRtfParser.GetRtfToken; -var c: char; - i, ALevel: integer; -begin - FRtfTextBuf := ''; //not really needed - - //Get first character, which may be a pushback from previous token - if APushedChar <> #0 then begin - c := APushedChar; - APushedChar := #0; - end - else c := GetRtfChar; - - - case c of - #0: begin - FRtfClass := RtfEof; - FRtfTextBuf := ''; - end; - #8: begin //effectively a \tab control symbol - FRtfClass := RtfControl; - FRtfMajor := RtfSpecialChar; - FRtfMinor := RtfTab; - FRtfTextBuf := c; - c := #0; - end; - '{': begin - FRtfClass := RtfGroup; - FRtfMajor := RtfBeginGroup; - FRtfTextBuf := c; - c := #0; - end; - '}': begin - FRtfClass := RtfGroup; - FRtfMajor := RtfEndGroup; - FRtfTextBuf := c; - c := #0; - end; - '\': begin //We have the backslash, advance to next character - FRtfTextBuf := c; - c := GetRtfChar; - case c of - chr(39): begin //Hex encoded text char, e.g., \'d5, \'d3 - FRtfClass := RtfUnknown; - FRtfTextBuf := FRtfTextBuf + c; - c := GetRtfChar; - if c <> #0 then begin - FRtfTextBuf := FRtfTextBuf + c; - c := GetRtfChar; - if c <> #0 then begin - FRtfClass := RtfText; - FRtfTextBuf := FRtfTextBuf + c; - //It can still be a special character.. - for i := Low(Rtfkey)to High(Rtfkey)do begin - if FRtfTextBuf = Rtfkey[i].RtfKStr then begin - FRtfClass := RtfControl; - FRtfMajor := Rtfkey[i].RtfKMajor; - FRtfMinor := Rtfkey[i].RtfKMinor; - break; - end; - end; - c := #0; - end; - end; - end; - ':', '{', '}', ';', '\': begin //special escaped text char, e.g., \, \; - FRtfTextBuf := FRtfTextBuf + c; - //"\" Marks the start and end of an expression with the RtfParseBegin - //RtfClass. They will later be removed and replaced by RtfExpression - //Items between the opening and closing \ will be the expression text - if c = '\' - then FRtfClass := RtfParseBegin - else FRtfClass := RtfText; - c := #0; - end; - '|': begin - FRtfTextBuf := FRtfTextBuf + c; - FRtfClass := RtfControl; - FRtfMajor := RtfSpecialChar; - FRtfMinor := RtfFormula; - c := #0; - end; - '~': begin - FRtfTextBuf := FRtfTextBuf + c; - FRtfClass := RtfControl; - FRtfMajor := RtfSpecialChar; - FRtfMinor := RtfNoBrkSpace; - c := #0; - end; - '-': begin - FRtfTextBuf := FRtfTextBuf + c; - FRtfClass := RtfControl; - FRtfMajor := RtfSpecialChar; - FRtfMinor := RtfNoReqHyphen; - c := #0; - end; - '_': begin - FRtfTextBuf := FRtfTextBuf + c; - FRtfClass := RtfControl; - FRtfMajor := RtfSpecialChar; - FRtfMinor := RtfNoBrkHyphen; - c := #0; - end; - '*': begin - FRtfTextBuf := FRtfTextBuf + c; - FRtfClass := RtfControl; - FRtfMajor := RtfSpecialChar; - FRtfMinor := RtfOptDest; - c := #0; - end; - #13, #10: begin - FRtfTextBuf := FRtfTextBuf + c; - FRtfClass := RtfControl; - FRtfMajor := RtfSpecialChar; - FRtfMinor := RtfPar; - c := #0; - end; - else begin //Wasn't anything special, continue with control word - - while(c in['A'..'Z', 'a'..'z'])do begin - FRtfTextBuf := FRtfTextBuf + c; - c := GetRtfChar; - end; - - //Find the control word in the key array - FRtfClass := RtfUnknown; - for i := Low(Rtfkey)to High(Rtfkey)do begin - if FRtfTextBuf = Rtfkey[i].RtfKStr then begin - FRtfClass := RtfControl; - FRtfMajor := Rtfkey[i].RtfKMajor; - FRtfMinor := Rtfkey[i].RtfKMinor; - break; - end; - end; - - //Parse the word parameter negative sign - if c = '-' then begin - FRtfTextBuf := FRtfTextBuf + c; - c := GetRtfChar; - end; - //Parse the word parameter number - while(c in['0'..'9'])do begin - FRtfTextBuf := FRtfTextBuf + c; - c := GetRtfChar; - end; - - //Append control symbol delimiter (i need it for writing) - if c = ' ' then begin - FRtfTextBuf := FRtfTextBuf + c; - c := GetRtfChar; - end; - - //Crap1: Fix for {\field{\*\fldinst SYMBOL 32 \\f "Symbol" \\s 12}{\fldrslt\... - //RTF text gets corrupted by this parser (notice the Double backslash!) - //Crap2:Also INFO since it can contain the first line from rtf as docinfo. - if(FRtfClass = RtfControl)and(FRtfMajor = RtfDestination) then begin - if FRtfMinor in[RtfField, RtfInfo, RtfStyleSheet, RtfFontTbl, RtfColorTbl] then begin - //Just include the whole field Group to the TextBuf (who cares..?) - ALevel := 1; //All these items have a "group open" before them - while c <> #0 do begin - FRtfTextBuf := FRtfTextBuf + c; - case c of - '{': Inc(ALevel); - '}': Dec(ALevel); - end; - c := GetRtfChar; - if ALevel = 0 - then break; - end; - FRtfClass := RtfControl; - end; - end; - end; - end; - end; - else - begin - //literal text char. This will give one character per call (which is slow) - FRtfTextBuf := c; - FRtfClass := RtfText; - - c := GetRtfChar; - while not(c in[#0, #8, '\', '{', '}']) do - begin - FRtfTextBuf := FRtfTextBuf + c; - c := GetRtfChar; - end; - end; - end; - - //Push character back if we read one to much - if c <> #0 then - APushedChar := c; -end; - -procedure TRawRtfParser.Execute(ARawItems: TRtfItemList; ARtfPtr: pchar; ARtfSize: integer); -var AItem: TRtfItem; -begin - APtr := ARtfPtr; - APushedChar := #0; - RawItems := ARawItems; - FRtfClass := RtfNothing; - AEnd := APtr + ARtfSize; - - //Dummy item so tail of list is always assigned - AItem := TRtfItem.Create; - AItem.RtfClass := RtfText; - ARawItems.Add(AItem); - - while true do - begin - GetRtfToken; - if RtfClass = RtfEOF then - break; - RtfHook; - end; -end; - -{ TRtfVariableList } - -function TRtfVariableList.Add(AName: string; AValue: variant; AToken: TRtfToken): TRtfVariable; -begin - Result := Find(AName); - if Assigned(Result) then - raise TRtfException.CreateFmt('Variable %s already exists',[AName]); - Result := TRtfVariable.Create; - inherited Add(Result); - Result.Name := AName; - Result.Value := AValue; - Result.Token := AToken; -end; - -destructor TRtfVariableList.Destroy; -begin - inherited; -end; - -function TRtfVariableList.Find(AName: string): TRtfVariable; -var i: integer; -begin - for i := 0 to Count - 1 do begin - Result := Items[i]; - if SameText(Result.Name, AName) - then exit; - end; - Result := nil; -end; - -function TRtfVariableList.GetItem(Index: integer): TRtfVariable; -begin - Result := TRtfVariable(inherited Items[Index]); -end; - -{ TRtfFunctionList } - -function TRtfFunctionList.GetItem(Index: integer): TRtfFunction; -begin - Result := TRtfFunction(inherited Items[Index]); -end; - -function TRtfFunctionList.Add(ATokenType: TRtfToken; AName: string; AMin, AMax: smallint; AOnexecute: TRtfFunctionExecute): TRtfFunction; -//Add a new function or even an additional token to the function list -begin - Result := Find(AName); - if Assigned(Result) - then raise TRtfException.CreateFmt('Function already exists',[AName]); - - Result := TRtfFunction.Create; - Result.Name := AName; - Result.Min := AMin; - Result.Max := AMax; - Result.Token := ATokenType; - Result.Onexecute := AOnexecute; - inherited Add(Result); -end; - -function TRtfFunctionList.Find(AName: string): TRtfFunction; -var i: integer; -begin - for i := 0 to Count - 1 do begin - Result := Items[i]; - if SameText(Result.Name, AName) - then exit; - end; - Result := nil; -end; - -{ TRtfDataset } - -procedure TRtfDataset.Notify(Ptr: pointer; Action: TListNotification); -begin - inherited; - case Action of - lnAdded: TRtfDataset(Ptr).FParent := Self; - lnExtracted: TRtfDataset(Ptr).FParent := nil; - end; -end; - -function TRtfDataset.Bof: boolean; -begin - if Dataset is TDataset then begin - with Dataset as TDataset do begin - Result := Bof; - end - end - else if Dataset is TtiObjectList then - Result := TableIndex = 0 - else if Dataset is TtiObject then - Result := false - else - raise TRtfException.Create(rsNotImplemented); -end; - -function TRtfDataset.Eof: boolean; -begin - if Dataset is TDataset then begin - with Dataset as TDataset do begin - Result := Eof; - end - end - else if Dataset is TtiObjectList then - Result :=(TableIndex >= RecordCount)or(TableIndex < 0) - else if Dataset is TtiObject then - Result := false - else - Result := false; -end; - -function TRtfDataset.Find(AName: string): TRtfDataset; -var i: integer; -begin - for i := 0 to Count - 1 do begin - Result := Items[i]; - if SameText(Result.Name, AName) - then exit; - end; - Result := nil; -end; - -function TRtfDataset.Add(ADataset: TObject; AName: string; AFreeDataset: boolean = false): TRtfDataset; -begin - Result := Find(AName); - if Assigned(Result) then - raise TRtfException.CreateFmt('Dataset already exists',[AName]); - - Result := TRtfDataset.Create; - Result.Dataset := ADataset; - Result.Name := AName; - Result.FFreeDataset := AFreeDataset; - inherited Add(Result); -end; - -function TRtfDataset.ResolveNestedFields(ATable: TRtfDataset; AName: string; var AFieldName: string): TRtfDataset; -//Advance to field level (skipping nested dataset objects) -var ATableName: string; - APropInfo: PPropInfo; - ASubTable: TRtfDataset; - AIndex, i: integer; - AObject: TObject; -begin - AIndex := 1; - Result := ATable; - AFieldName := AName; - while AIndex < Length(AName)do begin - - //Check object dataset and eof state - AObject := nil; - if Result.Dataset is TDataset - then exit; //A TDataset is never nested - if Result.Dataset is TtiObjectList then begin - //Get the right record from the array - if Result.TableIndex <(Result.Dataset as TtiObjectList).Count - then AObject :=(Result.Dataset as TtiObjectList)[Result.TableIndex] - else exit; //Trying beyond eof (or empty table) big problem; nah? - end else if Result.Dataset is TtiObject - then AObject := Result.Dataset - else raise TRtfException.Create('Unknown object'); - - //If the next field is a class then advance - ASubTable := nil; - ATableName := ExtractFieldName(AName, AIndex); - APropInfo := GetPropInfo(AObject, ATableName); - if not Assigned(APropInfo)or(APropInfo^.PropType^.Kind <> tkClass) - then exit; //As long as it's an object continue parsing.. - - //Advance fieldname and find nested table - AFieldName := Copy(AName, AIndex, Maxint); - for i := 0 to Result.Count - 1 do begin - if SameText(Result[i].Name, ATableName) then begin - ASubTable := Result[i]; - break; - end; - end; - - //Add the nested table (for administration of the TableIndex) - if not Assigned(ASubTable) then begin - APropInfo := GetPropInfo(AObject, ATableName); - if not Assigned(APropInfo) - then raise TRtfException.CreateFmt('property %s not found',[ATableName]); - if APropInfo^.PropType^.Kind = tkClass - then AObject := GetObjectProp(AObject, APropInfo) - else exit; //Just a plain property field (returned via AFieldName) - ASubTable := Result.Add(AObject, ATableName); - end; - - //Advance to a deeper table level - Result := ASubTable; - end; -end; - -function TRtfDataset.Find(AName: string; out AFieldName: string): TRtfDataset; -//Find the requested dataset -var - ATableName: string; - AIndex, i: integer; -begin - //MainTable must be in the list of tables - //Otherwise no point of reference. - AIndex := 1; - Result := nil; - ATableName := ExtractFieldName(AName, AIndex); - AFieldName := Copy(AName, AIndex, Maxint); - for i := 0 to Count - 1 do begin - if SameText(Items[i].Name, ATableName) then begin - Result := Items[i]; - break; - end; - end; - if not Assigned(Result)or not Assigned(Result.Dataset) - then raise TRtfException.CreateFmt('Unable to resolve %s',[ATableName]); - Result := ResolveNestedFields(Result, AFieldName, AFieldName); -end; - -procedure TRtfDataset.Open; -begin - Clear; //Clear nested tables - if Dataset is TDataset then begin - with Dataset as TDataset do begin - if not Active - then Open; - end - end; - First; -end; - -procedure TRtfDataset.First; -begin - Clear; //Clear nested tables - if Dataset is TDataset then - begin - with Dataset as TDataset do - begin - First; - end - end - else if Dataset is TtiObjectList then - begin - TableIndex := 0; - end; -end; - -function TRtfDataset.GetItem(Index: integer): TRtfDataset; -begin - Result := TRtfDataset(inherited Items[Index]); -end; - -function TRtfDataset.IsEmpty: boolean; -begin - if Dataset is TDataset then - begin - with Dataset as TDataset do - begin - Result := IsEmpty; - end - end - else if Dataset is TtiObjectList then - Result := RecordCount = 0 - else if Dataset is TtiObject then - Result := false - else - raise TRtfException.Create(rsNotImplemented); -end; - -procedure TRtfDataset.Last; -begin - Clear; //Clear nested tables - if Dataset is TDataset then begin - with Dataset as TDataset do begin - Last; - end - end else if Dataset is TtiObjectList then begin - TableIndex := RecordCount - 1; - end; -end; - -procedure TRtfDataset.Next; -begin - Clear; //Clear nested tables - if Dataset is TDataset then begin - with Dataset as TDataset do begin - Next; - end - end else if Dataset is TtiObjectList then begin - if not Eof then begin - TableIndex := TableIndex + 1; - end; - end; -end; - -procedure TRtfDataset.Prior; -begin - Clear; //Clear nested tables - if Dataset is TDataset then begin - with Dataset as TDataset do begin - Prior; - end - end else if Dataset is TtiObjectList then begin - if not Bof then begin - TableIndex := TableIndex - 1; - end; - end; -end; - -function TRtfDataset.RecordCount: integer; -//This can give problems with Sql.. -begin - if Dataset is TDataset - then Result :=(Dataset as TDataset).RecordCount - else if Dataset is TtiObjectList - then Result :=(Dataset as TtiObjectList).Count - else Result := 1; //Single OpfRecord -end; - -destructor TRtfDataset.Destroy; -begin - if FreeDataset - then FreeAndNil(FDataset); - inherited; -end; - - -{ TRtfArgument } - -constructor TRtfArgument.Create(AParser: TtiRtfParser); -begin - inherited Create(true); - FParser := AParser; -end; - -function TRtfArgument.Add(AValue: variant; ATokenType: TRtfToken): TRtfArgument; -begin - Result := TRtfArgument.Create(Parser); - inherited Add(Result); - Result.Value := AValue; - Result.Token := ATokenType; -end; - -function TRtfArgument.Add(AArgument: TRtfArgument): TRtfArgument; -begin - inherited Add(AArgument); - Result := AArgument; -end; - -function TRtfArgument.GetItem(Index: integer): TRtfArgument; -begin - Result := TRtfArgument(inherited Items[Index]); -end; - -procedure TRtfArgument.Notify(Ptr: pointer; Action: TListNotification); -//Nice way of setting the parent reference -begin - inherited; - case Action of - lnAdded: TRtfArgument(Ptr).FParent := Self; - lnExtracted: TRtfArgument(Ptr).FParent := nil; - end; -end; - -function TRtfArgument.Check(AParam: integer; ATokens: TRtfTokenSet): boolean; -begin - if AParam >= Count then begin - Result := false; - exit; - end; - if not(Items[AParam].Token in ATokens) then begin - Result := false; - exit; - end; - Result := true; -end; - -function TRtfArgument.Check(ATokens: array of TRtfTokenSet): boolean; -var i: integer; -begin - for i := Low(ATokens)to High(ATokens)do begin - Result := Check(i, ATokens[i]); - if not Result - then exit; - end; - Result := true; -end; - -procedure TRtfArgument.ParseExpression(AExpression: string); -//Add token to the argument list. Parameters surrounded by parentheses will -//be added to the nested arguments. This will make a nice argument tree. -//Constant .9 wont be parse, but that's ok -var - FSourcePtr, p, TokenStart: PChar; - ALastArgument, ALast: TRtfArgument; - AInts: array[0..6]of integer; - ASeps: array[0..6]of char; - AFunction: TRtfFunction; - AFloatResult: boolean; - AIntIndex: integer; - AValue: variant; - AToken: string; -begin - ALast := nil; - Value := varEmpty; - Token := etNothing; - ALastArgument := Self; - FSourcePtr := PChar(AExpression); - while FSourcePtr^ <> #0 do begin - - p := FSourcePtr; - while(P^ <> #0)and(P^ <= ' ')do begin - ALast := nil; - Inc(p); - end; - - TokenStart := p; - case P^ of - 'A'..'Z', 'a'..'z', '_', '@': begin // The '@' infront of a reference variable - Inc(p); - ALast := nil; - while P^ in['A'..'Z', 'a'..'z', '0'..'9', '_', '.', '@']do Inc(p); - if TokenStart^ = '@' then begin - Inc(TokenStart); //Remove the '@' prefix - SetString(AToken, TokenStart, p - TokenStart); - ALast := ALastArgument.Add(AToken, etVariable) - end else begin - SetString(AToken, TokenStart, p - TokenStart); - AFunction := Parser.Functions.Find(AToken); - if Assigned(AFunction) - then ALastArgument.Add(AFunction.Name, AFunction.Token) - else ALast := ALastArgument.Add(AToken, etFieldName); //Field or tablename, what else can it be? - end; - end; - Chr(39): begin - Inc(p); - TokenStart := p; - while true do begin - if P^ = Chr(39) then begin - SetString(AToken, TokenStart, p - TokenStart); - //Concatenate etFieldName."Field with spaces" - if Assigned(ALast)and(ALast.Token in[etVariable, etFieldName]) - then ALast.Value := ALast.Value + AToken - else ALastArgument.Add(AToken, etLitString); - Inc(p); - Break; - end; - if P^ = #0 - then raise TRtfException.Create(rsUnterminatedStringConstant); - Inc(p); - end; - end; - '"': begin - Inc(p); - TokenStart := p; - while true do begin - if P^ = '"' then begin - SetString(AToken, TokenStart, p - TokenStart); - //Concatenate etFieldName."Field with spaces" - if Assigned(ALast)and(ALast.Token in[etVariable, etFieldName]) - then ALast.Value := ALast.Value + AToken - else ALastArgument.Add(AToken, etLitString); - Inc(p); - Break; - end; - if P^ = #0 - then raise TRtfException.Create(rsUnterminatedStringConstant); - Inc(p); - end; - end; - '-': begin - Inc(p); - ALast := nil; - ALastArgument.Add(AToken, etSUB); - end; - '0'..'9': begin //Ik ga ervan uit dat alles in het amerikaans genoteerd word - Inc(p); - ALast := nil; - AFloatResult := false; - while P^ in['0'..'9']do Inc(p); - if P^ = '.' then begin //Floating point - Inc(p); - AFloatResult := true; - while P^ in['0'..'9']do Inc(p); - end; - if P^ in['e', 'E'] then begin //1.700000E+308 - AFloatResult := true; - Inc(p); - if P^ in['+', '-'] - then Inc(p); - while P^ in['0'..'9']do Inc(p); - end; - SetString(AToken, TokenStart, p - TokenStart); - if AFloatResult - then AValue := StrToFloat(AToken) - else AValue := StrToInt(AToken); - if AFloatResult - then ALastArgument.Add(AValue, etLitFloat) - else ALastArgument.Add(AValue, etLitInt); - end; - '(': begin - Inc(p); - ALast := nil; - //Add them to the last function if possible.. - if(ALastArgument.Count > 0)and(ALastArgument[ALastArgument.Count - 1].Token in[etFunction, etProcedure]) - then ALastArgument := ALastArgument[ALastArgument.Count - 1] - else ALastArgument := ALastArgument.Add('()', etParenthesis); - end; - ')': begin - Inc(p); - ALast := nil; - ALastArgument := ALastArgument.Parent; - if not Assigned(ALastArgument) - then raise TRtfException.Create(rsToManyClosingParenthesis); - end; - '<': begin - Inc(p); - ALast := nil; - case P^ of - '=': begin - Inc(p); - ALastArgument.Add('<=', etLE); - end; - '>': begin - Inc(p); - ALastArgument.Add('<>', etNE); - end; - else ALastArgument.Add('<', etLT); - end; - end; - '=': begin - Inc(p); - ALast := nil; - ALastArgument.Add('=', etEq); - end; - ':': begin - Inc(p); - ALast := nil; - if P^ = '=' then begin - Inc(p); - ALastArgument.Add(':=', etAssign); - end - else raise TRtfException.CreateFmt(rsInvalidExpressionCharacter,[P^]); - end; - '&': begin - Inc(p); - ALast := nil; - if P^ = '&' then begin - Inc(p); - ALastArgument.Add('and', etAnd); - end - else raise TRtfException.CreateFmt(rsInvalidExpressionCharacter,[P^]); - end; - '|': begin - Inc(p); - ALast := nil; - if P^ = '|' then begin - Inc(p); - ALastArgument.Add('or', etOr); - end - else raise TRtfException.CreateFmt(rsInvalidExpressionCharacter,[P^]); - end; - '!': begin - Inc(p); - ALast := nil; - if P^ = '=' then begin - Inc(p); - ALastArgument.Add('!=', etNe); - end - else ALastArgument.Add(AToken, etNot); - end; - '>': begin - Inc(p); - ALast := nil; - if P^ = '=' then begin - Inc(p); - ALastArgument.Add('>=', etGE); - end - else ALastArgument.Add('>', etGT); - end; - '+': begin - Inc(p); - ALast := nil; - ALastArgument.Add('+', etADD); - end; - '*': begin - Inc(p); - ALast := nil; - ALastArgument.Add('*', etMUL); - end; - '/': begin - Inc(p); - ALast := nil; - ALastArgument.Add('/', etDIV); - end; - ',': begin - Inc(p); - ALast := nil; - ALastArgument.Add(',', etComma); - end; - '\': begin //a date/time constant. Since these are - //in a fixed format we need to parse them ourselves. - Inc(p); - ALast := nil; - if P^ = '{' then begin - Inc(p); - FillChar(AInts[0], SizeOf(AInts), 0); - FillChar(ASeps[0], SizeOf(ASeps), 0); - - AIntIndex := 0; - while(p^ <> #0)and(p^ in['0'..'9', ' ', ':', '-'])do begin - //read integer parts - TokenStart := p; - while P^ in['0'..'9']do Inc(p); - SetString(AToken, TokenStart, p - TokenStart); - if AToken = '' - then raise TRtfException.Create(rsInvalidDateConstant); - ASeps[AIntIndex] := p^; - AInts[AIntIndex] := StrToInt(AToken); - Inc(AIntIndex); - if AIntIndex > 6 - then raise TRtfException.Create(rsInvalidDateConstant); - if(p^ in[' ', '-', ':']) - then Inc(p); - end; - - //There shoud be at least two values entered - if AIntIndex < 2 - then raise TRtfException.Create(rsInvalidDateConstant); - - if not(p^ in['\']) - then raise TRtfException.Create(rsInvalidDateConstant); - Inc(p); - if P^ <> '}' - then raise TRtfException.Create(rsInvalidDateConstant); - Inc(p); - - if ASeps[0] = '-' then begin - //Its a date/time constant.. There should be at least 3 ints - if AIntIndex < 3 - then raise TRtfException.Create(rsInvalidDateConstant); - if ASeps[1] <> '-' - then raise TRtfException.Create(rsInvalidDateSeparator); - if not(ASeps[2]in[' ', '\']) - then raise TRtfException.Create(rsInvalidDateSeparator); - AValue := EncodeDate(AInts[0], AInts[1], AInts[2]); - - //Followed by a optional time constant? There should be at least 2 ints in it - if AIntIndex > 3 then begin - if AIntIndex < 5 - then raise TRtfException.Create(rsInvalidTimeConstant); - if not(ASeps[2]in[' ']) - then raise TRtfException.Create(rsInvalidTimeSeparator); - if not(ASeps[3]in[':', ' ', '\']) - then raise TRtfException.Create(rsInvalidTimeSeparator); - AValue := AValue + EncodeTime(AInts[3], AInts[4], AInts[5], 0); - end; - end else if ASeps[0] = ':' then begin - //Its a time constant.. There should be at least 2 ints - if AIntIndex < 1 - then raise TRtfException.Create(rsInvalidTimeConstant); - if not(ASeps[1]in[':', ' ', '\']) - then raise TRtfException.Create(rsInvalidTimeSeparator); - AValue := EncodeTime(AInts[0], AInts[1], AInts[2], 0); - end; - ALastArgument.Add(AValue, etLitDate) - end - else raise TRtfException.CreateFmt(rsInvalidExpressionCharacter,[P^]); - end; - else begin - if p^ <> #0 - then raise TRtfException.CreateFmt(rsInvalidExpressionCharacter,[P^]); - end; - end; - FSourcePtr := p; - end; - if ALastArgument <> Self - then raise TRtfException.Create(rsExpectedClosingParenthesis); -end; - -procedure TRtfArgument.EvaluateUnaryBinary(APrevItem, AArgument, ANextItem: TRtfArgument); -begin - case APrevItem.Token of - etLitString: begin - case ANextItem.Token of - etLitString: begin - if AArgument.Token <> etAdd - then raise TRtfException.Create('Unable to combine strings with other types'); - APrevItem.Value := APrevItem.Value + ANextItem.Value; - Remove(AArgument); - Remove(ANextItem); - end; - else raise TRtfException.Create('Unable to combine strings with other types'); - end; - end; - etLitInt: begin - case ANextItem.Token of - etLitInt, etLitDate, etLitFloat: begin - case AArgument.Token of - etAdd: APrevItem.Value := APrevItem.Value + ANextItem.Value; - etSub: APrevItem.Value := APrevItem.Value - ANextItem.Value; - etMul: APrevItem.Value := APrevItem.Value * ANextItem.Value; - etDiv: APrevItem.Value := APrevItem.Value / ANextItem.Value; - end; - if ANextItem.Token = etLitDate - then APrevItem.Token := etLitDate - else if ANextItem.Token = etLitFloat - then APrevItem.Token := etLitFloat - else if AArgument.Token = etDiv - then APrevItem.Token := etLitFloat - else APrevItem.Token := etLitInt; - Remove(AArgument); - Remove(ANextItem); - end; - else raise TRtfException.Create('Invalid formula'); - end; - end; - etLitFloat: begin - case ANextItem.Token of - etLitInt, etLitFloat, etLitDate: begin - case AArgument.Token of - etAdd: APrevItem.Value := APrevItem.Value + ANextItem.Value; - etSub: APrevItem.Value := APrevItem.Value - ANextItem.Value; - etMul: APrevItem.Value := APrevItem.Value * ANextItem.Value; - etDiv: APrevItem.Value := APrevItem.Value / ANextItem.Value; - end; - if ANextItem.Token = etLitDate - then APrevItem.Token := etLitDate - else APrevItem.Token := etLitFloat; - Remove(AArgument); - Remove(ANextItem); - end; - else raise TRtfException.Create('Invalid formula'); - end; - end; - etLitDate: begin - case ANextItem.Token of - etLitInt, etLitFloat, etLitDate: begin - case AArgument.Token of - etAdd: APrevItem.Value := APrevItem.Value + ANextItem.Value; - etSub: APrevItem.Value := APrevItem.Value - ANextItem.Value; - etMul: APrevItem.Value := APrevItem.Value * ANextItem.Value; - etDiv: APrevItem.Value := APrevItem.Value / ANextItem.Value; - end; - APrevItem.Token := etLitDate; - Remove(AArgument); - Remove(ANextItem); - end; - else raise TRtfException.Create('Invalid formula'); - end; - end; - etComma: begin - //Fix for constant int's and float's - case ANextItem.Token of - etLitInt, etLitFloat, etLitDate: begin - case AArgument.Token of - etAdd:; //nothing just a (..., +Value) - etSub: ANextItem.Value := ANextItem.Value * - 1; - else raise TRtfException.Create('Invalid formula'); - end; - Remove(AArgument); - end; - else raise TRtfException.Create('Invalid formula'); - end; - end; - etAssign: begin - //Fix for constant int's and float's - case ANextItem.Token of - etLitInt, etLitFloat, etLitDate: begin - case AArgument.Token of - etAdd:; //nothing just a @Variable := +Value - etSub: ANextItem.Value := ANextItem.Value * - 1; - else raise TRtfException.Create('Invalid formula'); - end; - Remove(AArgument); - end; - else raise TRtfException.Create('Invalid formula'); - end; - end; - else raise TRtfException.Create('Invalid formula'); //Otherwise it wont advance - end; - if Assigned(Parser.OnEvalutate) - then Parser.OnEvalutate(Self); -end; - -procedure TRtfArgument.EvaluateComparison(APrevItem, AArgument, ANextItem: TRtfArgument); -begin - if(APrevItem.Token = etLitString)and(ANextItem.Token <> etLitString) - then raise TRtfException.Create('Invalid comparison'); - if(ANextItem.Token = etLitString)and(APrevItem.Token <> etLitString) - then raise TRtfException.Create('Invalid comparison'); - - case AArgument.Token of - etEQ: APrevItem.Value := APrevItem.Value = ANextItem.Value; - etNE: APrevItem.Value := APrevItem.Value <> ANextItem.Value; - etGE: APrevItem.Value := APrevItem.Value >= ANextItem.Value; - etLE: APrevItem.Value := APrevItem.Value <= ANextItem.Value; - etGT: APrevItem.Value := APrevItem.Value > ANextItem.Value; - etLT: APrevItem.Value := APrevItem.Value < ANextItem.Value; - etOr: APrevItem.Value := APrevItem.Value or ANextItem.Value; - etAnd: APrevItem.Value := APrevItem.Value and ANextItem.Value; - else raise TRtfException.Create('Invalid comparison'); - end; - if APrevItem.Value - then APrevItem.Token := etLitTrue - else APrevItem.Token := etLitFalse; - - Remove(AArgument); - Remove(ANextItem); - if Assigned(Parser.OnEvalutate) - then Parser.OnEvalutate(Self); -end; - -procedure TRtfArgument.EvaluateAssign(APrevItem, AArgument, ANextItem: TRtfArgument); -var AVariable: TRtfVariable; -begin - if APrevItem.Token <> etVariable - then raise TRtfException.Create('Invalid assignment'); - - AVariable := Parser.Variables.Find(APrevItem.Value); - if Assigned(AVariable) then begin - AVariable.Value := ANextItem.Value; - AVariable.Token := ANextItem.Token; - end - else AVariable := Parser.Variables.Add(APrevItem.Value, ANextItem.Value, ANextItem.Token); - - APrevItem.Value := AVariable.Value; - APrevItem.Token := AVariable.Token; - - Remove(AArgument); - Remove(ANextItem); - if Assigned(Parser.OnEvalutate) - then Parser.OnEvalutate(Self); -end; - -procedure TRtfArgument.GetPictureData(ABuffer: pointer; ALength: cardinal; var Result: string); -var ASrc: Pbyte; - ADst: pchar; - AIndex: cardinal; - i: integer; - s: string; -begin - if poBinary in Parser.PictureOptions then begin - //Save graphic binary - Result := Format('%s\bin%d ',[Result, ALength]); - AIndex := Length(Result); - SetLength(Result, AIndex + ALength); - ADst := @Result[AIndex + 1]; - System.Move(ABuffer^, ADst^, ALength); - end else begin - //Save graphics as hex - ASrc := ABuffer; - Result := Result + ' '; - AIndex := Length(Result); - SetLength(Result, AIndex + 2 *(ALength +(ALength div 128))); - ADst := @Result[AIndex + 1]; - for i := 0 to ALength - 1 do begin - s := IntToHex(ASrc^, 2); - ADst^ := s[1]; - Inc(ADst); - ADst^ := s[2]; - Inc(ADst); - if(i > 0)and(i and 127 = 0) then begin - ADst^ := #13; - Inc(ADst); - ADst^ := #10; - Inc(ADst); - end; - Inc(ASrc); - end; - end; - Result := Result + #13#10 + '}'; -end; - -function TRtfArgument.GetPicture(APicture: TPicture): string; -//Convert a picture to a string suitable for in the Rtf -(* -var - xw, yh: word; - Rect: TRect; - ARefDC: HDC; - ABuffer: pointer; - ALength: cardinal; - AMetafile: TMetafile; - ABorderWidth: integer; - APictureAttr: TRtfPictureAttr; - ppi, AColorIndex, xtw, ytw: integer; -*) -begin - Result := ''; - (* - ppi := Screen.PixelsPerInch; - - AMetafile := TMetaFile.Create; - try - AMetafile.Enhanced := true; - - if poMetafile in Parser.PictureOptions then begin - AMetafile.Width := Round(APicture.Graphic.Width * ppi / 96); - AMetafile.Height := Round(APicture.Graphic.Height * ppi / 96); - end else begin - if(APicture.graphic is TMetafile)and not APicture.Metafile.Enhanced then begin - AMetafile.Height := APicture.graphic.Height; - AMetafile.Width := APicture.graphic.Width; - end else begin - AMetafile.Height := Round(APicture.graphic.Height * ppi / 96); - AMetafile.Width := Round(APicture.graphic.Width * ppi / 96); - end; - end; - - Rect.Top := 0; - Rect.Left := 0; - Rect.Right := AMetafile.Width - 1; - Rect.Bottom := AMetafile.Height - 1; - - with TMetaFileCanvas.Create(AMetafile, 0)do try - if ppi = 96 - then Draw(0, 0, APicture.Graphic) - else StretchDraw(Rect, APicture.Graphic); - finally - Free; - end; - - if(APicture.Graphic is TMetafile)and not APicture.Metafile.Enhanced then begin - xw := Round(APicture.Width * 96 / ppi); - yh := Round(APicture.Height * 96 / ppi); - end else begin - xw := APicture.Width; - yh := APicture.Height; - end; - - APictureAttr := TRtfPictureAttr.Create(xw, yh); - try - AMetafile.MMWidth := Round(APictureAttr.Widthmm * 100); - AMetafile.MMHeight := Round(APictureAttr.Heigthmm * 100); - - if poMetafile in Parser.PictureOptions then begin - xtw := Round(APictureAttr.Width * 26.4596930676); - ytw := Round(APictureAttr.Heigth * 26.4596930676); - end else begin - xtw := Round(5669 * APictureAttr.Widthmm / 100); - ytw := Round(5669 * APictureAttr.Heigthmm / 100); - end; - - if Assigned(Parser.OnPictureAttr) - then Parser.OnPictureAttr(APictureAttr); - - Result := Format('{\pict\picscalex%d\picscaley%d\piccropl0' + - '\piccropr0\piccropt0\piccropb0\picw%d\pich%d', - [APictureAttr.ScaleX, APictureAttr.ScaleY, xtw, ytw]); - if poMetafile in Parser.PictureOptions - then Result := Result + '\wmetafile8' - else Result := Result + '\emfblip'; - - if(APictureAttr.BorderType <> brNone)and(APictureAttr.BorderWidth > 0) then begin - case APictureAttr.BorderType of - brSingle: Result := Result + '\brdrs'; - brDouble: Result := Result + '\brdrdb'; - brThick: Result := Result + '\brdrth'; - brShadow: Result := Result + '\brdrsh'; - brDot: Result := Result + '\brdrdot'; - brHair: Result := Result + '\brdrhair'; - end; - - ABorderWidth := APictureAttr.BorderWidth; - if ABorderWidth > 75 - then ABorderWidth := 75; - - AColorIndex := Parser.ColorList.UseColor(APictureAttr.BorderColor); - Result := Format('%s\brdrw%d\brdrcf%d',[Result, ABorderWidth, AColorIndex]); - end; - finally - APictureAttr.Free; - end; - - - if poMetafile in Parser.PictureOptions then begin - ARefDC := GetDC(0); - try - ALength := GetWinMetaFileBits(AMetafile.Handle, 0, nil, MM_ANISOTROPIC, ARefDC); - GetMem(ABuffer, ALength); - try - GetWinMetaFileBits(AMetafile.Handle, ALength, ABuffer, MM_ANISOTROPIC, ARefDC); - GetPictureData(ABuffer, ALength, Result); - finally - FreeMem(ABuffer); - end; - finally - ReleaseDC(0, ARefDc); - end; - end else begin - ALength := GetEnhMetaFileBits(AMetafile.Handle, 0, nil); - GetMem(ABuffer, ALength); - try - GetEnhMetaFileBits(AMetafile.Handle, ALength, ABuffer); - GetPictureData(ABuffer, ALength, Result); - finally - FreeMem(ABuffer); - end; - end; - finally - AMetafile.Free; - end; - *) -end; - -procedure TRtfArgument.GetGraphicsValue(ADataset: TRtfDataset; AFieldName: string); -(* -var - APicture: TPicture; - ABlob: TBlobField; - APhoto: TJPEGImage; - AStream: TStringStream; - s: string[20]; - AField: TField; -*) -begin -(* - Value := varEmpty; - Token := etNothing; - if ADataset.Dataset is TDataset then begin - AField :=(ADataset.Dataset as TDataset).FieldByName(AFieldName); - - APicture := TPicture.Create; - try - ABlob := AField as TBlobField; - s := Copy(ABlob.Value, 1, 20); - if(Pos('GIF8', s) > 0)or(Pos('JFIF', s) > 0) then begin - APhoto := TJPEGImage.Create; - try - AStream := TStringStream.Create(ABlob.AsString); - APhoto.LoadFromStream(AStream); - APicture.Assign(APhoto); - finally - FreeAndNil(APhoto); - FreeAndNil(AStream); - end; - end - else APicture.Assign(ABlob); - - if Assigned(APicture.Graphic) then begin - Value := GetPicture(APicture); - Token := etLitString; - end; - - finally - APicture.Free; - end; - end - else - raise TRtfException.Create('Graphic fields worden alleen ondersteund via de tdataset!'); -*) -end; - -procedure TRtfArgument.ResolveFieldValue(ADataset: TRtfDataset; AFieldName: string); -//Get field data from a dataset object -var - AObject: TObject; - APropInfo: PPropInfo; - ATypedata: PTypeData; - ATable: TDataset; - AField: TField; -begin - //Can't resolve that - if AFieldName = '' then - raise TRtfException.Create('invalid fieldname'); - - if ADataset.Dataset is TDataset then - begin - ATable := ADataset.Dataset as TDataset; - AField := ATable.FieldByName(AFieldName); - case AField.DataType of - ftMemo, ftFmtMemo, ftFixedChar, ftWideString, ftString: begin - Token := etLitString; - Value := AField.AsString; - end; - ftLargeint, ftAutoInc, ftSmallint, ftInteger, ftWord: begin - Token := etLitInt; - Value := AField.AsInteger; - end; - ftBoolean: begin - Value := AField.AsBoolean; - if Value then - Token := etLitTrue - else - Token := etLitFalse; - end; - ftFloat, ftCurrency, ftBCD: begin - Token := etLitFloat; - Value := AField.AsFloat; - end; - ftDate, ftTime, ftDateTime, ftTimeStamp: begin - Token := etLitDate; - Value := AField.AsDateTime; - end; - ftGraphic: begin - GetGraphicsValue(ADataset, AFieldName); - end; - else - raise TRtfException.CreateFmt('Unable to convert field "%s" value',[AFieldName]); - end; - end - else - begin - AObject := ADataset.Dataset; - if AObject is TtiObjectList then - begin - //Get the right record from the array - if ADataset.TableIndex <(AObject as TtiObjectList).Count then - AObject :=(AObject as TtiObjectList)[ADataset.TableIndex] - else - begin //Trying beyond eof (or empty dataset) big problem; nah? - Token := etNothing; - Value := varEmpty; - exit; - end; - end; - APropInfo := GetPropInfo(AObject, AFieldName); - if not Assigned(APropInfo) then - raise TRtfException.CreateFmt('Field "%s" does not exist',[AFieldName]); - if not Assigned(APropInfo^.GetProc) then - raise TRtfException.CreateFmt('Cannot access field "%s"',[AFieldName]); - {$IFDEF FPC} - ATypeData := GetTypeData(APropInfo^.PropType); - {$ELSE} - ATypeData := GetTypeData(APropInfo^.PropType^); - {$ENDIF} - - case APropInfo^.PropType^.Kind of - tkChar, tkString, tkLString, tkWString{$IFDEF FPC},tkAString{$ENDIF}: begin - Token := etLitString; - Value := GetStrProp(AObject, APropInfo); - end; - tkInt64: begin - Token := etLitInt; - Value := GetInt64Prop(AObject, APropInfo); - end; - tkSet, tkInteger: begin - Token := etLitInt; - Value := GetOrdProp(AObject, APropInfo); - end; - tkEnumeration: begin - {$IFDEF FPC} - if ATypeData^.BaseType = TypeInfo(boolean) then - {$ELSE} - if ATypeData^.BaseType^ = TypeInfo(boolean) then - {$ENDIF} - begin - Value := GetOrdProp(AObject, APropInfo) = 1; - if Value then - Token := etLitTrue - else - Token := etLitFalse; - end - else - begin - Token := etLitInt; - Value := GetOrdProp(AObject, APropInfo); - end; - end; - tkFloat: begin - if SameText(APropInfo^.PropType^.Name, 'TDate') - or SameText(APropInfo^.PropType^.Name, 'TTime') - or SameText(APropInfo^.PropType^.Name, 'TDateTime') then - Token := etLitDate - else - Token := etLitFloat; - Value := GetFloatProp(AObject, APropInfo); - end; - else - raise TRtfException.CreateFmt('Unable to convert field "%s" value',[AFieldName]); - end; { case } - end; { if/else } -end; - -procedure TRtfArgument.ResolveVariable; -var AVariable: TRtfVariable; - AText, AFieldName: string; - ADataset: TRtfDataset; - AIndex: integer; -begin - AText := Value; - AIndex := Pos('.', AText); - if AIndex > 0 then begin - //Its a dataset reference @Table.Fieldname - AFieldName := Copy(AText, AIndex + 1, Maxint); - AText := Copy(AText, 1, AIndex - 1); - - AVariable := Parser.Variables.Find(AText); - if not Assigned(AVariable) - then raise TRtfException.Create('variable does not exist'); - Token := AVariable.Token; - Value := AVariable.Value; - if Token <> etDataset - then raise TRtfException.Create('variable is not a dataset'); - - ADataset := TRtfDataset(ptrint(Value)); - ADataset := ADataset.ResolveNestedFields(ADataset, AFieldName, AFieldName); - if AFieldName = '' then begin - //Its a (nested) dataset - Token := etDataset; - Value := PtrInt(ADataset); - end - else ResolveFieldValue(ADataset, AFieldName); - end else begin - AVariable := Parser.Variables.Find(AText); - if not Assigned(AVariable) - then raise TRtfException.Create('variable does not exist'); - Token := AVariable.Token; - Value := AVariable.Value; - end; -end; - -procedure TRtfArgument.ResolveFieldName; -//Resolve dataset names or fieldnames (seperated with ".") -var ADataset: TRtfDataset; - AFieldName: string; -begin - //Otherwise it should be a table reference or fieldname - ADataset := Parser.Datasets.Find(Value, AFieldName); - if not Assigned(ADataset) //There should be at least a table reference. - then raise TRtfException.CreateFmt('Dataset "%s" not found',[Value]); - if AFieldName <> '' - then ResolveFieldValue(ADataset, AFieldName) - else begin - //Its a dataset or objectlist reference - Token := etDataset; - Value := PtrInt(ADataset); - end; -end; - -procedure TRtfArgument.Walk(ATokenset: TRtfTokenSet; AExecproc: TRtfArgumentEvent); -//Not really neat (what can you expect in 1 day) -var i: integer; - AText: string; - AResolve: boolean; - AParent, APrevItem, AArgument, ANextItem: TRtfArgument; -begin - if Count > 0 then begin - i := 0; - while i < Count do begin - AArgument := Items[i]; - - if AArgument.Token = etVariable then begin - if(i >= Count - 1)or(Items[i + 1].Token <> etAssign) - then AArgument.ResolveVariable; - end else if AArgument.Token = etFieldName then begin - //An exception is the DbPicture(Table.Field). It shoud not evaluate - //since the DbPicture function should be responsible for that. - AResolve := true; - AParent := AArgument.Parent; - if Assigned(AParent) then begin - AText := AParent.Value; - if SameText(AText, 'DbPicture') - then AResolve := false; - end; - if AResolve - then AArgument.ResolveFieldName; - end; - - if AArgument.Token = etNot then begin - if i < Count - 1 - then ANextItem := Items[i + 1] - else raise TRtfException.Create('invalid formula'); - if ANextItem.Token = etLitFalse - then ANextItem.Value := true - else if ANextItem.Token = etLitTrue - then ANextItem.Value := false - else raise TRtfException.Create('invalid formula'); - Remove(AArgument); - end else if AArgument.Token in ATokenSet then begin - if i > 0 - then APrevItem := Items[i - 1] - else raise TRtfException.Create('invalid formula'); - if i < Count - 1 - then ANextItem := Items[i + 1] - else raise TRtfException.Create('invalid formula'); - AExecproc(APrevItem, AArgument, ANextItem); - end - else Inc(i); - end; - - if(Count = 1)and(Token = etParenthesis) then begin - //Advance the answer from between parenthesis to parent. - AArgument := Items[0]; - Value := AArgument.Value; - Token := AArgument.Token; - Remove(AArgument); - if Assigned(Parser.OnEvalutate) - then Parser.OnEvalutate(Self); - end; - end; -end; - -procedure TRtfArgument.EvaluateExpression; -//Not really neat (what can you expect in 1 day) -//Evaluate the entered expression via ParseExpression() -var AFunction: TRtfFunction; - AArgument: TRtfArgument; - i: integer; -begin - if Count > 0 then begin - //First the binary operators - Walk([etMul, etDiv], {$IFDEF FPC}@{$ENDIF}EvaluateUnaryBinary); - //Secondly the unary operators - Walk([etAdd, etSub], {$IFDEF FPC}@{$ENDIF}EvaluateUnaryBinary); - //And finally the simple comparisons - Walk([etEQ, etNE, etGE, etLE, etGT, etLT], {$IFDEF FPC}@{$ENDIF}EvaluateComparison); - //And finally the more "complicated" comparisons - Walk([etAnd, etOr], {$IFDEF FPC}@{$ENDIF}EvaluateComparison); - end; - - - if Token in[etFunction, etProcedure] then begin - AFunction := Parser.Functions.Find(Value); - if not Assigned(AFunction) - then raise TRtfException.Create('Cannot resolve function'); - - if not Assigned(AFunction.OnExecute) - then raise TRtfException.Create('Cannot resolve function'); - - //Remove now redundant comma's - for i := Count - 1 downto 0 do begin - AArgument := Items[i]; - if AArgument.Token = etComma - then Remove(AArgument) - else if VarIsEmpty(AArgument.Value) - then raise TRtfException.Create('Function needs valid parameters'); - end; - - if Count < AFunction.Min - then raise TRtfException.Create('expected more parameters'); - if Count > AFunction.Max - then raise TRtfException.Create('to many parameters'); - - Value := varEmpty; - Token := etNothing; - if Assigned(Parser.OnEvalutate) - then Parser.OnEvalutate(Self); - AFunction.OnExecute(Self); - Clear; //Clear parameters - if Assigned(Parser.OnEvalutate) - then Parser.OnEvalutate(Self); - end; - - //And not to forget any optional assignments - if Count > 0 - then Walk([etAssign], {$IFDEF FPC}@{$ENDIF}EvaluateAssign); -end; - -procedure TRtfArgument.Evaluate; -//Not really neat (what can you expect in 1 day) -//Evaluate the expression (not very efficient, but what the hack) -var i: integer; - AText: string; - AArgument: TRtfArgument; -begin - for i := 0 to Count - 1 do begin - AArgument := Items[i]; - AArgument.Evaluate; - end; - EvaluateExpression; - - if(Parent = nil)and(Count > 1) - then raise TRtfException.Create('invalid formula'); - - if Count = 1 then begin - //Advance the answer from between parenthesis to parent. - AArgument := Items[0]; - Value := AArgument.Value; - Token := AArgument.Token; - Param := AArgument.Param; - Clear; - if Assigned(Parser.OnEvalutate) - then Parser.OnEvalutate(Self); - end; - - if Token = etLitString then begin - //Fix: DbExpres appends a #0 character to memo fields - AText := Value; - if(Length(AText) > 0)and(AText[Length(AText)] = #0) - then Value := Copy(AText, 1, Length(AText) - 1); - end; -end; - - -{ TRtfColor } - -function TRtfColor.GetAsString: string; -begin - Result := Format('\red%d\green%d\blue%d;',[Red, Green, Blue]); -end; - -{ TRtfColorList } - -function TRtfColorList.GetItem(Index: integer): TRtfColor; -begin - Result := TRtfColor(inherited Items[Index]); -end; - -procedure TRtfColorList.Clear; -begin - inherited Clear; - { TODO -oGraeme : Not sure why this was here, so I removed it. 2009-11-10 } -// Add(0, 0, 0); //Dummy color.. -end; - -function TRtfColorList.Add(ARed, AGreen, ABlue: integer): integer; -var AColor: TRtfColor; -begin - AColor := TRtfColor.Create; - AColor.Red := ARed; - AColor.Green := AGreen; - AColor.Blue := ABlue; - Result := inherited Add(AColor); -end; - -function TRtfColorList.Find(ARed, AGreen, ABlue: integer): integer; -var - i: integer; - AColor: TRtfColor; -begin - //0 is a dummy color - for i := 1 to Count - 1 do - begin - AColor := Items[i]; - if(AColor.Red = ARed)and(AColor.Green = AGreen)and(AColor.Blue = ABlue) then - begin - Result := i; - exit; - end; - end; - Result := - 1; -end; - -function TRtfColorList.GetAsString: string; -var - i: integer; - AColor: TRtfColor; -begin - Result := ''; - //0 is a dummy color - for i := 1 to Count - 1 do - begin - AColor := Items[i]; - Result := Result + AColor.AsString; - end; -end; - -function TRtfColorList.UseColor(ARed, AGreen, ABlue: integer): integer; -begin - Result := Find(ARed, AGreen, ABlue); - if Result < 0 - then Result := Add(ARed, AGreen, ABlue); -end; - -function TRtfColorList.UseColor(AColor: TColor): integer; -var ARed, AGreen, ABlue: integer; -begin - ARed := AColor and 255; - AColor := AColor shr 8; - AGreen := AColor and 255; - AColor := AColor shr 8; - ABlue := AColor and 255; - Result := UseColor(ARed, AGreen, ABlue); -end; - - -{ TtiRtfParser } - -constructor TtiRtfParser.Create; -begin - inherited Create; - FBoolTrue := 'Ja'; - FBoolFalse := 'Nee'; - FErrorForeColor := clRed; - FErrorBackColor := clYellow; - FPictureOptions :=[poMetafile, poBinary]; - FHlpItems := TRtfItem.Create; - TmpItems := TObjectlist.Create; - FDatasets := TRtfDataset.Create; - FRtfItems := TRtfItemList.Create; - FRawItems := TRtfItemList.Create; - FColorList := TRtfColorList.Create; - FVariables := TRtfVariableList.Create; - FFunctions := TRtfFunctionList.Create; - AddFunctions; -end; - -destructor TtiRtfParser.Destroy; -begin - FDatasets.Free; - FRtfItems.Free; - TmpItems.Free; - FHlpItems.Free; - FVariables.Free; - FFunctions.Free; - FRawItems.Free; - FColorList.Free; - inherited; -end; - -procedure TtiRtfParser.Clear; -begin - TmpItems.Clear; - RawItems.Clear; - RtfItems.Clear; - HlpItems.Clear; - ColorList.Clear; -end; - -procedure TtiRtfParser.SaveToFile(AFileName: string); -var AStream: TMemoryStream; -begin - AStream := TMemoryStream.Create; - try - RtfItems.SaveToStream(AStream, ColorList.AsString); - AStream.SaveToFile(AFileName); - finally - AStream.Free; - end; -end; - -function TtiRtfParser.SaveToString: string; -var AStream: TMemoryStream; -begin - Result := ''; - AStream := TMemoryStream.Create; - try - RtfItems.SaveToStream(AStream, ColorList.AsString); - SetLength(Result, AStream.Size); - if AStream.Size > 0 //Humble admitted its a bit dirty - then Move(AStream.Memory^, Result[1], AStream.Size); - finally - AStream.Free; - end; -end; - -procedure TtiRtfParser.SaveToStream(AStream: TMemoryStream); -begin - RtfItems.SaveToStream(AStream, ColorList.AsString); -end; - -function TtiRtfParser.AddVariable(AName: string; AValue: variant; AToken: TRtfToken): TRtfVariable; -begin - Result := Variables.Add(AName, AValue, AToken); -end; - -function TtiRtfParser.AddDataset(ATable: TObject; AName: string; AFreeDataset: boolean = false): TRtfDataset; -begin - Result := Datasets.Add(ATable, AName, AFreeDataset); -end; - -function TtiRtfParser.AddFunction(AName: string; ATokenType: TRtfToken; AMin, AMax: smallint; AOnexecute: TRtfFunctionExecute): TRtfFunction; -begin - Result := Functions.Add(ATokenType, AName, AMin, AMax, AOnexecute); -end; - -function TtiRtfParser.AddToRtfItems(AItem: TRtfItem): TRtfItem; -begin - Result := TRtfItem.Create; - Result.Assign(AItem); - RtfItems.Add(Result); -end; - -procedure TtiRtfParser.LoadFromFile(AFilename: string); -//Tokenize the raw rtf and put it into rawitems -var - AStream: TMemoryStream; -begin - Clear; - AStream := TMemoryStream.Create; - try - AStream.LoadFromFile(AFileName); - LoadFromBuffer(AStream.Memory, AStream.Size); - finally - FreeAndNil(AStream); - end; -end; - -procedure TtiRtfParser.LoadFromStream(AStream: TMemoryStream); -//Tokenize the raw rtf and put it into rawitems -begin - LoadFromBuffer(AStream.Memory, AStream.Size); -end; - -procedure TtiRtfParser.LoadFromString(AString: string); -//Tokenize the raw rtf and put it into rawitems -begin - LoadFromBuffer(pchar(AString), Length(AString)); -end; - -procedure TtiRtfParser.LoadFromBuffer(ABuffer: pchar; ASize: integer); -//Tokenize the raw rtf and put it into rawitems -var AColorTable: TRtfItem; - AColors, AToken: string; - ANumber, ARed, AGreen, ABlue: integer; - p: pchar; -begin - Clear; - with TRawRtfParser.Create do try - Execute(FRawItems, ABuffer, ASize); - AColorTable := ColorTable; - finally - Free; - end; - - if not Assigned(AColorTable) - then raise TRtfException.Create('no colortbl found'); - - //Parse the color table (tiny parser) - ARed := 0; - ABlue := 0; - AGreen := 0; - AColors := Copy(AColorTable.RtfTextBuf, 11, Maxint); - p := pchar(AColors); - while p <> #0 do begin - case p^ of - '\': begin - inc(p); - AToken := ''; - ANumber := 0; - while(p^ in['A'..'Z', 'a'..'z'])do begin - AToken := AToken + p^; - inc(p); - end; - while(p^ in['0'..'9'])do begin - ANumber :=(ANumber * 10) +(ord(p^) - ord('0')); - inc(p); - end; - ANumber := ANumber and 255; - if SameText(AToken, 'red') - then ARed := ANumber - else if SameText(AToken, 'blue') - then ABlue := ANumber - else if SameText(AToken, 'green') - then AGreen := ANumber; - end; - ';': begin - inc(p); - ColorList.UseColor(ARed, AGreen, ABlue); - ARed := 0; - ABlue := 0; - AGreen := 0; - end; - #13, #10: inc(p); - '}': break; - else raise TRtfException.Create('Invalid character in colortbl'); - end; - end; - - (* - {\colortbl;\red0\green0\blue;\red255\green0\blue;\red255\green255\blue;\red0\green255\blue;\red255\green0\blue;\red0\green0\blue;\red0\green255\blue;\red255\green255\blue;\red128\green0\blue;\red128\green128\blue;\red0\green128\blue;\red128\green0\blue;\red0\green0\blue;\red0\green128\blue;\red128\green128\blue;\red192\green192\blue;} - *) -end; - -procedure TtiRtfParser.Execute; -//Rtf has been already been loaded -begin - PreParse; //Create a tree for easy parsing of if-then-else and scan-endscan etc. - Parse(HlpItems); //Parse the tree items in the structure.. -end; - -procedure TtiRtfParser.PreParse; -//Preparse the items from Items to Structure -//This will make a tree from (sub)expressions and code. -//Specially for the if/else/endif and scan/scanend -var AIndex, AForeColor, ABackColor: integer; - AItem, AStart, ABranche: TRtfItem; - AArguments: TRtfArgument; - ARemoveParagraph: boolean; - AFirstArgument: string; - AFirstToken: TRtfToken; - AText: string; -begin - AItem := RawItems.Head; - AArguments := TRtfArgument.Create(Self); - try - //Round 1: create expression nodes - while Assigned(AItem)do begin - if AItem.RtfClass = RtfParsebegin then begin - - //Items starts with a RtfParseBegin - AText := AItem.RtfTextBuf; //Initial expression - AStart := HlpItems[HlpItems.Add(AItem)]; - AStart.RtfClass := RtfExpression; - AStart.RtfMajor := RtfNormalExpression; - AStart.RtfTextBuf := ''; - AItem := AItem.Next; - while Assigned(AItem)do begin - case AItem.RtfClass of - RtfParseEnd: begin //End of expression - AText := AText + AItem.RtfTextBuf; - AItem := AItem.Next; //Skip's ParseEnd - break; - end; - RtfParseBegin: begin //WTF: Start of expression, this should not happen. Inform user - raise TRtfException.Create('Error in preparse? at ' + AText); - end; - RtfText: AText := AText + AItem.RtfTextBuf; - RtfControl: begin - case AItem.RtfMajor of - RtfSpecialChar: begin //Add some special characters - case AItem.RtfMinor of - RtfPar, RtfParDef:; //Ignore these - RtflQuote, RtfrQuote: AText := AText + Chr(39); - RtflDblQuote, RtfrDblQuote: AText := AText + '"'; - else AText := AText + AItem.RtfTextBuf; //Hope this is Ok? - end; - end; - else HlpItems.Add(AItem); - end; - end; - else HlpItems.Add(AItem); - end; - AItem := AItem.Next; - end; - - AStart.RtfTextBuf := StringReplace(AText, #13#10, '',[rfReplaceAll]); - AArguments.Clear; - ARemoveParagraph := true; - try - AArguments.ParseExpression(AText); - except - on e: Exception do begin - //Ignore at this moment, it will be triggered again in the Parse() - end; - end; - if AArguments.Count > 0 then begin - AFirstToken := AArguments[0].Token; - AFirstArgument := AArguments[0].Value; - if SameText(AFirstArgument, 'if') - then AStart.RtfMajor := RtfIfExpression - else if SameText(AFirstArgument, 'else') - then AStart.RtfMajor := RtfElseExpression - else if SameText(AFirstArgument, 'endif') - then AStart.RtfMajor := RtfEndifExpression - else if SameText(AFirstArgument, 'scan') - then AStart.RtfMajor := RtfScan - else if SameText(AFirstArgument, 'endscan') - then AStart.RtfMajor := RtfScanEnd - else if SameText(AFirstArgument, 'scanentry') - then AStart.RtfMajor := RtfScanEntry - else if SameText(AFirstArgument, 'scanfooter') - then AStart.RtfMajor := RtfScanFooter; - ARemoveParagraph := AFirstToken in[etVariable, etProcedure, etNothing]; - if(AFirstToken = etVariable)and(AArguments.Count = 1) - then ARemoveParagraph := false; //One exception: variable reference - end; - - if ARemoveParagraph - then AItem := SkipParagraph(AItem); - end else begin - HlpItems.Add(AItem); - AItem := AItem.Next; - end; - end; - - finally - AArguments.Free; - end; - - //Round 2: create if then else expression sub-nodes - AIndex := 0; - ABranche := nil; - while AIndex < HlpItems.Count do begin - AItem := HlpItems[AIndex]; - try - - if AItem.CheckItem(RtfExpression, RtfIfExpression) then begin - if Assigned(ABranche) then begin - HlpItems.Extract(AItem); - ABranche.Add(AItem); - end - else Inc(AIndex); - - ABranche := TRtfItem.Create; - ABranche.RtfClass := RtfBranche; - ABranche.RtfMajor := RtfThenExpression; - TmpItems.Add(ABranche); //Otherwise memory leak - AItem.Add(ABranche); - end else if AItem.CheckItem(RtfExpression, RtfElseExpression) then begin - if not Assigned(ABranche) - then raise TRtfException.Create('unexpected else'); - - HlpItems.Extract(AItem); //Remove else item - AItem := ABranche.Parent; //Points to "if" statement - if AItem.RtfClass = RtfBranche - then AItem := AItem.Parent; //Points to "if" statement - if not Assigned(AItem) - then raise TRtfException.Create('unexpected else'); - if not AItem.CheckItem(RtfExpression, RtfIfExpression) - then raise TRtfException.Create('unexpected scanentry'); - - ABranche := TRtfItem.Create; - ABranche.RtfClass := RtfBranche; - ABranche.RtfMajor := RtfElseExpression; - TmpItems.Add(ABranche); //Otherwise memory leak - AItem.Add(ABranche); - end else if AItem.CheckItem(RtfExpression, RtfEndifExpression) then begin - if not Assigned(ABranche) - then raise TRtfException.Create('unexpected endif'); - - HlpItems.Extract(AItem); //Remove item - ABranche := ABranche.Parent; - ABranche := ABranche.Parent; - if ABranche = HlpItems - then ABranche := nil; - end else if AItem.CheckItem(RtfExpression, RtfScan) then begin - - if Assigned(ABranche) then begin - HlpItems.Extract(AItem); - ABranche.Add(AItem); - end - else Inc(AIndex); - - ABranche := TRtfItem.Create; - ABranche.RtfClass := RtfBranche; - ABranche.RtfMajor := RtfScan; - TmpItems.Add(ABranche); //Otherwise memory leak - AItem.Add(ABranche); - end else if AItem.CheckItem(RtfExpression, RtfScanEntry) then begin - if not Assigned(ABranche) - then raise TRtfException.Create('unexpected scanentry'); - - HlpItems.Extract(AItem); //Remove else item - AItem := ABranche.Parent; //Points to "scan" statement - if AItem.RtfClass = RtfBranche - then AItem := AItem.Parent; //Points to "scan" statement - if not Assigned(AItem) - then raise TRtfException.Create('unexpected scanentry'); - if not AItem.CheckItem(RtfExpression, RtfScan) - then raise TRtfException.Create('unexpected scanentry'); - - ABranche := TRtfItem.Create; - ABranche.RtfClass := RtfBranche; - ABranche.RtfMajor := RtfScanEntry; - TmpItems.Add(ABranche); //Otherwise memory leak - AItem.Add(ABranche); - end else if AItem.CheckItem(RtfExpression, RtfScanFooter) then begin - if not Assigned(ABranche) - then raise TRtfException.Create('unexpected scanfooter'); - - HlpItems.Extract(AItem); //Remove item - AItem := ABranche.Parent; //Points to "scan" statement - if AItem.RtfClass = RtfBranche - then AItem := AItem.Parent; //Points to "scan" statement - if not Assigned(AItem) - then raise TRtfException.Create('unexpected scanfooter'); - if not AItem.CheckItem(RtfExpression, RtfScan) - then raise TRtfException.Create('unexpected scanfooter'); - - ABranche := TRtfItem.Create; - ABranche.RtfClass := RtfBranche; - ABranche.RtfMajor := RtfScanFooter; - TmpItems.Add(ABranche); //Otherwise memory leak - AItem.Add(ABranche); - end else if AItem.CheckItem(RtfExpression, RtfScanEnd) then begin - if not Assigned(ABranche) - then raise TRtfException.Create('unexpected scanend'); - - HlpItems.Extract(AItem); //Remove item - ABranche := ABranche.Parent; - ABranche := ABranche.Parent; - if ABranche = HlpItems - then ABranche := nil; - end else begin - if Assigned(ABranche) then begin - HlpItems.Extract(AItem); - ABranche.Add(AItem); - end - else Inc(AIndex); - end; - except - on e: Exception do begin - fpgApplication.HandleException(e); -{ - if Assigned(AItem) - then AItem.RtfTextBuf := AItem.RtfTextBuf + ' ' + E.Message; -} - end; - end; - end; - - if Assigned(ABranche) then begin - if Assigned(AItem) then begin - AForeColor := ColorList.UseColor(ErrorForeColor); - ABackColor := ColorList.UseColor(ErrorBackColor); - AItem.FRtfTextBuf := Format('{\b\ul\highlight%d\cf%d <<<<endif or endscan missing}%s',[ABackColor, AForeColor, AItem.RtfTextBuf]); - end; - end; -end; - -function TtiRtfParser.SkipParagraph(AItem: TRtfItem): TRtfItem; -//Remove paragraph breaks if it was just a procedure (or a VAR/SET etc.) -//This can be multiple breaks (CrLf and /Par controls) but -//do not remove more than a single item from each of them -var AEnter, APar, AParDef: boolean; -begin - APar := false; - AEnter := false; - AParDef := false; - while Assigned(AItem) do - begin - case AItem.RtfClass of - RtfText: begin - if not AEnter and(Pos(#13#10, AItem.RtfTextBuf) > 0) then - begin - //Crap, it can contain multiple #13#10's - AItem.RtfTextBuf := StringReplace(AItem.RtfTextBuf, #13#10, '',[rfReplaceAll]); - AItem := AItem.Next; - AEnter := true; - continue; - end - else - break; - end; - RtfControl: begin - case AItem.RtfMajor of - RtfSpecialChar: begin - case AItem.RtfMinor of - RtfPar: begin - if not APar then - begin - AItem := AItem.Next; - APar := true; - continue; - end - else - break; - end; - RtfParDef: begin - if not AParDef then - begin - AItem := AItem.Next; - AParDef := true; - continue; - end - else - break; - end; - end; - end; - end; - end; - end; - break; - end; - Result := AItem; -end; - -procedure TtiRtfParser.Parse(AItems: TRtfItem); -//Forward all stuff to the output list -var - i: integer; - AItem: TRtfItem; -begin - for i := 0 to AItems.Count - 1 do - begin - AItem := AItems[i]; - if AItem.RtfClass = RtfExpression then - ParseExpression(AItem) - else - AddToRtfItems(AItem); - end; -end; - -procedure TtiRtfParser.ParseExpression(AItem: TRtfItem); -var - i, ABackColor, AForeColor: integer; - ARemove: boolean; - ADataset: TRtfDataset; - AScanNoEof: boolean; - AExpression: string; - AResultValue: variant; - AResultParam: integer; - AResultToken: TRtfToken; - AArguments: TRtfArgument; - AAnswer, ATemp, AHeader, ARecord, AFooter: TRtfItem; -begin - AExpression := AItem.RtfTextBuf; - AAnswer := AddToRtfItems(AItem); - AAnswer.RtfTextBuf := ''; - - try - ARemove := true; - AArguments := TRtfArgument.Create(Self); - try - AArguments.ParseExpression(AExpression); - if AArguments.Count > 0 then - begin - //procedures and variables have no returning value and etNothing, well - ARemove := AArguments[0].Token in[etVariable, etProcedure, etNothing]; - if (AArguments[0].Token = etVariable) and (AArguments.Count = 1) then - ARemove := false; //But show a single variable - end; - if Assigned(OnEvalutate) then //debug - OnEvalutate(AArguments); - AArguments.Evaluate; - AResultToken := AArguments.Token; - AResultValue := AArguments.Value; - AResultParam := AArguments.Param; - if Assigned(OnEvalutate) then //debug - OnEvalutate(AArguments); - - case AItem.RtfMajor of - RtfNormalExpression: begin - if not ARemove then begin - //Expand booleans and date to text values (date because Variant - //have no typing for it. Place the text into the output rtf - if AResultToken = etLitTrue then - AAnswer.RtfTextBuf := BoolTrue - else if AResultToken = etLitFalse then - AAnswer.RtfTextBuf := BoolFalse - else if AResultToken = etLitDate then - begin - if Frac(AResultValue) = 0 then - AAnswer.RtfTextBuf := DateToStr(AResultValue) - else if Int(AResultValue) = 0 then - AAnswer.RtfTextBuf := TimeToStr(AResultValue) - else - AAnswer.RtfTextBuf := DateTimeToStr(AResultValue); - end - else - AAnswer.RtfTextBuf := VarToStr(AResultValue); - end; - end; - - RtfIfExpression: - begin - if AResultToken = etLitTrue then - Parse(AItem[0]) - else if(AResultToken = etLitFalse)and(AItem.Count > 1) then - Parse(AItem[1]); - end; - - RtfScan: - begin - //Scan(Dataset). Find out what items is header, record and footer - ARecord := nil; - AHeader := nil; - AFooter := nil; - ADataset := TRtfDataset(PtrInt(AResultValue)); //Dirty! - - for i := 0 to AItem.Count - 1 do begin - ATemp := AItem[i]; - case ATemp.RtfMajor of - RtfScan: AHeader := ATemp; - RtfScanEntry: ARecord := ATemp; - RtfScanFooter: AFooter := ATemp; - end; - end; - - if AHeader = ARecord - then AHeader := nil; - if ARecord = nil then begin - ARecord := AHeader; - AHeader := nil; - end; - - AScanNoEof := AResultParam = 1; - - //And evaluate the Scan(dataset) - ADataset.Open; - if Assigned(AHeader) - then Parse(AHeader); - ADataset.First; - - if AScanNoEof and ADataset.Eof - then exit; //Also no footer.. - - while not ADataset.Eof do begin - if Assigned(ARecord) - then Parse(ARecord); - ADataset.Next; - end; - if Assigned(AFooter) - then Parse(AFooter); - end; - end; - finally - AArguments.Free; - end; - - except - on e: Exception do begin - AForeColor := ColorList.UseColor(ErrorForeColor); - ABackColor := ColorList.UseColor(ErrorBackColor); - AAnswer.FRtfTextBuf := Format('{\b\ul\highlight%d\cf%d %s %s}',[ABackColor, AForeColor, AExpression, E.Message]); - end; - end; -end; - -procedure TtiRtfParser.AddFunctions; -begin - //Extra tokens not tokenized by RawParser - FFunctions.Add(etOr, 'Or', 0, 0, nil); - FFunctions.Add(etNot, 'Not', 0, 0, nil); - FFunctions.Add(etAnd, 'And', 0, 0, nil); - FFunctions.Add(etLitTrue, 'True', 0, 0, nil); - FFunctions.Add(etLitFalse, 'False', 0, 0, nil); - - //Date time functions/conversions - FFunctions.Add(etFunction, 'Year', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfYear); - FFunctions.Add(etFunction, 'Month', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfMonth); - FFunctions.Add(etFunction, 'Day', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfDay); - FFunctions.Add(etFunction, 'SYear', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfSYear); - FFunctions.Add(etFunction, 'SMonth', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfSMonth); - FFunctions.Add(etFunction, 'SDay', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfSDay); - FFunctions.Add(etFunction, 'Dtos', 1, 2, {$IFDEF FPC}@{$ENDIF}UdfDtos); - FFunctions.Add(etFunction, 'Stod', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfStod); - FFunctions.Add(etFunction, 'DateToStr', 1, 2, {$IFDEF FPC}@{$ENDIF}UdfDateToStr); - FFunctions.Add(etFunction, 'TimeToStr', 1, 2, {$IFDEF FPC}@{$ENDIF}UdfTimeToStr); - FFunctions.Add(etFunction, 'DateTimeToStr', 1, 2, {$IFDEF FPC}@{$ENDIF}UdfDateTimeToStr); - FFunctions.Add(etFunction, 'StrToDate', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfStrToDate); - FFunctions.Add(etFunction, 'StrToTime', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfStrToTime); - FFunctions.Add(etFunction, 'StrToDateTime', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfStrToDateTime); - FFunctions.Add(etFunction, 'ShortMonthName', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfShortMonthName); - FFunctions.Add(etFunction, 'ShortDayName', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfShortDayName); - FFunctions.Add(etFunction, 'LongMonthName', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfLongMonthName); - FFunctions.Add(etFunction, 'LongDayName', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfLongDayName); - - //String, int, float functions/conversions - FFunctions.Add(etFunction, 'Int', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfInt); - FFunctions.Add(etFunction, 'Chr', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfChr); - FFunctions.Add(etFunction, 'Iif', 3, 3, {$IFDEF FPC}@{$ENDIF}UdfIif); - FFunctions.Add(etFunction, 'Str', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfStr); - FFunctions.Add(etFunction, 'Val', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfVal); - FFunctions.Add(etFunction, 'Nul', 2, 2, {$IFDEF FPC}@{$ENDIF}UdfNul); - FFunctions.Add(etFunction, 'Now', 0, 0, {$IFDEF FPC}@{$ENDIF}UdfNow); - FFunctions.Add(etFunction, 'Frac', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfFrac); - FFunctions.Add(etFunction, 'Padr', 2, 2, {$IFDEF FPC}@{$ENDIF}UdfPadr); - FFunctions.Add(etFunction, 'Padl', 2, 2, {$IFDEF FPC}@{$ENDIF}UdfPadl); - FFunctions.Add(etFunction, 'Date', 0, 0, {$IFDEF FPC}@{$ENDIF}UdfDate); - FFunctions.Add(etFunction, 'Time', 0, 0, {$IFDEF FPC}@{$ENDIF}UdfTime); - FFunctions.Add(etFunction, 'Mid', 2, 3, {$IFDEF FPC}@{$ENDIF}UdfSubStr); - FFunctions.Add(etFunction, 'Copy', 2, 3, {$IFDEF FPC}@{$ENDIF}UdfSubStr); - FFunctions.Add(etFunction, 'SubStr', 2, 3, {$IFDEF FPC}@{$ENDIF}UdfSubStr); - FFunctions.Add(etFunction, 'Trunc', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfTrunc); - FFunctions.Add(etFunction, 'Round', 1, 2, {$IFDEF FPC}@{$ENDIF}UdfRound); - FFunctions.Add(etFunction, 'Upper', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfUpper); - FFunctions.Add(etFunction, 'Lower', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfLower); - FFunctions.Add(etFunction, 'Trim', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfTrim); - FFunctions.Add(etFunction, 'Empty', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfEmpty); - FFunctions.Add(etFunction, 'TrimLeft', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfTrimLeft); - FFunctions.Add(etFunction, 'TrimRight', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfTrimRight); - FFunctions.Add(etFunction, 'IntToStr', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfIntToStr); - FFunctions.Add(etFunction, 'StrToInt', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfStrToInt); - FFunctions.Add(etFunction, 'FloatToStr', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfFloatToStr); - FFunctions.Add(etFunction, 'StrToFloat', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfStrToFloat); - FFunctions.Add(etFunction, 'Power', 2, 2, {$IFDEF FPC}@{$ENDIF}UdfIntPower); - FFunctions.Add(etFunction, 'IntPower', 2, 2, {$IFDEF FPC}@{$ENDIF}UdfIntPower); - FFunctions.Add(etFunction, 'FormatFloat', 2, 2, {$IFDEF FPC}@{$ENDIF}UdfFormatFloat); - FFunctions.Add(etFunction, 'FBool', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfFbool); - - //Dataset - FFunctions.Add(etFunction, 'Bof', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfBof); - FFunctions.Add(etFunction, 'Eof', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfEof); - FFunctions.Add(etProcedure, 'Next', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfNext); - FFunctions.Add(etProcedure, 'Prev', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfPrior); - FFunctions.Add(etProcedure, 'Open', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfOpen); - FFunctions.Add(etProcedure, 'First', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfFirst); - FFunctions.Add(etProcedure, 'Last', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfLast); - FFunctions.Add(etFunction, 'IsEmpty', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfIsEmpty); - FFunctions.Add(etFunction, 'RecordCount', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfRecordCount); - FFunctions.Add(etProcedure, 'Scan', 1, 9999, {$IFDEF FPC}@{$ENDIF}UdfScan); - FFunctions.Add(etProcedure, 'EndScan', 0, 0, {$IFDEF FPC}@{$ENDIF}UdfDummy); - FFunctions.Add(etProcedure, 'ScanEntry', 0, 0, {$IFDEF FPC}@{$ENDIF}UdfDummy); - FFunctions.Add(etProcedure, 'ScanFooter', 0, 0, {$IFDEF FPC}@{$ENDIF}UdfDummy); - FFunctions.Add(etProcedure, 'Dataset', 3, 9999, {$IFDEF FPC}@{$ENDIF}UdfDataset); - - //Misc routines - FFunctions.Add(etProcedure, 'If', 1, 9999, {$IFDEF FPC}@{$ENDIF}UdfIf); - FFunctions.Add(etProcedure, 'Else', 0, 0, {$IFDEF FPC}@{$ENDIF}UdfDummy); - FFunctions.Add(etProcedure, 'Endif', 0, 0, {$IFDEF FPC}@{$ENDIF}UdfDummy); - FFunctions.Add(etProcedure, 'NoPar', 0, 0, {$IFDEF FPC}@{$ENDIF}UdfDummy); - FFunctions.Add(etFunction, 'Picture', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfPicture); - FFunctions.Add(etFunction, 'DbPicture', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfDbPicture); -end; - -procedure TtiRtfParser.UdfDummy(AArgument: TRtfArgument); -begin - //Nothing, since its an etProcedure the Rtf paragraph will be removed -end; - -procedure TtiRtfParser.UdfChr(AArgument: TRtfArgument); -begin - if not AArgument.Check(0,[etLitInt]) - then raise TRtfException.Create(rsUnexpectedParameterType); - AArgument.Value := Chr(StrToInt(AArgument[0].Value)); - AArgument.Token := etLitString; -end; - -procedure TtiRtfParser.UdfNow(AArgument: TRtfArgument); -begin - AArgument.Value := Now; - AArgument.Token := etLitDate; -end; - -procedure TtiRtfParser.UdfDate(AArgument: TRtfArgument); -begin - AArgument.Value := Date; - AArgument.Token := etLitDate; -end; - -procedure TtiRtfParser.UdfTime(AArgument: TRtfArgument); -begin - AArgument.Value := Time; - AArgument.Token := etLitDate; -end; - -procedure TtiRtfParser.UdfIntToStr(AArgument: TRtfArgument); -begin - if not AArgument.Check(0,[etLitInt]) - then raise TRtfException.Create(rsUnexpectedParameterType); - AArgument.Value := IntToStr(AArgument[0].Value); - AArgument.Token := etLitString; -end; - -procedure TtiRtfParser.UdfStrToInt(AArgument: TRtfArgument); -begin - if not AArgument.Check(0,[etLitString]) - then raise TRtfException.Create(rsUnexpectedParameterType); - AArgument.Value := StrToInt(AArgument[0].Value); - AArgument.Token := etLitInt; -end; - -procedure TtiRtfParser.UdfFloatToStr(AArgument: TRtfArgument); -begin - if not AArgument.Check(0,[etLitFloat]) - then raise TRtfException.Create(rsUnexpectedParameterType); - AArgument.Value := FloatToStr(Extended(AArgument[0].Value)); - AArgument.Token := etLitString; -end; - -procedure TtiRtfParser.UdfStrToFloat(AArgument: TRtfArgument); -begin - if not AArgument.Check(0,[etLitString]) - then raise TRtfException.Create(rsUnexpectedParameterType); - AArgument.Value := StrToFloat(AArgument[0].Value); - AArgument.Token := etLitFloat; -end; - -procedure TtiRtfParser.UdfNul(AArgument: TRtfArgument); -var AStr: string; - ACnt: integer; -begin - if not AArgument.Check([[etLitInt],[etLitInt]]) - then raise TRtfException.Create(rsUnexpectedParameterType); - AStr := AArgument[0].Value; - ACnt := AArgument[1].Value; - while Length(AStr) < ACnt do AStr := '0' + AStr; - while Length(AStr) > ACnt do Delete(AStr, 1, 1); - AArgument.Value := AStr; - AArgument.Token := etLitString; -end; - -procedure TtiRtfParser.UdfPadl(AArgument: TRtfArgument); -var AStr: string; - ACnt: integer; -begin - if not AArgument.Check([[etLitString],[etLitInt]]) - then raise TRtfException.Create(rsUnexpectedParameterType); - AStr := AArgument[0].Value; - ACnt := AArgument[1].Value; - AStr := Copy(AStr, 1, ACnt); - while Length(AStr) < ACnt do begin - AStr := ' ' + AStr; - end; - AArgument.Value := AStr; - AArgument.Token := etLitString; -end; - -procedure TtiRtfParser.UdfPadr(AArgument: TRtfArgument); -var AStr: string; - ACnt: integer; -begin - if not AArgument.Check([[etLitString],[etLitInt]]) - then raise TRtfException.Create(rsUnexpectedParameterType); - AStr := AArgument[0].Value; - ACnt := AArgument[1].Value; - AStr := Copy(AStr, 1, ACnt); - while Length(AStr) < ACnt do begin - AStr := AStr + ' '; - end; - AArgument.Value := AStr; - AArgument.Token := etLitString; -end; - -procedure TtiRtfParser.UdfIif(AArgument: TRtfArgument); -begin - if not AArgument.Check(0,[etLitFalse, etLitTrue]) - then raise TRtfException.Create(rsUnexpectedParameterType); - if AArgument[0].Token = etLitTrue then begin - AArgument.Value := AArgument[1].Value; - AArgument.Token := AArgument[1].Token; - end else begin - AArgument.Value := AArgument[2].Value; - AArgument.Token := AArgument[2].Token; - end; -end; - -procedure TtiRtfParser.UdfIf(AArgument: TRtfArgument); -begin - if not AArgument.Check(0,[etLitFalse, etLitTrue]) - then raise TRtfException.Create(rsUnexpectedParameterType); - AArgument.Value := AArgument[0].Value; - AArgument.Token := AArgument[0].Token; -end; - -procedure TtiRtfParser.UdfScan(AArgument: TRtfArgument); -begin - if not AArgument.Check(0,[etDataset]) - then raise TRtfException.Create(rsUnexpectedParameterType); - AArgument.Value := AArgument[0].Value; - AArgument.Token := AArgument[0].Token; - if AArgument.Count > 1 then begin - if AArgument[1].Token = etLitTrue - then AArgument.Param := 1; - end; -end; - -procedure TtiRtfParser.UdfDataset(AArgument: TRtfArgument); -var ADatabase, AAliasName, ASqlScript: string; - ADataset: TRtfDataset; - AObject: TObject; -begin - if not AArgument.Check([[etLitString],[etLitString],[etLitString]]) - then raise TRtfException.Create(rsUnexpectedParameterType); - - ADatabase := AArgument[0].Value; - AAliasName := AArgument[1].Value; - ASqlScript := AArgument[2].Value; - - //Delete first argument so Sql params become first - AArgument.Delete(0); - AArgument.Delete(0); - AArgument.Delete(0); - - //Remove existing dataset with same aliasname - ADataset := Datasets.Find(AAliasName); - if Assigned(ADataset) - then Datasets.Remove(ADataset); - - //Create the new query or dataset (whatever) - if Assigned(OnCreateDataset) - then OnCreateDataset(ADatabase, AAliasName, ASqlScript, AArgument) - else raise TRtfException.Create('OnCreateDataset is not assigned'); - if VarIsEmpty(AArgument.Value) - then raise TRtfException.Create('OnCreateDataset did not return a dataset object'); - - AObject := TObject(Ptrint(AArgument.Value)); - ADataset := Datasets.Add(AObject, AAliasname, true); - AArgument.Token := etDataset; - AArgument.Value := PtrInt(ADataset); -end; - -procedure TtiRtfParser.UdfLower(AArgument: TRtfArgument); -begin - if not AArgument.Check(0,[etLitString]) - then raise TRtfException.Create(rsUnexpectedParameterType); - AArgument.Token := etLitString; - AArgument.Value := LowerCase(AArgument[0].Value); -end; - -procedure TtiRtfParser.UdfUpper(AArgument: TRtfArgument); -begin - if not AArgument.Check(0,[etLitString]) - then raise TRtfException.Create(rsUnexpectedParameterType); - AArgument.Token := etLitString; - AArgument.Value := UpperCase(AArgument[0].Value); -end; - -procedure TtiRtfParser.UdfTrim(AArgument: TRtfArgument); -begin - if not AArgument.Check(0,[etLitString]) - then raise TRtfException.Create(rsUnexpectedParameterType); - AArgument.Token := etLitString; - AArgument.Value := Trim(AArgument[0].Value); -end; - -procedure TtiRtfParser.UdfTrimLeft(AArgument: TRtfArgument); -begin - if not AArgument.Check(0,[etLitString]) - then raise TRtfException.Create(rsUnexpectedParameterType); - AArgument.Token := etLitString; - AArgument.Value := TrimLeft(AArgument[0].Value); -end; - -procedure TtiRtfParser.UdfTrimRight(AArgument: TRtfArgument); -begin - if not AArgument.Check(0,[etLitString]) - then raise TRtfException.Create(rsUnexpectedParameterType); - AArgument.Token := etLitString; - AArgument.Value := TrimRight(AArgument[0].Value); -end; - -procedure TtiRtfParser.UdfSubStr(AArgument: TRtfArgument); -var AStr: string; - APos, ACnt: integer; -begin - ACnt := Maxint; - if not AArgument.Check([[etLitString],[etLitInt]]) - then raise TRtfException.Create(rsUnexpectedParameterType); - if AArgument.Count > 2 then begin - if not AArgument.Check(2,[etLitInt]) then - raise TRtfException.Create(rsUnexpectedParameterType); - ACnt := AArgument[2].Value; - end; - AStr := AArgument[0].Value; - APos := AArgument[1].Value; - AStr := Copy(AStr, APos, ACnt); - AArgument.Value := AStr; - AArgument.Token := etLitString; -end; - -procedure TtiRtfParser.UdfStr(AArgument: TRtfArgument); -begin - if not AArgument.Check(0,[etLitFloat, etLitInt]) then - raise TRtfException.Create(rsUnexpectedParameterType); - if AArgument[0].Token = etLitFloat then - begin - AArgument.Token := etLitString; - AArgument.Value := FloatToStr(AArgument[0].Value); - end - else - begin - AArgument.Token := etLitString; - AArgument.Value := IntToStr(AArgument[0].Value); - end; -end; - -procedure TtiRtfParser.UdfVal(AArgument: TRtfArgument); -begin - if not AArgument.Check(0,[etLitString]) then - raise TRtfException.Create(rsUnexpectedParameterType); - if (Pos('.', AArgument[0].Value) > 0)or(Pos(',', AArgument[0].Value) > 0) then - begin - AArgument.Token := etLitString; - AArgument.Value := StrToFloat(AArgument[0].Value) - end - else - begin - AArgument.Token := etLitString; - AArgument.Value := StrToInt(AArgument[0].Value) - end; -end; - -procedure TtiRtfParser.UdfBof(AArgument: TRtfArgument); -var ATable: TRtfDataset; -begin - if not AArgument.Check(0,[etDataset]) then - raise TRtfException.Create(rsUnexpectedParameterType); - ATable := TRtfDataset(Ptrint(AArgument[0].Value)); - if ATable.Bof then - begin - AArgument.Token := etLitTrue; - AArgument.Value := true; - end - else - begin - AArgument.Token := etLitFalse; - AArgument.Value := false; - end; -end; - -procedure TtiRtfParser.UdfEof(AArgument: TRtfArgument); -var ATable: TRtfDataset; -begin - if not AArgument.Check(0,[etDataset]) then - raise TRtfException.Create(rsUnexpectedParameterType); - ATable := TRtfDataset(Ptrint(AArgument[0].Value)); - if ATable.Eof then - begin - AArgument.Token := etLitTrue; - AArgument.Value := true; - end - else - begin - AArgument.Token := etLitFalse; - AArgument.Value := false; - end; -end; - - -procedure TtiRtfParser.UdfRecordCount(AArgument: TRtfArgument); -var ATable: TRtfDataset; -begin - if not AArgument.Check(0,[etDataset]) - then raise TRtfException.Create(rsUnexpectedParameterType); - ATable := TRtfDataset(Ptrint(AArgument[0].Value)); - AArgument.Token := etLitInt; - AArgument.Value := ATable.RecordCount -end; - -procedure TtiRtfParser.UdfIsEmpty(AArgument: TRtfArgument); -var ATable: TRtfDataset; -begin - if not AArgument.Check(0,[etDataset]) - then raise TRtfException.Create(rsUnexpectedParameterType); - ATable := TRtfDataset(Ptrint(AArgument[0].Value)); - if ATable.IsEmpty then begin - AArgument.Token := etLitTrue; - AArgument.Value := true; - end else begin - AArgument.Token := etLitFalse; - AArgument.Value := false; - end; -end; - -procedure TtiRtfParser.UdfFirst(AArgument: TRtfArgument); -var ATable: TRtfDataset; -begin - if not AArgument.Check(0,[etDataset]) - then raise TRtfException.Create(rsUnexpectedParameterType); - ATable := TRtfDataset(Ptrint(AArgument[0].Value)); - ATable.First; -end; - -procedure TtiRtfParser.UdfLast(AArgument: TRtfArgument); -var ATable: TRtfDataset; -begin - if not AArgument.Check(0,[etDataset]) - then raise TRtfException.Create(rsUnexpectedParameterType); - ATable := TRtfDataset(Ptrint(AArgument[0].Value)); - ATable.Last; -end; - -procedure TtiRtfParser.UdfNext(AArgument: TRtfArgument); -var ATable: TRtfDataset; -begin - if not AArgument.Check(0,[etDataset]) - then raise TRtfException.Create(rsUnexpectedParameterType); - ATable := TRtfDataset(Ptrint(AArgument[0].Value)); - ATable.Next; -end; - -procedure TtiRtfParser.UdfOpen(AArgument: TRtfArgument); -var ATable: TRtfDataset; -begin - if not AArgument.Check(0,[etDataset]) - then raise TRtfException.Create(rsUnexpectedParameterType); - ATable := TRtfDataset(Ptrint(AArgument[0].Value)); - ATable.Open; -end; - -procedure TtiRtfParser.UdfPrior(AArgument: TRtfArgument); -var ATable: TRtfDataset; -begin - if not AArgument.Check(0,[etDataset]) - then raise TRtfException.Create(rsUnexpectedParameterType); - ATable := TRtfDataset(Ptrint(AArgument[0].Value)); - ATable.Prior; -end; - -procedure TtiRtfParser.UdfInt(AArgument: TRtfArgument); -//Returns the integer part of a float -begin - if not AArgument.Check(0,[etLitFloat, etLitInt]) - then raise TRtfException.Create(rsUnexpectedParameterType); - if AArgument[0].Token = etLitFloat then begin - AArgument.Token := etLitFloat; - AArgument.Value := Int(AArgument[0].Value); - end else begin - AArgument.Token := etLitInt; - AArgument.Value := AArgument[0].Value; - end; -end; - -procedure TtiRtfParser.UdfFrac(AArgument: TRtfArgument); -//Returns the fractional part of a float -begin - if not AArgument.Check(0,[etLitFloat, etLitInt]) - then raise TRtfException.Create(rsUnexpectedParameterType); - if AArgument[0].Token = etLitFloat then begin - AArgument.Token := etLitFloat; - AArgument.Value := Frac(AArgument[0].Value); - end else begin - AArgument.Token := etLitInt; - AArgument.Value := 0; - end; -end; - -procedure TtiRtfParser.UdfRound(AArgument: TRtfArgument); -//0.5 is always rounded to largest integer number -var - ASign, ADecimals, AInt: integer; - AFloat, APower, AFrac: Double; -begin - ADecimals := 0; - if not AArgument.Check(0,[etLitFloat, etLitInt]) then - raise TRtfException.Create(rsUnexpectedParameterType); - if AArgument.Count > 1 then - begin - if not AArgument.Check(1,[etLitInt]) then - raise TRtfException.Create(rsUnexpectedParameterType); - ADecimals := AArgument[1].Value; - end; - - if AArgument[0].Token = etLitFloat then - begin - AFloat := AArgument[0].Value; - - ASign := 1; - if AFloat < 0 then - begin - AFloat := - AFloat; - ASign := - 1; - end; - - if ADecimals = 0 then - begin - AInt := Trunc(AFloat); //integer part - AFrac := AFloat - AInt; //fractional part - if AFrac >= 0.5 then - AArgument.Value := ASign *(AInt + 1) - else - AArgument.Value := ASign * AInt; - AArgument.Token := etLitFloat; - end - else - begin - APower := IntPower(10, ADecimals); - AInt := Trunc(AFloat * APower); //integer part * 10^ADecimals - AFrac := AFloat * APower - AInt; //fractional part - if AFrac >= 0.5 then - AArgument.Value := ASign * IntPower(10, - ADecimals) *(AInt + 1) - else - AArgument.Value := ASign * IntPower(10, - ADecimals) * AInt; - AArgument.Token := etLitFloat; - end; - end - else - begin - AArgument.Token := etLitInt; - AArgument.Value := AArgument[0].Value; - end; -end; - -procedure TtiRtfParser.UdfTrunc(AArgument: TRtfArgument); -begin - if not AArgument.Check(0,[etLitFloat, etLitInt]) - then raise TRtfException.Create(rsUnexpectedParameterType); - if AArgument[0].Token = etLitFloat then begin - AArgument.Token := etLitFloat; - AArgument.Value := Trunc(AArgument[0].Value); - end else begin - AArgument.Token := etLitInt; - AArgument.Value := AArgument[0].Value; - end; -end; - -procedure TtiRtfParser.UdfIntPower(AArgument: TRtfArgument); -var AFloat: Double; - AExponent: integer; -begin - if not AArgument.Check([[etLitInt, etLitFloat],[etLitInt]]) then - raise TRtfException.Create(rsUnexpectedParameterType); - AFloat := AArgument[0].Value; - AExponent := AArgument[1].Value; - AArgument.Token := etLitFloat; - AArgument.Value := IntPower(AFloat, AExponent); -end; - -procedure TtiRtfParser.UdfPower(AArgument: TRtfArgument); -var AFloat, AExponent: Double; -begin - if not AArgument.Check([[etLitInt, etLitFloat],[etLitInt, etLitFloat]]) - then raise TRtfException.Create(rsUnexpectedParameterType); - AFloat := AArgument[0].Value; - AExponent := AArgument[1].Value; - AArgument.Token := etLitFloat; - AArgument.Value := Pwr(AFloat, AExponent); -end; - -procedure TtiRtfParser.UdfEmpty(AArgument: TRtfArgument); -begin - if not AArgument.Check(0,[etLitString]) - then raise TRtfException.Create(rsUnexpectedParameterType); - if Trim(AArgument[0].Value) = '' then begin - AArgument.Token := etLitTrue; - AArgument.Value := true; - end else begin - AArgument.Token := etLitFalse; - AArgument.Value := false; - end; -end; - -procedure TtiRtfParser.UdfDay(AArgument: TRtfArgument); -var AYear, AMonth, ADay: word; -begin - if not AArgument.Check(0,[etLitDate]) - then raise TRtfException.Create(rsUnexpectedParameterType); - DecodeDate(AArgument[0].Value, AYear, AMonth, ADay); - AArgument.Token := etLitInt; - AArgument.Value := ADay; -end; - -procedure TtiRtfParser.UdfMonth(AArgument: TRtfArgument); -var AYear, AMonth, ADay: word; -begin - if not AArgument.Check(0,[etLitDate]) - then raise TRtfException.Create(rsUnexpectedParameterType); - DecodeDate(AArgument[0].Value, AYear, AMonth, ADay); - AArgument.Token := etLitInt; - AArgument.Value := AMonth; -end; - -procedure TtiRtfParser.UdfYear(AArgument: TRtfArgument); -var AYear, AMonth, ADay: word; -begin - if not AArgument.Check(0,[etLitDate]) - then raise TRtfException.Create(rsUnexpectedParameterType); - DecodeDate(AArgument[0].Value, AYear, AMonth, ADay); - AArgument.Token := etLitInt; - AArgument.Value := AYear; -end; - -procedure TtiRtfParser.UdfShortDayName(AArgument: TRtfArgument); -var AYear, AMonth, ADay: word; -begin - if not AArgument.Check(0,[etLitDate]) - then raise TRtfException.Create(rsUnexpectedParameterType); - DecodeDate(AArgument[0].Value, AYear, AMonth, ADay); - AArgument.Token := etLitString; - AArgument.Value := ShortDayNames[ADay]; -end; - -procedure TtiRtfParser.UdfShortMonthName(AArgument: TRtfArgument); -var AYear, AMonth, ADay: word; -begin - if not AArgument.Check(0,[etLitDate]) - then raise TRtfException.Create(rsUnexpectedParameterType); - DecodeDate(AArgument[0].Value, AYear, AMonth, ADay); - AArgument.Token := etLitString; - AArgument.Value := ShortMonthNames[AMonth]; -end; - -procedure TtiRtfParser.UdfLongDayName(AArgument: TRtfArgument); -var AYear, AMonth, ADay: word; -begin - if not AArgument.Check(0,[etLitDate]) - then raise TRtfException.Create(rsUnexpectedParameterType); - DecodeDate(AArgument[0].Value, AYear, AMonth, ADay); - AArgument.Token := etLitString; - AArgument.Value := LongMonthNames[AMonth]; -end; - -procedure TtiRtfParser.UdfLongMonthName(AArgument: TRtfArgument); -var AYear, AMonth, ADay: word; -begin - if not AArgument.Check(0,[etLitDate]) - then raise TRtfException.Create(rsUnexpectedParameterType); - DecodeDate(AArgument[0].Value, AYear, AMonth, ADay); - AArgument.Token := etLitString; - AArgument.Value := LongMonthNames[AMonth]; -end; - -procedure TtiRtfParser.UdfSDay(AArgument: TRtfArgument); -var AYear, AMonth, ADay: word; -begin - if not AArgument.Check(0,[etLitDate]) - then raise TRtfException.Create(rsUnexpectedParameterType); - DecodeDate(AArgument[0].Value, AYear, AMonth, ADay); - AArgument.Token := etLitString; - AArgument.Value := Format('%0.2d',[ADay]); -end; - -procedure TtiRtfParser.UdfSMonth(AArgument: TRtfArgument); -var AYear, AMonth, ADay: word; -begin - if not AArgument.Check(0,[etLitDate]) - then raise TRtfException.Create(rsUnexpectedParameterType); - DecodeDate(AArgument[0].Value, AYear, AMonth, ADay); - AArgument.Token := etLitString; - AArgument.Value := Format('%0.2d',[AMonth]); -end; - -procedure TtiRtfParser.UdfSYear(AArgument: TRtfArgument); -var AYear, AMonth, ADay: word; -begin - if not AArgument.Check(0,[etLitDate]) - then raise TRtfException.Create(rsUnexpectedParameterType); - DecodeDate(AArgument[0].Value, AYear, AMonth, ADay); - AArgument.Token := etLitString; - AArgument.Value := Format('%0.4d',[AYear]); -end; - -procedure TtiRtfParser.UdfStod(AArgument: TRtfArgument); -var AYear, AMonth, ADay: word; - AStr: string; -begin - if not AArgument.Check(0,[etLitString]) - then raise TRtfException.Create(rsUnexpectedParameterType); - AStr := AArgument[0].Value; - AYear := StrToInt(Copy(AStr, 1, 4)); - AMonth := StrToInt(Copy(AStr, 5, 2)); - ADay := StrToInt(Copy(AStr, 7, 2)); - AArgument.Token := etLitDate; - AArgument.Value := EncodeDate(AYear, AMonth, ADay); -end; - -procedure TtiRtfParser.UdfDateTimeTo(AArgument: TRtfArgument; AFormat: string); -begin - if not AArgument.Check(0,[etLitDate]) then - raise TRtfException.Create(rsUnexpectedParameterType); - if AArgument.Count > 1 then - begin - if not AArgument.Check(1,[etLitString]) then - raise TRtfException.Create(rsUnexpectedParameterType); - AFormat := AArgument[1].Value; - end; - AArgument.Token := etLitString; - AArgument.Value := FormatDateTime(AFormat, AArgument[0].Value); -end; - -procedure TtiRtfParser.UdfDtoS(AArgument: TRtfArgument); -begin - UdfDateTimeTo(AArgument, 'YYYYMMDD'); -end; - -procedure TtiRtfParser.UdfDateToStr(AArgument: TRtfArgument); -begin - UdfDateTimeTo(AArgument, ShortDateFormat); -end; - -procedure TtiRtfParser.UdfTimeToStr(AArgument: TRtfArgument); -begin - UdfDateTimeTo(AArgument, ShortTimeFormat); -end; - -procedure TtiRtfParser.UdfDateTimeToStr(AArgument: TRtfArgument); -begin - UdfDateTimeTo(AArgument, ShortDateFormat + ' ' + ShortTimeFormat); -end; - -procedure TtiRtfParser.UdfStrToDate(AArgument: TRtfArgument); -begin - if not AArgument.Check(0,[etLitString]) then - raise TRtfException.Create(rsUnexpectedParameterType); - AArgument.Token := etLitString; - AArgument.Value := StrToDate(AArgument[0].Value); -end; - -procedure TtiRtfParser.UdfStrToTime(AArgument: TRtfArgument); -begin - if not AArgument.Check(0,[etLitString]) - then raise TRtfException.Create(rsUnexpectedParameterType); - AArgument.Token := etLitString; - AArgument.Value := StrToTime(AArgument[0].Value); -end; - -procedure TtiRtfParser.UdfStrToDateTime(AArgument: TRtfArgument); -begin - if not AArgument.Check(0,[etLitString]) - then raise TRtfException.Create(rsUnexpectedParameterType); - AArgument.Token := etLitString; - AArgument.Value := StrToDateTime(AArgument[0].Value); -end; - -procedure TtiRtfParser.UdfFormatFloat(AArgument: TRtfArgument); -var AFormat: string; - AFloat: Double; -begin - if not AArgument.Check([[etLitString],[etLitFloat, etLitInt]]) then - raise TRtfException.Create(rsUnexpectedParameterType); - AFormat := AArgument[0].Value; - AFloat := AArgument[1].Value; - AArgument.Token := etLitString; - AArgument.Value := FormatFloat(AFormat, AFloat); -end; - -procedure TtiRtfParser.UdfFBool(AArgument: TRtfArgument); -begin - if not AArgument.Check(0,[etLitFalse, etLitTrue]) then - raise TRtfException.Create(rsUnexpectedParameterType); - if AArgument[0].Token = etLitFalse then - begin - AArgument.Token := etLitString; - AArgument.Value := BoolFalse; - end else begin - AArgument.Token := etLitString; - AArgument.Value := BoolTrue; - end; -end; - -procedure TtiRtfParser.UdfPicture(AArgument: TRtfArgument); -{ -var - APicture: TPicture; - AFilename: string; -} -begin -(* - if not AArgument.Check(0,[etLitString]) - then raise TRtfException.Create(rsUnexpectedParameterType); - APicture := TPicture.Create; - try - AFilename := AArgument[0].Value; - if Assigned(OnPicturePath) - then OnPicturePath(AFilename); - - APicture.LoadFromFile(AFilename); - if not Assigned(APicture.Graphic)or APicture.Graphic.Empty then begin - AArgument.Token := etNothing; - AArgument.Value := varEmpty; - end else begin - AArgument.Value := AArgument.GetPicture(APicture); - AArgument.Token := etLitString; - end; - finally - APicture.Free; - end; - *) -end; - -procedure TtiRtfParser.UdfDbPicture(AArgument: TRtfArgument); -//Since a simple blob (not ftGraphic field) can contain an image -//It has become kind of a typecast for a dataset field. -var ADataset: TRtfDataset; - AFieldName: string; -begin - if not AArgument.Check(0,[etFieldName]) then - raise TRtfException.Create(rsUnexpectedParameterType); - ADataset := Datasets.Find(AArgument[0].Value, AFieldName); - if not Assigned(ADataset) then //There should be at least a table reference. - raise TRtfException.Create('Dataset not found'); - AArgument.GetGraphicsValue(ADataset, AFieldName); -end; - -end. - diff --git a/extras/tiopf/tiOPFfpGUI.lpk b/extras/tiopf/tiOPFfpGUI.lpk deleted file mode 100644 index 1a93652d..00000000 --- a/extras/tiopf/tiOPFfpGUI.lpk +++ /dev/null @@ -1,95 +0,0 @@ -<?xml version="1.0"?> -<CONFIG> - <Package Version="3"> - <Name Value="tiOPFfpGUI"/> - <AddToProjectUsesSection Value="False"/> - <Author Value="Graeme Geldenhuys"/> - <CompilerOptions> - <Version Value="8"/> - <SearchPaths> - <OtherUnitFiles Value="gui/"/> - <UnitOutputDirectory Value="../../lib/$(TargetCPU)-$(TargetOS)"/> - </SearchPaths> - <Parsing> - <SyntaxOptions> - <CStyleOperator Value="False"/> - </SyntaxOptions> - </Parsing> - <Other> - <CustomOptions Value="-dLINK_CSV --dLINK_TAB --dLINK_FBLx --dLINK_SQLDB_IB --dLINK_SQLDB_PQx --dLINK_SQLDB_Oraclex --dLINK_SQLDB_SQLLite3x --dLINK_SQLDB_ODBCx --dLINK_SQLDB_MySQL40x --dLINK_SQLDB_MySQL41x --dLINK_SQLDB_MySQL50x --dLINK_XMLLIGHTx --dLINK_ZEOS_FB15x --dUseCThreads --Xd -"/> - <CompilerPath Value="$(CompPath)"/> - </Other> - </CompilerOptions> - <Description Value="tiOPF GUI layer - visual units -"/> - <License Value="Mozilla Public License v1.1 -"/> - <Version Major="2" Release="5"/> - <Files Count="8"> - <Item1> - <Filename Value="gui/tiGUIUtils.pas"/> - <UnitName Value="tiGUIUtils"/> - </Item1> - <Item2> - <Filename Value="gui/tiDialogs.pas"/> - <UnitName Value="tiDialogs"/> - </Item2> - <Item3> - <Filename Value="gui/tiGUIINI.pas"/> - <UnitName Value="tiGUIINI"/> - </Item3> - <Item4> - <Filename Value="gui/tiGUIConstants.pas"/> - <UnitName Value="tiGUIConstants"/> - </Item4> - <Item5> - <Filename Value="gui/tiRtfReport.pas"/> - <UnitName Value="tiRtfReport"/> - </Item5> - <Item6> - <Filename Value="gui/tiMediators.pas"/> - <UnitName Value="tiMediators"/> - </Item6> - <Item7> - <Filename Value="gui/tiListMediators.pas"/> - <UnitName Value="tiListMediators"/> - </Item7> - <Item8> - <Filename Value="gui/tiLogToGUI.pas"/> - <UnitName Value="tiLogToGUI"/> - </Item8> - </Files> - <RequiredPkgs Count="2"> - <Item1> - <PackageName Value="fpgui_toolkit"/> - <MinVersion Minor="6" Release="2" Valid="True"/> - </Item1> - <Item2> - <PackageName Value="tiOPF"/> - <MinVersion Major="2" Release="3" Valid="True"/> - </Item2> - </RequiredPkgs> - <UsageOptions> - <UnitPath Value="$(PkgOutDir)/"/> - </UsageOptions> - <PublishOptions> - <Version Value="2"/> - <IgnoreBinaries Value="False"/> - </PublishOptions> - </Package> -</CONFIG> diff --git a/extras/tiopf/tiOPFfpGUI.pas b/extras/tiopf/tiOPFfpGUI.pas deleted file mode 100644 index 331a463b..00000000 --- a/extras/tiopf/tiOPFfpGUI.pas +++ /dev/null @@ -1,15 +0,0 @@ -{ This file was automatically created by Lazarus. do not edit! - This source is only used to compile and install the package. - } - -unit tiOPFfpGUI; - -interface - -uses - tiGUIUtils, tiDialogs, tiGUIINI, tiGUIConstants, tiRtfReport, tiMediators, - tiListMediators, tiLogToGUI; - -implementation - -end. |