diff options
author | graemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf> | 2008-08-22 14:52:49 +0000 |
---|---|---|
committer | graemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf> | 2008-08-22 14:52:49 +0000 |
commit | 24c78a01ed317848c744be6e9e7dc42ab9335ee4 (patch) | |
tree | 9eae0af5db41d0161c057fa08291546e30d18058 | |
parent | 8b8e6e91c58d73b8bd543433f789c43d062fd10a (diff) | |
download | fpGUI-24c78a01ed317848c744be6e9e7dc42ab9335ee4.tar.xz |
* Added Michael new refactored and improved MGM implementation.
* Removed the old units from the tiOPFfpGUI.lpk package and added new units. I did not delete the old mediator units yet.
-rw-r--r-- | extras/tiopf/gui/tiListMediators.pas | 551 | ||||
-rw-r--r-- | extras/tiopf/gui/tiMediators.pas | 690 | ||||
-rw-r--r-- | extras/tiopf/tiOPFfpGUI.lpk | 22 | ||||
-rw-r--r-- | extras/tiopf/tiOPFfpGUI.pas | 8 |
4 files changed, 1254 insertions, 17 deletions
diff --git a/extras/tiopf/gui/tiListMediators.pas b/extras/tiopf/gui/tiListMediators.pas new file mode 100644 index 00000000..257f72fc --- /dev/null +++ b/extras/tiopf/gui/tiListMediators.pas @@ -0,0 +1,551 @@ +{ + 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 + ,Contnrs { TObjectList } + ,gui_listview { TfpgListView } + ,gui_grid { TfpgStringGrid } + ,tiObject + ; + + +type + + { Composite mediator for TfpgListView } + TListViewMediator = class(TCustomListMediator) + private + FObserversInTransit: TList; + FView: TfpgListView; + procedure SetView(const AValue: TfpgListView); + protected + function GetSelectedObject: TtiObject; override; + procedure SetSelectedObject(const AValue: TtiObject);override; + procedure CreateColumns; override; + procedure DoCreateItemMediator(AData: TtiObject; ARowIdx : Integer); override; + Function GetGuiControl : TComponent; override; + Procedure SetGuiControl (Const AValue : TComponent); override; + procedure SetupGUIandObject; override; + procedure RebuildList; override; + public + constructor CreateCustom(AModel: TtiObjectList; AView: TfpgListView; ADisplayNames: string; AIsObserving: Boolean = True); overload; + constructor CreateCustom(AModel: TtiObjectList; AView: TfpgListView; AOnBeforeSetupField: TOnBeforeSetupField; ADisplayNames: string; AIsObserving: Boolean = True); overload; + class function ComponentClass: TClass; virtual; + Constructor Create; override; + Destructor Destroy; override; + { Called from the GUI to trigger events } + procedure HandleSelectionChanged; virtual; + { Event handler to allow formatting of fields before they are written. } + published + property View: TfpgListView read FView Write SetView; + end; + + + // for backwards compatibility + TCompositeListViewMediator = TListViewMediator; + + + { Composite mediator for TfpgStringGrid } + TStringGridMediator = class(TCustomListMediator) + private + FView: TfpgStringGrid; + procedure DoCreateItemMediator(AData: TtiObject; ARowIdx : Integer); override; + procedure SetView(const AValue: TfpgStringGrid); + protected + function GetSelectedObject: TtiObject; override; + procedure SetSelectedObject(const AValue: TtiObject);override; + procedure CreateColumns; override; + Function GetGuiControl : TComponent; override; + Procedure SetGuiControl (Const AValue : TComponent); override; + procedure SetupGUIandObject; override; + procedure RebuildList;override; + public + constructor CreateCustom(AModel: TtiObjectList; AGrid: TfpgStringGrid; ADisplayNames: string; AIsObserving: Boolean = True); + class function ComponentClass: TClass; virtual; + published + property View: TfpgStringGrid read FView Write SetView; + property SelectedObject: TtiObject read GetSelectedObject write SetSelectedObject; + end; + + + // for backwards compatibility + TCompositeStringGridMediator = TStringGridMediator; + + + { Used internally for sub-mediators in ListView mediator. Moved to interface + section so it can be overridden. } + TListViewListItemMediator = class(TListItemMediator) + private + FView: TfpgLVItem; + procedure SetupFields; virtual; + public + constructor CreateCustom(AModel: TtiObject; AView: TfpgLVItem; const AFieldsInfo : TtiMediatorFieldInfoList; IsObserving: Boolean = True); + constructor CreateCustom(AModel: TtiObject; AView: TfpgLVItem; AOnBeforeSetupField: TOnBeforeSetupField; const AFieldsInfo : TtiMediatorFieldInfoList; IsObserving: Boolean = True); 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. } + TStringGridRowMediator = class(TListItemMediator) + 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; + + +implementation + +uses + tiUtils + ,typinfo + ,tiExcept + ; + + +{ --------------------------------------------------------------------- + ListView + --------------------------------------------------------------------- } + +{ TListViewMediator } + +procedure TListViewMediator.SetView(const AValue: TfpgListView); +begin + FView:=AValue; + SetGUIControl(AValue); +end; + +function TListViewMediator.GetGuiControl: TComponent; +begin + Result:=FView; +end; + +procedure TListViewMediator.SetGuiControl(const AValue: TComponent); +begin + FView:=AValue as TfpgListView; + inherited SetGuiControl(AValue); +end; + +procedure TListViewMediator.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 TListViewMediator.GetSelectedObject: TtiObject; +begin +// if FView.SelCount = 0 then + if FView.ItemIndex = -1 then + Result := nil + else +// FSelectedObject := TtiObject(FView.Selected.Data); + Result := TtiObject(FView.Items.Item[FView.ItemIndex].UserData); +end; + + +procedure TListViewMediator.DoCreateItemMediator(AData: TtiObject; ARowIdx : Integer); +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, OnBeforeSetupField, FieldsInfo, Active); + MediatorList.Add(m); +end; + +procedure TListViewMediator.CreateColumns; + +var + c: integer; + lc: TfpgLVColumn; + lInfo : TtiMediatorFieldInfo; + +begin + if View.Columns.Count = 0 then + begin + { Create column headers } + for c := 0 to Pred(FieldsInfo.Count) do + begin + lInfo := FieldsInfo[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; +end; + +procedure TListViewMediator.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 TListViewMediator.RebuildList; +begin + MediatorList.Clear; + ClearList; + { 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 + View.Columns.Clear; + View.Items.Clear; + CreateSubMediators; + finally + View.EndUpdate; + end; +end; + +constructor TListViewMediator.CreateCustom(AModel: TtiObjectList; + AView: TfpgListView; AOnBeforeSetupField: TOnBeforeSetupField; + ADisplayNames: string; AIsObserving: Boolean); +begin + Create; // don't forget this + OnBeforeSetupField := AOnBeforeSetupField; + DisplayNames := ADisplayNames; // Will call ParseDisplaynames. + Subject := AModel; + GUIControl := AView; // Will call SetupGUIandObject; + CreateSubMediators; + Active := AIsObserving; // Will attach/Detach +end; + +class function TListViewMediator.ComponentClass: TClass; +begin + Result:=TfpgListView; +end; + +constructor TListViewMediator.Create; +begin + inherited Create; + FObserversInTransit := TList.Create; +end; + +constructor TListViewMediator.CreateCustom(AModel: TtiObjectList; + AView: TfpgListView; ADisplayNames: string; AIsObserving: Boolean); +begin + CreateCustom(AModel,AView,Nil,ADisplayNames,AIsObserving); +end; + +Destructor TListViewMediator.Destroy; +begin + IsObserving:=False; + FView := nil; + inherited; +end; + +{ TODO: This is not working 100% yet. Be warned! } +procedure TListViewMediator.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 + begin + TMediatorView(SelectedObject.ObserverList.Items[i]).Subject := + SelectedObject; + end; + + // execute the NotifyObservers event to update the observers. + SelectedObject.NotifyObservers; + end; +end; + + +{ TListViewListItemMediator } + +procedure TListViewListItemMediator.SetupFields; +var + c: integer; + lMemberName: string; + lValue: string; +begin + lMemberName :=FFieldsInfo[0].PropName; + lValue:=FModel.PropValue[lMemberName]; + if Assigned(OnBeforeSetupField) then + OnBeforeSetupField(FModel, lMemberName, lValue); + FView.Caption := lValue; + for c := 1 to FFieldsInfo.Count-1 do + begin + lMemberName := FFieldsInfo[c].PropName; + lValue := FModel.PropValue[lMemberName]; + if Assigned(OnBeforeSetupField) then + OnBeforeSetupField(FModel, lMemberName, lValue); + FView.SubItems.Add(lValue); + end; +end; + +constructor TListViewListItemMediator.CreateCustom(AModel: TtiObject; + AView: TfpgLVItem; const AFieldsInfo: TtiMediatorFieldInfoList; + IsObserving: Boolean); +begin + CreateCustom(AModel,AView,Nil,AFieldsInfo,IsObserving); +end; + +constructor TListViewListItemMediator.CreateCustom(AModel: TtiObject; + AView: TfpgLVItem; AOnBeforeSetupField: TOnBeforeSetupField; + const AFieldsInfo: TtiMediatorFieldInfoList; IsObserving: Boolean); +begin + inherited Create; + FModel := AModel; + FView := AView; + FFieldsInfo := AFieldsInfo; + OnBeforeSetupField := AOnBeforeSetupField; + SetupFields; + Active:=IsObserving; // Will attach +end; + +procedure TListViewListItemMediator.BeforeDestruction; +begin + FModel.DetachObserver(self); + FModel := nil; + FView := nil; + inherited BeforeDestruction; +end; + +procedure TListViewListItemMediator.Update(ASubject: TtiObject); +var + c: integer; + lMemberName: string; + lValue: string; +begin + Assert(FModel = ASubject); + + lMemberName := FFieldsInfo[0].PropName; + lValue := FModel.PropValue[lMemberName]; + if Assigned(OnBeforeSetupField) then + OnBeforeSetupField(FModel, lMemberName, lValue); + + FView.Caption := lValue; + + for c := 1 to FFieldsInfo.Count-1 do + begin + lMemberName := FFieldsInfo[c].PropName; + lValue := FModel.PropValue[lMemberName]; + if Assigned(OnBeforeSetupField) then + OnBeforeSetupField(FModel, lMemberName, lValue); + FView.SubItems[c-1] := lValue; + end; +end; + +{ --------------------------------------------------------------------- + StringGrid + --------------------------------------------------------------------- } + +{ TStringGridMediator } + +function TStringGridMediator.GetSelectedObject: 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 TStringGridMediator.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 TStringGridMediator.SetView(const AValue: TfpgStringGrid); +begin + SetGUIControl(AValue); +end; + +function TStringGridMediator.GetGuiControl: TComponent; +begin + Result:=fView; +end; + +procedure TStringGridMediator.SetGuiControl(const AValue: TComponent); +begin + FView:=AValue as TfpgStringGrid; +end; + +procedure TStringGridMediator.DoCreateItemMediator(AData: TtiObject; ARowIdx: Integer); +var + i: Integer; + lFieldName: string; + lMediatorView: TStringGridRowMediator; +begin + FView.Objects[0, ARowIdx] := AData; // set Object reference inside grid + for i := 0 to FieldsInfo.Count-1 do + begin + lFieldName:=FieldsInfo[i].PropName; + FView.Cells[i, ARowIdx]:=AData.PropValue[lFieldName]; // set Cell text + end; + lMediatorView := TStringGridRowMediator.CreateCustom(AData, FView, FieldsInfo, ARowIdx, Active); + MediatorList.Add(lMediatorView); +end; + +procedure TStringGridMediator.CreateColumns; +var + i: integer; + lColumnTotalWidth: integer; +begin + lColumnTotalWidth := 0; + for i := 0 to FieldsInfo.Count-1 do + begin + FView.ColumnWidth[i] := FieldsInfo[i].FieldWidth; + FView.ColumnTitle[i] := FieldsInfo[i].Caption; + FView.Columns[i].Alignment:=FieldsInfo[i].Alignment; + //resize the last column to fill the grid. + if i = FieldsInfo.Count-1 then + begin + If FView.Width > (lColumnTotalWidth + 10) then + FView.ColumnWidth[i] := FView.Width - (lColumnTotalWidth + 10) + end + else + lColumnTotalWidth := lColumnTotalWidth + FView.ColumnWidth[i] + 20; + end; +end; + +procedure TStringGridMediator.SetupGUIandObject; +begin + //Setup default properties for the StringGrid + FView.RowSelect := True; + FView.ColumnCount := FieldsInfo.Count; + if ShowDeleted then + FView.RowCount := Model.Count + else + FView.RowCount := Model.CountNotDeleted; +end; + +procedure TStringGridMediator.RebuildList; +begin + { This rebuilds the whole list. Not very efficient. } + View.BeginUpdate; + try + SetupGUIandObject; + MediatorList.Clear; +// for i := View.ColumnCount-1 downto 0 do +// View.DeleteColumn(i); + CreateSubMediators; + finally + View.EndUpdate; + end; +end; + +constructor TStringGridMediator.CreateCustom(AModel: TtiObjectList; + AGrid: TfpgStringGrid; ADisplayNames: string; AIsObserving: Boolean); +begin + inherited Create; + DisplayNames := ADisplayNames; + Subject := AModel; + GUIControl := AGrid; + CreateSubMediators; + IsObserving := AIsObserving; +end; + +class function TStringGridMediator.ComponentClass: TClass; +begin + Result:=TfpgStringGrid +end; + + +{ TStringGridRowMediator } + +constructor TStringGridRowMediator.CreateCustom(AModel: TtiObject; + AGrid: TfpgStringGrid; Const AFieldsInfo : TtiMediatorFieldInfoList; ARowIndex: integer; + IsObserving: Boolean); +begin + inherited Create; + FModel := AModel; + FView := AGrid; + FFieldsInfo := AFieldsInfo; + FRowIndex := ARowIndex; + Active :=IsObserving; // Will attach +end; + +procedure TStringGridRowMediator.Update(ASubject: TtiObject); +var + i: Integer; + lvalue, + lFieldName: string; +begin + Assert(FModel = ASubject); + for i := 0 to FFieldsInfo.Count-1 do + begin + lFieldName := FFieldsInfo[I].PropName; + lValue := FModel.PropValue[lFieldName]; + if Assigned(OnBeforeSetupField) then + OnBeforeSetupField(FModel, lFieldName, lValue); + FView.Cells[i, FRowIndex] := lValue; + end; +end; + + +end. + diff --git a/extras/tiopf/gui/tiMediators.pas b/extras/tiopf/gui/tiMediators.pas new file mode 100644 index 00000000..dd5d47e3 --- /dev/null +++ b/extras/tiopf/gui/tiMediators.pas @@ -0,0 +1,690 @@ +{ + 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: + * As soon as TfpgSpinEdit has been implemented, port the SpinEdit mediator +} + +unit tiMediators; + +{$mode objfpc}{$H+} + +interface +uses + tiObject + ,Classes + ,tiBaseMediator + ,fpgfx + ,gfx_widget + ,gui_edit + ,gui_checkbox + ,gui_label + ,gui_trackbar + ,gui_combobox + ,gui_memo + ,gui_popupcalendar + ; + +type + + { Base class to handle TfpgEdit controls } + TMediatorEditView = class(TMediatorView) + private + FEditControl: TfpgEdit; + protected + function GetGUIControl: TComponent; override; + procedure SetGUIControl(const AValue: TComponent);override; + protected + procedure UpdateGuiValidStatus(pErrors: TtiObjectErrors); override; + procedure SetupGUIandObject; override; + procedure SetObjectUpdateMoment (Const AValue : TObjectUpdateMoment); override; + public + Constructor Create; override; + constructor CreateCustom(pEditControl: TfpgWidget; pSubject: TtiObject; pFieldName: string; pGuiFieldName: string = 'Text'); reintroduce; + destructor Destroy; override; + property EditControl: TfpgEdit read FEditControl write FEditControl; + class function ComponentClass: TClass; override; + end; + + + { Base class to handle TfpgCheckBox controls } + TMediatorCheckBoxView = class(TMediatorView) + private + FEditControl: TfpgCheckBox; + function GetGUIControl: TComponent; override; + procedure SetGUIControl(const AValue: TComponent);override; + protected + procedure UpdateGuiValidStatus(pErrors: TtiObjectErrors); override; + public + Constructor Create; override; + property EditControl: TfpgCheckBox read FEditControl write FEditControl; + class function ComponentClass: TClass; override; + end; + + + { Base class to handle TfpgLabel controls } + TMediatorStaticTextView = class(TMediatorView) + private + FEditControl: TfpgLabel; + function GetGUIControl: TComponent; override; + procedure SetGUIControl(const AValue: TComponent);override; + protected + procedure SetupGUIandObject; override; + public + Constructor Create; override; + property EditControl: TfpgLabel read FEditControl write FEditControl; + 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 + FEditControl: TfpgTrackBar; + function GetGUIControl: TComponent; override; + procedure SetGUIControl(const AValue: TComponent);override; + public + Constructor Create; override; + property EditControl: TfpgTrackBar read FEditControl write FEditControl; + class function ComponentClass: TClass; override; + end; + + + { Base class to handle TfpgComboBox controls } + TMediatorComboBoxView = class(TMediatorView) + private + FEditControl: TfpgComboBox; + function GetGUIControl: TComponent; override; + procedure SetGUIControl(const AValue: TComponent);override; + protected + procedure UpdateGuiValidStatus(pErrors: TtiObjectErrors); override; + public + Constructor Create; override; + property EditControl: TfpgComboBox read FEditControl write FEditControl; + procedure DoObjectToGui; override; + class function ComponentClass: TClass; override; + end; + + + // Sets ItemIndex based on integer property + TMediatorItemComboBoxView = class(TMediatorComboBoxView) + Protected + Procedure DoGUIToObject; override; + Procedure DoObjectToGUI; override; + end; + + + { TComboBox observing a list and setting a Object property } + TMediatorDynamicComboBoxView = class(TMediatorComboBoxView) + private + FExternalOnChange: TNotifyEvent; + procedure InternalListRefresh; + protected + procedure SetListObject(const AValue: TtiObjectList); override; + procedure SetOnChangeActive(AValue: Boolean); virtual; + procedure SetupGUIandObject; override; + public + procedure DoGuiToObject; override; + procedure DoObjectToGui; override; + procedure RefreshList; virtual; + end; + + + { Base class to handle TfpgMemo controls } + TMediatorMemoView = class(TMediatorView) + private + FEditControl: TfpgMemo; + function GetGUIControl: TComponent; override; + procedure SetGUIControl(const AValue: TComponent);override; + protected + procedure SetupGUIandObject; override; + public + property EditControl: TfpgMemo read FEditControl write FEditControl; + procedure DoObjectToGui; override; + procedure DoGuiToObject; override; + class function ComponentClass: TClass; override; + end; + + + { Base class to handle TfpgCalendarCombo controls } + TMediatorCalendarComboView = class(TMediatorView) + private + FEditControl: TfpgCalendarCombo; + function GetGUIControl: TComponent; override; + procedure SetGUIControl(const AValue: TComponent);override; + public + Constructor Create; override; + property EditControl: TfpgCalendarCombo read FEditControl write FEditControl; + class function ComponentClass: TClass; override; + end; + + +implementation +uses + SysUtils + ,TypInfo + ,tiExcept + ,gui_dialogs // for TfpgMessageDialog + ,tiGUIConstants // for error color + ,gfxbase // for predefined colors + ; + +const + cErrorListHasNotBeenAssigned = 'List has not been assigned'; + + +{ TMediatorEditView } + +function TMediatorEditView.GetGUIControl: TComponent; +begin + Result:=FeditControl; +end; + +procedure TMediatorEditView.SetGUIControl(const AValue: TComponent); +begin + FEditControl:=AValue as TfpgEdit; + Inherited; +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; + +procedure TMediatorEditView.SetupGUIandObject; +var + Mi,Ma : Integer; +begin + inherited; + if Subject.GetFieldBounds(FieldName,Mi,Ma) and (Ma>0) then + FEditControl.MaxLength:=Ma; + if ObjectUpdateMoment in [ouOnchange,ouCustom] then + FeditControl.OnChange:=@DoOnChange + else + FeditControl.OnExit:=@DoOnChange +end; + +procedure TMediatorEditView.SetObjectUpdateMoment( + const AValue: TObjectUpdateMoment); +begin + inherited SetObjectUpdateMoment(AValue); + If Assigned(FEditControl) then + If ObjectUpdateMoment in [ouOnchange,ouCustom] then + FeditControl.OnChange:=@DoOnChange + else + FeditControl.OnExit:=@DoOnChange +end; + +constructor TMediatorEditView.Create; +begin + inherited Create; + GuiFieldName:='Text'; +end; + +constructor TMediatorEditView.CreateCustom(pEditControl: TfpgWidget; + pSubject: TtiObject; pFieldName: string; pGuiFieldName: string); +begin + inherited; +end; + +destructor TMediatorEditView.Destroy; +begin + if Assigned(EditControl) and 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.GetGUIControl: TComponent; +begin + Result:=FEditControl; +end; + +procedure TMediatorTrackBarView.SetGUIControl(const AValue: TComponent); +begin + FEditControl:=AValue as TfpgTrackBar; + Inherited; +end; + +constructor TMediatorTrackBarView.Create; +begin + Inherited; + GuiFieldName:='Position'; +end; + +class function TMediatorTrackBarView.ComponentClass: TClass; +begin + Result := TfpgTrackBar; +end; + + +{ TMediatorComboBoxView } + +class function TMediatorComboBoxView.ComponentClass: TClass; +begin + Result := TfpgComboBox; +end; + +function TMediatorComboBoxView.GetGUIControl: TComponent; +begin + Result:=FeditControl; +end; + +procedure TMediatorComboBoxView.SetGUIControl(const AValue: TComponent); +begin + FEditControl:=AValue as TfpgComboBox; + Inherited; +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; + +constructor TMediatorComboBoxView.Create; +begin + inherited Create; + GuiFieldName:='FocusItem'; +end; + +procedure TMediatorComboBoxView.DoObjectToGui; +begin + EditControl.FocusItem := + EditControl.Items.IndexOf(Subject.PropValue[FieldName]); +end; + + +{ TMediatorMemoView } + +class function TMediatorMemoView.ComponentClass: TClass; +begin + Result := TfpgMemo; +end; + +procedure TMediatorMemoView.DoGuiToObject; +begin + Subject.PropValue[FieldName] := EditControl.Lines.Text; +end; + +procedure TMediatorMemoView.DoObjectToGui; +begin + EditControl.Lines.Text := Subject.PropValue[FieldName]; +end; + +function TMediatorMemoView.GetGUIControl: TComponent; +begin + Result:=FEditControl; +end; + +procedure TMediatorMemoView.SetGUIControl(const AValue: TComponent); +begin + FEditControl:=AValue as TfpgMemo; + Inherited; +end; + +procedure TMediatorMemoView.SetupGUIandObject; +begin + inherited; + EditControl.Lines.Clear; +// EditControl.ScrollBars := ssVertical; +// EditControl.WordWrap := True; +end; + + +{ TMediatorDynamicComboBoxView } + +procedure TMediatorDynamicComboBoxView.SetListObject(const AValue: TtiObjectList); +begin + Inherited; + InternalListRefresh; +end; + +procedure TMediatorDynamicComboBoxView.InternalListRefresh; +var + lItems: TStrings; + i: Integer; +begin + lItems := EditControl.Items; + lItems.Clear; + EditControl.Text := ''; + + if (ValueList = nil) or + (ValueList.Count < 1) or + (SameText(FieldName, EmptyStr)) then + Exit; //==> + + try + for i := 0 to ValueList.Count - 1 do + begin + lItems.Add(ValueList.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, FieldName]); + 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 := (ValueList.Count > 0); +end; + +procedure TMediatorDynamicComboBoxView.DoGuiToObject; +var + lValue: TtiObject; + lPropType: TTypeKind; +begin + if not DataAndPropertyValid then + Exit; //==> + if EditControl.FocusItem < 0 then + Exit; //==> + + lValue := TtiObject(ValueList.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.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) + EditControl.FocusItem := -1; + if Subject = nil then + Exit; //==> + + if not Assigned(ValueList) 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 ValueList.Count - 1 do + if ValueList.Items[i] = lValue then + begin + EditControl.FocusItem := i; + Break; //==> + end; + + SetOnChangeActive(true); +end; + +procedure TMediatorDynamicComboBoxView.RefreshList; +begin + InternalListRefresh; +end; + + +{ TMediatorCheckBoxView } + +function TMediatorCheckBoxView.GetGUIControl: TComponent; +begin + Result:=FEditControl; +end; + +procedure TMediatorCheckBoxView.SetGUIControl(const AValue: TComponent); +begin + FEditControl:=AValue as TfpgCheckBox; + Inherited; +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; + +constructor TMediatorCheckBoxView.Create; +begin + inherited Create; + GuiFieldName:='Checked'; +end; + +class function TMediatorCheckBoxView.ComponentClass: TClass; +begin + Result := TfpgCheckBox; +end; + + +{ TMediatorStaticTextView } + +procedure TMediatorStaticTextView.SetupGUIandObject; +begin + inherited SetupGUIandObject; + EditControl.Text := ''; +end; + +constructor TMediatorStaticTextView.Create; +begin + inherited Create; + GuiFieldName:='Text'; +end; + +function TMediatorStaticTextView.GetGUIControl: TComponent; +begin + Result:=FEditControl; +end; + +procedure TMediatorStaticTextView.SetGUIControl(const AValue: TComponent); +begin + FEditControl:=AValue as TfpgLabel; + Inherited; +end; + +class function TMediatorStaticTextView.ComponentClass: TClass; +begin + Result := TfpgLabel; +end; + + +{ TMediatorCalendarComboView } + +function TMediatorCalendarComboView.GetGUIControl: TComponent; +begin + Result:=FEditControl; +end; + +procedure TMediatorCalendarComboView.SetGUIControl(const AValue: TComponent); +begin + FEditControl:= AValue as TfpgCalendarCombo; + Inherited; +end; + +constructor TMediatorCalendarComboView.Create; +begin + inherited Create; + GUIFieldName:='DateValue'; +end; + +class function TMediatorCalendarComboView.ComponentClass: TClass; +begin + Result := TfpgCalendarCombo; +end; + + +{ TMediatorItemComboBoxView } + +procedure TMediatorItemComboBoxView.DoGUIToObject; +begin + SetOrdProp(Subject,FieldName,EditControl.FocusItem); +end; + +procedure TMediatorItemComboBoxView.DoObjectToGUI; +begin + EditCOntrol.FocusItem:=GetOrdProp(Subject,FieldName); +end; + +end. + diff --git a/extras/tiopf/tiOPFfpGUI.lpk b/extras/tiopf/tiOPFfpGUI.lpk index bcea5cb1..e1dcd750 100644 --- a/extras/tiopf/tiOPFfpGUI.lpk +++ b/extras/tiopf/tiOPFfpGUI.lpk @@ -36,7 +36,7 @@ <License Value="Mozilla Public License v1.1 "/> <Version Major="2" Release="4"/> - <Files Count="8"> + <Files Count="7"> <Item1> <Filename Value="gui/tiGUIUtils.pas"/> <UnitName Value="tiGUIUtils"/> @@ -50,25 +50,21 @@ <UnitName Value="tiGUIINI"/> </Item3> <Item4> - <Filename Value="gui/tiGenericEditMediators.pas"/> - <UnitName Value="tiGenericEditMediators"/> - </Item4> - <Item5> <Filename Value="gui/tiGUIConstants.pas"/> <UnitName Value="tiGUIConstants"/> + </Item4> + <Item5> + <Filename Value="gui/tiRtfReport.pas"/> + <UnitName Value="tiRtfReport"/> </Item5> <Item6> - <Filename Value="gui/tiGenericListMediators.pas"/> - <UnitName Value="tiGenericListMediators"/> + <Filename Value="gui/tiMediators.pas"/> + <UnitName Value="tiMediators"/> </Item6> <Item7> - <Filename Value="gui/tiCompositeMediators.pas"/> - <UnitName Value="tiCompositeMediators"/> + <Filename Value="gui/tiListMediators.pas"/> + <UnitName Value="tiListMediators"/> </Item7> - <Item8> - <Filename Value="gui/tiRtfReport.pas"/> - <UnitName Value="tiRtfReport"/> - </Item8> </Files> <RequiredPkgs Count="2"> <Item1> diff --git a/extras/tiopf/tiOPFfpGUI.pas b/extras/tiopf/tiOPFfpGUI.pas index 8ca8f183..6762cfc3 100644 --- a/extras/tiopf/tiOPFfpGUI.pas +++ b/extras/tiopf/tiOPFfpGUI.pas @@ -1,5 +1,5 @@ -{ This file was automatically created by Lazarus. Do not edit! -This source is only used to compile and install the package. +{ This file was automatically created by Lazarus. do not edit! + This source is only used to compile and install the package. } unit tiOPFfpGUI; @@ -7,8 +7,8 @@ unit tiOPFfpGUI; interface uses - tiGUIUtils, tiDialogs, tiGUIINI, tiGenericEditMediators, tiGUIConstants, - tiGenericListMediators, tiCompositeMediators, tiRtfReport; + tiGUIUtils, tiDialogs, tiGUIINI, tiGUIConstants, tiRtfReport, tiMediators, + tiListMediators; implementation |