diff options
Diffstat (limited to 'extras')
7 files changed, 682 insertions, 4 deletions
diff --git a/extras/tiopf/demos/Common/Constants.pas b/extras/tiopf/demos/Common/Constants.pas index 6c93719d..9820ae5e 100644 --- a/extras/tiopf/demos/Common/Constants.pas +++ b/extras/tiopf/demos/Common/Constants.pas @@ -6,7 +6,7 @@ interface const cNameMissing = 'Please enter a name'; - cAgeOutofRange = 'Please enter a valid age'; + cAgeOutofRange = 'Please enter a valid age between 1 - 100'; implementation diff --git a/extras/tiopf/demos/Common/Model.pas b/extras/tiopf/demos/Common/Model.pas index 148f94b9..3f2c048c 100644 --- a/extras/tiopf/demos/Common/Model.pas +++ b/extras/tiopf/demos/Common/Model.pas @@ -17,6 +17,18 @@ 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 @@ -24,16 +36,19 @@ type 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; 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; @@ -53,7 +68,7 @@ type procedure Add(const pObject: TPerson); reintroduce; end; - + function GeneratePersonList: TPersonList; @@ -104,7 +119,7 @@ begin if Name = '' then pErrors.AddError('Name', cNameMissing); - if Age < 1 then + if (Age < 1) or (Age > 100) then pErrors.AddError('Age', cAgeOutofRange); Result := pErrors.Count = 0; @@ -130,6 +145,18 @@ begin // 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; @@ -163,6 +190,17 @@ 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; diff --git a/extras/tiopf/demos/Common/Model_View.pas b/extras/tiopf/demos/Common/Model_View.pas index 7cc68e8a..82a9027b 100644 --- a/extras/tiopf/demos/Common/Model_View.pas +++ b/extras/tiopf/demos/Common/Model_View.pas @@ -14,11 +14,23 @@ uses ; type - { TEdit - Name } + { TfpgEdit - Name } TPerson_Name_TextEdit_View = class(TMediatorEditView) + private + procedure OnTextChanged(Sender: TObject); protected procedure SetupGUIandObject; override; end; + + { TfpgEdit - Age } + TPerson_Age_TextEdit_View = class(TMediatorEditView) + private + procedure OnTextChanged(Sender: TObject); + protected + procedure SetupGUIandObject; override; + procedure GuiToObject; override; + procedure ObjectToGui; override; + end; { TSpinEdit - Age } @@ -66,14 +78,22 @@ type implementation +uses + Model, SysUtils; { TPersonNameView } +procedure TPerson_Name_TextEdit_View.OnTextChanged(Sender: TObject); +begin + GUIChanged; +end; + procedure TPerson_Name_TextEdit_View.SetupGUIandObject; begin inherited; { The Name field my only contain 25 characters max. } EditControl.MaxLength := 25; + EditControl.OnChange := @OnTextChanged; end; @@ -133,6 +153,34 @@ begin EditControl.Max := 100; end; +{ TPerson_Age_TextEdit_View } + +procedure TPerson_Age_TextEdit_View.OnTextChanged(Sender: TObject); +begin + GUIChanged; +end; + +procedure TPerson_Age_TextEdit_View.SetupGUIandObject; +begin + inherited SetupGUIandObject; + EditControl.MaxLength := 3; + EditControl.OnChange := @OnTextChanged; +end; + +procedure TPerson_Age_TextEdit_View.GuiToObject; +begin + inherited GuiToObject; + // manual example without RTTI +// TPerson(Subject).Age := StrToInt(EditControl.Text); +end; + +procedure TPerson_Age_TextEdit_View.ObjectToGui; +begin + inherited ObjectToGui; + // manual example without RTTI +// EditControl.Text := IntToStr(TPerson(Subject).Age); +end; + initialization {----------------------------------------------------------------------------- Register all your Mediator Views here diff --git a/extras/tiopf/demos/StringGridMediatorDemo/frm_main.pas b/extras/tiopf/demos/StringGridMediatorDemo/frm_main.pas new file mode 100644 index 00000000..9f49f8d3 --- /dev/null +++ b/extras/tiopf/demos/StringGridMediatorDemo/frm_main.pas @@ -0,0 +1,278 @@ +unit frm_main; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, Classes, gfxbase, fpgfx, gui_edit, + gfx_widget, gui_form, gui_label, gui_button, + gui_basegrid, gui_grid, gui_menu, + gui_panel, gui_popupcalendar, gui_gauge, model, tiCompositeMediators; + +type + + TMainForm = class(TfpgForm) + private + FList: TPersonList; + medGrid: TCompositeStringGridMediator; + 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 + gui_dialogs, frm_personmaint; + +{@VFD_NEWFORM_IMPL} + +procedure TMainForm.SetupMediators; +begin + medGrid := TCompositeStringGridMediator.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); +begin + +end; + +procedure TMainForm.btnEditClicked(Sender: TObject); +begin + EditPerson(TPerson(medGrid.SelectedObject)); +end; + +procedure TMainForm.btnDeleteClicked(Sender: TObject); +begin + +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; + 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 new file mode 100644 index 00000000..00296e96 --- /dev/null +++ b/extras/tiopf/demos/StringGridMediatorDemo/frm_personmaint.pas @@ -0,0 +1,194 @@ +unit frm_personmaint; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, Classes, gfxbase, fpgfx, gui_edit, + gfx_widget, gui_form, gui_label, gui_button, + gui_listbox, gui_memo, gui_combobox, gui_basegrid, gui_grid, + gui_dialogs, gui_checkbox, gui_tree, gui_trackbar, + gui_progressbar, gui_radiobutton, gui_tab, gui_menu, + gui_panel, gui_popupcalendar, gui_gauge, 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 new file mode 100644 index 00000000..44c3c915 --- /dev/null +++ b/extras/tiopf/demos/StringGridMediatorDemo/stringgridmediatordemo.lpi @@ -0,0 +1,90 @@ +<?xml version="1.0"?> +<CONFIG> + <ProjectOptions> + <PathDelim Value="/"/> + <Version Value="6"/> + <General> + <Flags> + <SaveOnlyProjectUnits Value="True"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <IconPath Value="./"/> + <TargetFileExt Value=""/> + </General> + <VersionInfo> + <ProjectVersion Value=""/> + </VersionInfo> + <PublishOptions> + <Version Value="2"/> + <IgnoreBinaries Value="False"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + </local> + </RunParams> + <RequiredPackages Count="2"> + <Item1> + <PackageName Value="tiOPFfpGUI"/> + </Item1> + <Item2> + <PackageName Value="fpgui_package"/> + </Item2> + </RequiredPackages> + <Units Count="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="5"/> + <SearchPaths> + <OtherUnitFiles Value="../Common/"/> + </SearchPaths> + <CodeGeneration> + <Generate Value="Faster"/> + </CodeGeneration> + <Linking> + <Debugging> + <GenerateDebugInfo Value="True"/> + </Debugging> + </Linking> + <Other> + <CustomOptions Value="-FUunits +"/> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> +</CONFIG> diff --git a/extras/tiopf/demos/StringGridMediatorDemo/stringgridmediatordemo.lpr b/extras/tiopf/demos/StringGridMediatorDemo/stringgridmediatordemo.lpr new file mode 100644 index 00000000..2a0a31e3 --- /dev/null +++ b/extras/tiopf/demos/StringGridMediatorDemo/stringgridmediatordemo.lpr @@ -0,0 +1,30 @@ +program stringgridmediatordemo; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Classes, fpgfx, 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. + |