diff options
author | graemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf> | 2008-04-16 13:54:58 +0000 |
---|---|---|
committer | graemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf> | 2008-04-16 13:54:58 +0000 |
commit | 4c4961209a1848270721d8a3088410a366e53d5e (patch) | |
tree | bd92c4a0ad63ec3e1a54d8f4553cf36b4b431e98 /extras | |
parent | e9742fc1f660b4dc4e7cc028f662e6f06c155ab7 (diff) | |
download | fpGUI-4c4961209a1848270721d8a3088410a366e53d5e.tar.xz |
* Implememented more parts of the new MVP framework for tiOPF and fpGUI.
Diffstat (limited to 'extras')
-rw-r--r-- | extras/tiopf/mvp/basic_impl.pas | 298 | ||||
-rw-r--r-- | extras/tiopf/mvp/basic_intf.pas | 114 | ||||
-rw-r--r-- | extras/tiopf/mvp/fpgui_intf.pas | 22 | ||||
-rw-r--r-- | extras/tiopf/mvp/gg_mvp.lpk | 8 | ||||
-rw-r--r-- | extras/tiopf/mvp/gg_mvp.pas | 2 |
5 files changed, 376 insertions, 68 deletions
diff --git a/extras/tiopf/mvp/basic_impl.pas b/extras/tiopf/mvp/basic_impl.pas index e855a726..791f16e0 100644 --- a/extras/tiopf/mvp/basic_impl.pas +++ b/extras/tiopf/mvp/basic_impl.pas @@ -25,28 +25,6 @@ type end; - TListModel = class(TInterfacedObject, IListModel, ISubject) - private - fItems: IInterfaceList; - fSubject: ISubject; - protected - property Items: IInterfaceList read fItems; - // IListModel - function GetCount: Integer; - function GetItem(Idx: Integer): IInterface; - procedure Add(Item: IInterface); - procedure Clear; - procedure Insert(Item, Before: IInterface); - procedure Move(Item, Before: IInterface); - procedure Remove(Item: IInterface); - // ISubject - property Subject: ISubject read FSubject implements ISubject; - public - constructor Create; virtual; - destructor Destroy; override; - end; - - TString = class(TInterfacedObject, IString, IVisited) private fString: string; @@ -58,13 +36,6 @@ type end; - TStringListModel = class(TListModel, IStringListModel) - private - // IStringListModel - function GetItem(Idx: Integer): IString; - end; - - TStringSelection = class(TInterfacedObject, ISelection, IVisited) private fModel: IStringListModel; @@ -72,6 +43,7 @@ type // ISelection procedure AddItem(const Item: IInterface); procedure Clear; + function GetCount: integer; procedure RemoveItem(const Item: IInterface); procedure SelectModel; // IVisited @@ -81,6 +53,98 @@ type end; + TCommand = class(TInterfacedObject, ICommand, IVisited) + private + fSelection: ISelection; + procedure BindSelection(const Selection: ISelection); + protected + // IVisited + procedure Accept(const Visitor: IVisitor); virtual; + // ICommand + function Execute: Boolean; virtual; abstract; + function GetEnabled: Boolean; virtual; abstract; + function GetText: string; virtual; abstract; + end; + + + TCommandSet = class(TInterfacedObject, ICommandSet, IObserver, ISubject, IVisited) + private + fItems: IInterfaceList; + fSubject: ISubject; + function GetCount: integer; + // IVisited + procedure Accept(const Visitor: IVisitor); + protected + property Count: integer read GetCount; + property Items: IInterfaceList read fItems; + // IObserver + procedure Update(Subject: IInterface); + // ISubject + property Subject: ISubject read fSubject implements ISubject; + public + constructor Create; virtual; + end; + + + TMVPModel = class(TInterfacedObject, IMVPModel, ISubject) + private + fCommandSet: ICommandSet; + fCurrentSelection: ISelection; + fSubject: ISubject; + // IMVPModel + function GetCommandSet: ICommandSet; + function GetCurrentSelection: ISelection; + protected + property CommandSet: ICommandSet read GetCommandSet; + property CurrentSelection: ISelection read GetCurrentSelection; + // 3 methods to be called by the constructor + procedure BindSelection; virtual; + procedure CreateCommandSet(var ACommandSet: ICommandSet); virtual; abstract; + procedure CreateSelection(var ASelection: ISelection); virtual; abstract; + // ISubject + property Subject: ISubject read fSubject implements ISubject; + public + constructor Create; virtual; + destructor Destroy; override; + end; + + + TListModel = class(TMVPModel, IListModel) + private + fItems: IInterfaceList; + protected + property Items: IInterfaceList read fItems; + // IListModel + function GetCount: Integer; virtual; + function GetItem(Idx: Integer): IInterface; virtual; + procedure Add(const Item: IInterface); virtual; + procedure Clear; virtual; + function IndexOf(const Item: IInterface): Integer; virtual; + procedure Insert(const Item, Before: IInterface); virtual; + procedure Move(const Item, Before: IInterface); virtual; + procedure Remove(const Item: IInterface); virtual; + public + destructor Destroy; override; + end; + + + TStringListModel = class(TListModel, IStringListModel, IVisited) + private + // IStringListModel + function IStringListModel.GetItem = StringListModelGetItem; + function StringListModelGetItem(Idx: Integer): IString; + // IVisited + procedure Accept(const Visitor: IVisitor); virtual; + protected + // IMVPModel + procedure CreateCommandSet(var ACommandSet: ICommandSet); override; + procedure CreateSelection(var ASelection: ISelection); override; + public + destructor Destroy; override; + end; + + + implementation @@ -149,50 +213,79 @@ begin Result := fItems[Idx]; end; -procedure TListModel.Add(Item: IInterface); +procedure TListModel.Add(const Item: IInterface); begin - fSubject.BeginUpdate; + Subject.BeginUpdate; + if fItems = nil then + fItems := TInterfaceList.Create; +// fItems.Add(Item as IInterface); fItems.Add(Item); - fSubject.EndUpdate; + Subject.EndUpdate; end; procedure TListModel.Clear; begin - fSubject.BeginUpdate; + Subject.BeginUpdate; fItems.Clear; - fSubject.EndUpdate; + Subject.EndUpdate; end; -procedure TListModel.Insert(Item, Before: IInterface); +function TListModel.IndexOf(const Item: IInterface): Integer; begin - fSubject.BeginUpdate; - fItems.Insert(fItems.IndexOf(Before), Item); - fSubject.EndUpdate; + if fItems <> nil then +// Result := fItems.IndexOf(Item as IInterface) + Result := fItems.IndexOf(Item) + else + Result := -1; end; -procedure TListModel.Move(Item, Before: IInterface); +procedure TListModel.Insert(const Item, Before: IInterface); var - IndexOfBefore: integer; + InsertIdx: integer; begin - fSubject.BeginUpdate; - IndexOfBefore := fItems.IndexOf(Before); - if IndexOfBefore < 0 then - IndexOfBefore := 0; - fItems.Delete(fItems.IndexOf(Item)); - fItems.Insert(IndexOfBefore, Item); - fSubject.EndUpdate; + if fItems = nil then + fItems := TInterfaceList.Create; + if fItems.IndexOf(Item) < 0 then + begin + Subject.BeginUpdate; + InsertIdx := fItems.IndexOf(Before); + if InsertIdx < 0 then + InsertIdx := 0; + fItems.Insert(InsertIdx, Item); + Subject.EndUpdate; + end; end; -procedure TListModel.Remove(Item: IInterface); +procedure TListModel.Move(const Item, Before: IInterface); +var + IdxItem: integer; + IdxBefore: integer; + MoveItem: IInterface; begin - fSubject.BeginUpdate; - fItems.Delete(fItems.IndexOf(Item)); - fSubject.EndUpdate; + if fItems <> nil then + begin + IdxItem := fItems.IndexOf(Item); + if IdxItem >= 0 then + begin + Subject.BeginUpdate; + MoveItem := fItems[IdxItem]; + fItems.Delete(IdxItem); + IdxBefore := fItems.IndexOf(Before); + if IdxBefore >0 then + fItems.Insert(IdxBefore, MoveItem); + Subject.EndUpdate; + end; + end; { if } end; -constructor TListModel.Create; +procedure TListModel.Remove(const Item: IInterface); begin - inherited Create; + if fItems <> nil then + begin + Subject.BeginUpdate; + fItems.Remove(Item); + Subject.EndUpdate; + end; end; destructor TListModel.Destroy; @@ -219,11 +312,31 @@ end; { TStringListModel } -function TStringListModel.GetItem(Idx: Integer): IString; +function TStringListModel.StringListModelGetItem(Idx: Integer): IString; begin Result := Items[Idx] as IString; end; +procedure TStringListModel.Accept(const Visitor: IVisitor); +begin + +end; + +procedure TStringListModel.CreateCommandSet(var ACommandSet: ICommandSet); +begin + +end; + +procedure TStringListModel.CreateSelection(var ASelection: ISelection); +begin + +end; + +destructor TStringListModel.Destroy; +begin + inherited Destroy; +end; + { TStringSelection } procedure TStringSelection.AddItem(const Item: IInterface); @@ -239,6 +352,11 @@ begin end; +function TStringSelection.GetCount: integer; +begin + Result := fItems.Count; +end; + procedure TStringSelection.RemoveItem(const Item: IInterface); begin if fItems <> nil then @@ -272,5 +390,77 @@ begin fModel := Model; end; +{ TCommand } + +procedure TCommand.BindSelection(const Selection: ISelection); +begin + fSelection := Selection; +end; + +procedure TCommand.Accept(const Visitor: IVisitor); +begin + (Visitor as ICommandVisitor).VisitComand(self); +end; + +{ TCommandSet } + +function TCommandSet.GetCount: integer; +begin + if fItems <> nil then + Result := fItems.Count + else + Result := 0; +end; + +procedure TCommandSet.Accept(const Visitor: IVisitor); +var + i: integer; +begin + for i := 0 to fItems.Count-1 do + (fItems[i] as IVisited).Accept(Visitor); +end; + +procedure TCommandSet.Update(Subject: IInterface); +begin + // do nothing yet +end; + +constructor TCommandSet.Create; +begin + inherited Create; + fItems := TInterfaceList.Create; +end; + +{ TMVPModel } + +function TMVPModel.GetCommandSet: ICommandSet; +begin + Result := fCommandSet; +end; + +function TMVPModel.GetCurrentSelection: ISelection; +begin + Result := fCurrentSelection; +end; + +procedure TMVPModel.BindSelection; +begin + (fCurrentSelection as ISubject).Attach(fCommandSet as IObserver); +end; + +constructor TMVPModel.Create; +begin + inherited Create; + fSubject := TSubject.Create(self); + CreateSelection(fCurrentSelection); + CreateCommandSet(fCommandSet); + BindSelection; +end; + +destructor TMVPModel.Destroy; +begin + inherited Destroy; +end; + end. diff --git a/extras/tiopf/mvp/basic_intf.pas b/extras/tiopf/mvp/basic_intf.pas index efe58d4a..1d1aad80 100644 --- a/extras/tiopf/mvp/basic_intf.pas +++ b/extras/tiopf/mvp/basic_intf.pas @@ -7,6 +7,13 @@ interface type // forward declarations ISubject = interface; + IMVPView = interface; + ICommandMenuItem = interface; + IString = interface; + + + // event types + TSelectStringEvent = procedure(const AString: IString) of object; IObserver = interface(IInterface) @@ -34,23 +41,23 @@ type ['{7CF62F51-9412-445C-9E8C-DE94F2B1E280}'] procedure Accept(const Visitor: IVisitor); end; - IListModel = interface(IInterface) ['{1A772375-1263-4790-8827-F7BEA358674A}'] function GetCount: Integer; function GetItem(Idx: Integer): IInterface; - procedure Add(Item: IInterface); + procedure Add(const Item: IInterface); procedure Clear; - procedure Insert(Item, Before: IInterface); - procedure Move(Item, Before: IInterface); - procedure Remove(Item: IInterface); + function IndexOf(const Item: IInterface): Integer; + procedure Insert(const Item, Before: IInterface); + procedure Move(const Item, Before: IInterface); + procedure Remove(const Item: IInterface); property Count: Integer read GetCount; property Item[Idx: Integer]: IInterface read GetItem; end; -{ - + +(* IController = interface(IInterface) ['{4A99C01A-D025-4562-8E94-3A0C873CE894}'] function GetModel: IModel; @@ -60,7 +67,7 @@ type property Model: IModel read GetModel write SetModel; property View: IView read GetView write SetView; end; -} +*) IString = interface(IInterface) ['{E76984A4-1287-4353-8370-A7332B9FB1CB}'] @@ -70,9 +77,9 @@ type end; - IStringListModel = interface(IInterface) + IStringListModel = interface(IListModel) ['{769804CD-89E4-43C7-B8EF-783BFE27214E}'] - function GetItem(Idx: Integer): IString; + function GetItem(Idx: Integer): IString; overload; property Item[Idx: Integer]: IString read GetItem; end; @@ -81,8 +88,9 @@ type ['{F4DDA0EA-E982-4785-8602-5B32E8DD6DA2}'] procedure AddItem(const Item: IInterface); procedure Clear; + function GetCount: integer; procedure RemoveItem(const Item: IInterface); - procedure SelectModel; + property Count: integer read GetCount; end; @@ -90,7 +98,9 @@ type ['{B333C7E1-B124-4D08-A640-DC02F36264C7}'] procedure BindSelection(const Selection: ISelection); function Execute: Boolean; + function GetEnabled: Boolean; function GetText: string; + property Enabled: Boolean read GetEnabled; property Text: string read GetText; end; @@ -100,6 +110,88 @@ type // empty interface end; + + ICommandVisitor = interface(IVisitor) + ['{628B3A4A-30D1-48D3-8B46-090F08AD2AC8}'] + procedure VisitComand(const Command: ICommand); + end; + + + ICommandMenu = interface(IInterface) + ['{3C666D8F-6BED-454B-8BFE-28422943B300}'] + function AddItem(const Caption: string; Enabled: Boolean): ICommandMenuItem; + end; + + + ICommandMenuItem = interface(IInterface) + ['{7DFCF2BD-70DA-4DAC-B8D5-C6FB882267CF}'] + function GetCaption: string; + function GetChecked: Boolean; + function GetCommand: ICommand; + procedure SetCaption(const AValue: string); + procedure SetChecked(const AValue: Boolean); + procedure SetCommand(const AValue: ICommand); + property Caption: string read GetCaption write SetCaption; + property Checked: Boolean read GetChecked write SetChecked; + property Command: ICommand read GetCommand write SetCommand; + end; + + + IStringVisitor = interface(IVisitor) + ['{DA12355F-0727-41B3-9080-DDAF20797FC5}'] + procedure VisitString(const Str: IString); + end; + + + IMVPModel = interface(IInterface) + ['{85223140-B263-4413-89E3-BFA37E9D3112}'] + function GetCommandSet: ICommandSet; + function GetCurrentSelection: ISelection; + property CommandSet: ICommandSet read GetCommandSet; + property CurrentSelection: ISelection read GetCurrentSelection; + end; + + + IMVPPresenter = interface(IInterface) + ['{5B8477DA-A006-4DE1-B304-9512BFAD7507}'] + function GetCommandMenu: ICommandMenu; + function GetModel: IMVPModel; + function GetView: IMVPView; + procedure SetCommandMenu(const AValue: ICommandMenu); + procedure SetModel(const AValue: IMVPModel); + procedure SetView(const AValue: IMVPView); + property CommandMenu: ICommandMenu read GetCommandMenu write SetCommandMenu; + property Model: IMVPModel read GetModel write SetModel; + property View: IMVPView read GetView write SetView; + end; + + + IMVPView = interface(IInterface) + ['{2C575FE7-BACD-46EC-9D72-AEDA44836B20}'] + procedure AdoptCommandMenu(const Value: ICommandMenu); + procedure OrphanCommandMenu(const Value: ICommandMenu); + end; + + + IStringListView = interface(IMVPView) + ['{D834710A-9C1A-42D1-A29B-7F9F8FB46426}'] + function GetOnSelectString: TSelectStringEvent; + procedure SetOnSelectString(const AValue: TSelectStringEvent); + property OnSelectString: TSelectStringEvent read GetOnSelectString write SetOnSelectString; + end; + + + IStringMoveVisitor = interface(IStringVisitor) + ['{DB89C96F-DA90-43ED-A621-51B70E6C600E}'] + function GetCanDemote: Boolean; + function GetCanPromote: Boolean; + property CanDemote: Boolean read GetCanDemote; + property CanPromote: Boolean read GetCanPromote; + end; + + + + implementation diff --git a/extras/tiopf/mvp/fpgui_intf.pas b/extras/tiopf/mvp/fpgui_intf.pas new file mode 100644 index 00000000..f6e9e4ca --- /dev/null +++ b/extras/tiopf/mvp/fpgui_intf.pas @@ -0,0 +1,22 @@ +unit fpgui_intf; + +{$mode objfpc}{$H+} + +interface + +uses + gui_menu, basic_intf; + +type + + IPopupCommandMenu = interface(IInterface) + ['{812C1940-A8BD-4BB4-AE8D-37A912D44A6D}'] + function GetMenu: TfpgPopupMenu; + procedure SetMenu(const AValue: TfpgPopupMenu); + property Menu: TfpgPopupMenu read GetMenu write SetMenu; + end; + +implementation + +end. + diff --git a/extras/tiopf/mvp/gg_mvp.lpk b/extras/tiopf/mvp/gg_mvp.lpk index 74080b5c..3c335171 100644 --- a/extras/tiopf/mvp/gg_mvp.lpk +++ b/extras/tiopf/mvp/gg_mvp.lpk @@ -5,7 +5,7 @@ <CompilerOptions> <Version Value="5"/> <SearchPaths> - <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)/"/> + <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> <Generate Value="Faster"/> @@ -14,7 +14,7 @@ <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> - <Files Count="3"> + <Files Count="4"> <Item1> <Filename Value="basic_intf.pas"/> <UnitName Value="basic_intf"/> @@ -27,6 +27,10 @@ <Filename Value="view_impl.pas"/> <UnitName Value="view_impl"/> </Item3> + <Item4> + <Filename Value="fpgui_intf.pas"/> + <UnitName Value="fpgui_intf"/> + </Item4> </Files> <Type Value="RunAndDesignTime"/> <RequiredPkgs Count="2"> diff --git a/extras/tiopf/mvp/gg_mvp.pas b/extras/tiopf/mvp/gg_mvp.pas index 8a19fe85..c8981b1a 100644 --- a/extras/tiopf/mvp/gg_mvp.pas +++ b/extras/tiopf/mvp/gg_mvp.pas @@ -7,7 +7,7 @@ unit gg_mvp; interface uses - basic_intf, basic_impl, view_impl, LazarusPackageIntf; + basic_intf, basic_impl, view_impl, fpgui_intf, LazarusPackageIntf; implementation |