From 316a16c5f3337ad23ecdfdd6444c0b72af3f2406 Mon Sep 17 00:00:00 2001 From: graemeg Date: Mon, 27 Aug 2007 12:57:16 +0000 Subject: * Implemented List Mediators with tiOPF support and added a demo. * Added a quick workaround for the InvertCaret function causing a AV. * MenuBar now keeps the current menu focused even if you open more than 2 levels deep of Popup Menus. * Added some TODO entries to Widgets. Also published some missing properties. * Fixed repainting issue with TfpgComobBox when you set the Width from code and made the component focusable. Not sure why it wasn't! * Updated Lazarus IDE code template for new fpGUI applications. --- extras/code_templates/lazarus.dci | 55 +- extras/tiopf/demos/Common/Model_View.pas | 14 +- extras/tiopf/demos/EditControlsDemo/frmMain.pas | 1 + extras/tiopf/demos/ListControlDemo/frmMain.pas | 242 +++++++++ .../demos/ListControlDemo/listcontroldemo.lpi | 77 +++ .../demos/ListControlDemo/listcontroldemo.lpr | 26 + extras/tiopf/demos/readme.txt | 29 + extras/tiopf/gui/tiDialogs.pas | 4 +- extras/tiopf/gui/tiGenericListMediators.pas | 585 +++++++++++++++++++++ extras/tiopf/tiOPFfpGUI.lpk | 14 +- extras/tiopf/tiOPFfpGUI.pas | 3 +- src/corelib/fpgfx.pas | 20 +- src/corelib/gfx_widget.pas | 2 +- src/corelib/x11/gfx_x11.pas | 8 + src/gui/gui_combobox.pas | 32 ++ src/gui/gui_listbox.pas | 2 + src/gui/gui_menu.pas | 4 +- 17 files changed, 1061 insertions(+), 57 deletions(-) create mode 100644 extras/tiopf/demos/ListControlDemo/frmMain.pas create mode 100644 extras/tiopf/demos/ListControlDemo/listcontroldemo.lpi create mode 100644 extras/tiopf/demos/ListControlDemo/listcontroldemo.lpr create mode 100644 extras/tiopf/demos/readme.txt create mode 100644 extras/tiopf/gui/tiGenericListMediators.pas diff --git a/extras/code_templates/lazarus.dci b/extras/code_templates/lazarus.dci index a21c6190..888b0b1e 100644 --- a/extras/code_templates/lazarus.dci +++ b/extras/code_templates/lazarus.dci @@ -1,50 +1,39 @@ [fpguiapp | fpGUI template application] uses - fpGFX, fpGUI; + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Classes, fpgfx, gui_form; type - TMainForm = class(TForm) - private - FMainLayout: TBoxLayout; - lblTemplate: TLabel; + TMainForm = class(TfpgForm) public - procedure AfterConstruction; override; + constructor Create(AOwner: TComponent); override; end; - { TMainForm } -procedure TMainForm.AfterConstruction; +constructor TMainForm.Create(AOwner: TComponent); begin - inherited AfterConstruction; - Name := 'MainForm'; - BorderWidth := 8; - Text := 'fpGUI Template Application'; - - FMainLayout := TBoxLayout.Create(self); - FMainLayout.Spacing := 8; - FMainLayout.Orientation := Vertical; - FMainLayout.VertAlign := vertFill; - InsertChild(FMainLayout); - - lblTemplate := TLabel.Create('MainForm', self); - FMainLayout.InsertChild(lblTemplate); - - // Create other components here - + inherited Create(AOwner); + WindowTitle := 'My Title'; + WindowPosition := wpUser; + SetPosition(100, 100, 300, 200); end; +procedure MainProc; var - MainForm: TMainForm; + frm: TMainForm; begin - GFApplication.Initialize; - MainForm := TMainForm.Create(GFApplication); - try - MainForm.Show; - GFApplication.Run; - finally - MainForm.Free; - end; + fpgApplication.Initialize; + frm := TMainForm.Create(nil); + frm.Show; + fpgApplication.Run; +end; + +begin + MainProc; end. + diff --git a/extras/tiopf/demos/Common/Model_View.pas b/extras/tiopf/demos/Common/Model_View.pas index 937b51a3..7cc68e8a 100644 --- a/extras/tiopf/demos/Common/Model_View.pas +++ b/extras/tiopf/demos/Common/Model_View.pas @@ -9,7 +9,7 @@ interface uses Classes ,tiGenericEditMediators -// ,tiGenericListMediators + ,tiGenericListMediators // ,tiCompositeMediators ; @@ -51,18 +51,18 @@ type { TPersonList_ComboBox_Mediator } -{ + TPersonList_ComboBox_Mediator = class(TComboBoxMediator) protected procedure SetupGUIandObject; override; end; - +(* TPersonList_ListView_CompositeMediator = class(TCompositeListViewMediator) protected procedure SetupGUIandObject; override; end; -} +*) implementation @@ -99,17 +99,17 @@ end; { TPersonList_ComboBox_Mediator } -(* + procedure TPersonList_ComboBox_Mediator.SetupGUIandObject; begin inherited SetupGUIandObject; - View.Style := csDropDownList; +// View.Style := csDropDownList; // View.ReadOnly := True; end; { TPersonList_ListView_CompositeMediator } - +(* procedure TPersonList_ListView_CompositeMediator.SetupGUIandObject; begin inherited SetupGUIandObject; diff --git a/extras/tiopf/demos/EditControlsDemo/frmMain.pas b/extras/tiopf/demos/EditControlsDemo/frmMain.pas index afa03d91..83d25adc 100644 --- a/extras/tiopf/demos/EditControlsDemo/frmMain.pas +++ b/extras/tiopf/demos/EditControlsDemo/frmMain.pas @@ -249,6 +249,7 @@ var begin inherited Create(AOwner); WindowTitle := 'Edit Mediators Demo'; + WindowPosition := wpUser; SetPosition(100, 100, 500, 200); { The Data Object being observed } diff --git a/extras/tiopf/demos/ListControlDemo/frmMain.pas b/extras/tiopf/demos/ListControlDemo/frmMain.pas new file mode 100644 index 00000000..49797cfc --- /dev/null +++ b/extras/tiopf/demos/ListControlDemo/frmMain.pas @@ -0,0 +1,242 @@ +unit frmMain; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, gui_form, gui_button, gui_label, gui_edit, gui_trackbar, + gui_combobox, gui_checkbox, gui_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); +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 } + cbPeople.FocusItem := lbPeople.FocusItem; +end; + +procedure TMainForm.cbSelectionChanged(Sender: TObject); +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 } + lbPeople.FocusItem := cbPeople.FocusItem; +end; + +procedure TMainForm.chkShowDeletedChange(Sender: TObject); +begin + FComboBoxMediator.ShowDeleted := chkShowDeleted.Checked; + FListBoxMediator.ShowDeleted := chkShowDeleted.Checked; +end; + +procedure TMainForm.InitializeComponents; +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; + + CreateLabel(self, edtName.Right + 30, edtName.Top, 'These components observe the ').Color := clBlue; + CreateLabel(self, edtName.Right + 30, AgeTrackBar.Top-5, 'selected item of ComboBox').Color := clBlue; + + cbPeople := TfpgComboBox.Create(self); + cbPeople.Top := AgeTrackBar.Bottom + 17; + cbPeople.Left := 7; + cbPeople.Width := 200; + cbPeople.Hint := 'Shows objects from the object list'; + + lbPeople := TfpgListBox.Create(self); + lbPeople.Top := cbPeople.Bottom + 7; + lbPeople.Left := cbPeople.Left; + lbPeople.Height := 200; + lbPeople.Width := 200; + lbPeople.Hint := 'Shows objects from the object list'; + + chkShowDeleted := CreateCheckBox(self, cbPeople.Right + 50, cbPeople.Top, '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 new file mode 100644 index 00000000..4a51b108 --- /dev/null +++ b/extras/tiopf/demos/ListControlDemo/listcontroldemo.lpi @@ -0,0 +1,77 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/extras/tiopf/demos/ListControlDemo/listcontroldemo.lpr b/extras/tiopf/demos/ListControlDemo/listcontroldemo.lpr new file mode 100644 index 00000000..0761498e --- /dev/null +++ b/extras/tiopf/demos/ListControlDemo/listcontroldemo.lpr @@ -0,0 +1,26 @@ +program listcontroldemo; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Classes, fpgfx, 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/readme.txt b/extras/tiopf/demos/readme.txt new file mode 100644 index 00000000..4961aa2c --- /dev/null +++ b/extras/tiopf/demos/readme.txt @@ -0,0 +1,29 @@ + + 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/gui/tiDialogs.pas b/extras/tiopf/gui/tiDialogs.pas index 5458820b..430cd194 100644 --- a/extras/tiopf/gui/tiDialogs.pas +++ b/extras/tiopf/gui/tiDialogs.pas @@ -95,11 +95,11 @@ begin lForm.WindowTitle := pHeading; lForm.WindowPosition := wpScreenCenter; lForm.Name := 'FormShowStrings'; -// lMemo.Parent := lForm; - lMemo.Align := alClient; 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 diff --git a/extras/tiopf/gui/tiGenericListMediators.pas b/extras/tiopf/gui/tiGenericListMediators.pas new file mode 100644 index 00000000..52aa60ed --- /dev/null +++ b/extras/tiopf/gui/tiGenericListMediators.pas @@ -0,0 +1,585 @@ +(* + +Revision history: + + 2005-09-01: First release by Graeme Geldenhuys (graemeg@gmail.com) + 2007-08-27: Ported the code to the fpGUI toolkit. [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 } + + 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 := 0; + exit; //==> + end; + + for i := 0 to Pred(Model.Count) do + begin + if Value.OID.AsString = Model.Items[i].OID.AsString then + begin + View.FocusItem := i+1; // fpGUI is 1-based + exit; //==> + end; + end; +end; + +function TListBoxMediator.GetView: TfpgListBox; +begin + result := TfpgListBox(inherited GetView); +end; + +procedure TListBoxMediator.HandleSelectionChanged; +var + i: integer; +begin + if View.FocusItem = 0 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-1]); + + { 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 := 0; + if (Model.CountNotDeleted) >= View.FocusItem then + begin + selected := View.FocusItem; + end; + + ptr := View.OnSelect; + View.OnSelect := nil; + View.Items.BeginUpdate; + 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 + View.Items.AddObject(Model.Items[i].Caption, Model.Items[i]); + end; + end; + if Model.CountNotDeleted > 0 then + begin + if selected = 0 then + selected := 1; + View.FocusItem := selected; + end; + finally + View.Items.EndUpdate; + view.Update; + View.OnSelect := ptr; + HandleSelectionChanged; + end; +end; + + +procedure TListBoxMediator.RestoreBookmark; +begin + if OldPos > View.Items.Count then + NewPos := View.Items.Count + else if OldPos = 0 then + NewPos := 0 + 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 := 0; + exit; //==> + end; + + for i := 0 to Pred(Model.Count) do + begin + if Value = Model.Items[i] then + begin + View.FocusItem := i+1; // fpGUI is 1-based + exit; //==> + end; + end; +end; + +function TComboBoxMediator.GetView: TfpgComboBox; +begin + result := TfpgComboBox(inherited GetView); +end; + + +procedure TComboBoxMediator.HandleSelectionChanged; +var + i: integer; +begin + if View.FocusItem = 0 then + SelectedObject := nil + else + begin + if Assigned(SelectedObject) then + FObserversInTransit.Assign(SelectedObject.ObserverList); + + SelectedObject := TtiObject(View.Items.Objects[View.FocusItem-1]); + + 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 := 0; + if (Model.CountNotDeleted-1) >= View.FocusItem then + selected := View.FocusItem; + + ptr := View.OnChange; + View.OnChange := nil; + View.Items.BeginUpdate; + 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 + View.Items.AddObject( Model.Items[i].Caption, Model.Items[i] ); + end; + end; + if Model.CountNotDeleted > 0 then + begin + if selected = 0 then + selected := 1; + View.FocusItem := selected; + end; + finally + View.Items.EndUpdate; + 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/tiOPFfpGUI.lpk b/extras/tiopf/tiOPFfpGUI.lpk index 340f9e71..15a2bccf 100644 --- a/extras/tiopf/tiOPFfpGUI.lpk +++ b/extras/tiopf/tiOPFfpGUI.lpk @@ -21,7 +21,7 @@ - + @@ -42,19 +42,23 @@ + + + + - - + + - - + + diff --git a/extras/tiopf/tiOPFfpGUI.pas b/extras/tiopf/tiOPFfpGUI.pas index c452a52f..ef6bee5f 100644 --- a/extras/tiopf/tiOPFfpGUI.pas +++ b/extras/tiopf/tiOPFfpGUI.pas @@ -7,7 +7,8 @@ unit tiOPFfpGUI; interface uses - tiGUIUtils, tiDialogs, tiGUIINI, tiGenericEditMediators, tiGUIConstants; + tiGUIUtils, tiDialogs, tiGUIINI, tiGenericEditMediators, tiGUIConstants, + tiGenericListMediators; implementation diff --git a/src/corelib/fpgfx.pas b/src/corelib/fpgfx.pas index 064b964a..6cc4aa69 100644 --- a/src/corelib/fpgfx.pas +++ b/src/corelib/fpgfx.pas @@ -1128,13 +1128,21 @@ begin Exit; //==> // we could not be sure about the buffer contents! - FCanvas.BeginDraw(False); try - // this works well on narrow characters like 'i' or 'l' in non-mono fonts - FCanvas.XORFillRectangle($FFFFFF, FLeft, FTop, FWidth, FHeight); - FVisible := not FVisible; - finally - FCanvas.EndDraw(FLeft, FTop, FWidth, FHeight); + FCanvas.BeginDraw(False); + try + // this works well on narrow characters like 'i' or 'l' in non-mono fonts + FCanvas.XORFillRectangle($FFFFFF, FLeft, FTop, FWidth, FHeight); + FVisible := not FVisible; + finally + FCanvas.EndDraw(FLeft, FTop, FWidth, FHeight); + end; + except + {$Note This occurs every now and again with TfpgMemo and CaretInvert painting! } + // Investigate this. + {$IFDEF DEBUG} + writeln('TfpgCaret.InvertCaret cause an exception'); + {$ENDIF} end; end; diff --git a/src/corelib/gfx_widget.pas b/src/corelib/gfx_widget.pas index 2032eb3d..644362f8 100644 --- a/src/corelib/gfx_widget.pas +++ b/src/corelib/gfx_widget.pas @@ -409,7 +409,7 @@ begin begin AllocateWindowHandle; DoSetWindowVisible(True); - + for n := 0 to ComponentCount - 1 do begin c := Components[n]; diff --git a/src/corelib/x11/gfx_x11.pas b/src/corelib/x11/gfx_x11.pas index 250ebf7f..aa3b36a9 100644 --- a/src/corelib/x11/gfx_x11.pas +++ b/src/corelib/x11/gfx_x11.pas @@ -1307,6 +1307,14 @@ var pmh: longword; GcValues: TXGcValues; begin + if Assigned(TfpgWindowImpl(awin)) then + begin + // This occurs every now and again with TfpgMemo and InvertCaret painting! + // Investigate this. + if not TfpgWindowImpl(awin).HasHandle then + raise Exception.Create(' Window doesn''t have a Handle'); + end; + XGetGeometry(xapplication.display, TfpgWindowImpl(awin).FWinHandle, @rw, @x, @y, @w, @h, @bw, @d); if FDrawing and buffered and (FBufferPixmap > 0) then diff --git a/src/gui/gui_combobox.pas b/src/gui/gui_combobox.pas index bcf3de8a..a7b9f9c7 100644 --- a/src/gui/gui_combobox.pas +++ b/src/gui/gui_combobox.pas @@ -2,6 +2,16 @@ unit gui_combobox; {$mode objfpc}{$H+} +{ + TODO: + * When combobox Items changes, the combobox needs to refresh. We need a + custom StringItems class to notify us of changes. See TfpgListBox for + an example. + * Implement .BeginUpdate and .EndUpdate methods so we know when to refresh + the items list. + +} + interface uses @@ -37,6 +47,7 @@ type procedure SetFocusItem(const AValue: integer); procedure SetFontDesc(const AValue: string); procedure SetText(const AValue: string); + procedure SetWidth(const AValue: TfpgCoord); protected FMargin: integer; procedure SetEnabled(const AValue: boolean); override; @@ -52,8 +63,10 @@ type public constructor Create(AOwner: TComponent); override; destructor Destroy; override; + procedure Update; procedure AfterConstruction; override; property Font: TfpgFont read FFont; + property Width: TfpgCoord read FWidth write SetWidth; end; @@ -65,6 +78,8 @@ type property FontDesc; property Items; property Text; + property Width; + property Height; property OnChange; end; @@ -299,6 +314,16 @@ begin end; end; +procedure TfpgCustomComboBox.SetWidth(const AValue: TfpgCoord); +begin + if FWidth = AValue then + Exit; //==> + FWidth := AValue; + if Assigned(FInternalBtn) then + FInternalBtn.Left := Width - 20; + RePaint; +end; + procedure TfpgCustomComboBox.SetEnabled(const AValue: boolean); begin inherited SetEnabled(AValue); @@ -369,6 +394,7 @@ begin FHeight := 23; FFocusItem := 0; // nothing is selected FMargin := 3; + FFocusable := True; FFont := fpgGetFont('#List'); FItems := TStringList.Create; @@ -382,6 +408,12 @@ begin inherited Destroy; end; +procedure TfpgCustomComboBox.Update; +begin + FFocusItem := 1; + Repaint; +end; + procedure TfpgCustomComboBox.AfterConstruction; begin inherited AfterConstruction; diff --git a/src/gui/gui_listbox.pas b/src/gui/gui_listbox.pas index 0933c211..d565c7c8 100644 --- a/src/gui/gui_listbox.pas +++ b/src/gui/gui_listbox.pas @@ -6,6 +6,8 @@ unit gui_listbox; TODO: * Refactor these to have a better hierarchy * Only surface properties as published in TfpgListBox + * Implement .BeginUpdate and .EndUpdate methods so we know when to refresh + the items list. } interface diff --git a/src/gui/gui_menu.pas b/src/gui/gui_menu.pas index 60c3bc12..c34d40a9 100644 --- a/src/gui/gui_menu.pas +++ b/src/gui/gui_menu.pas @@ -632,8 +632,8 @@ begin VisibleItem(FFocusItem).Click; end; { if/else } - if OpenerMenuBar <> nil then - OpenerMenuBar.DeActivateMenu; +// if OpenerMenuBar <> nil then +// OpenerMenuBar.DeActivateMenu; end; procedure TfpgPopupMenu.CloseSubmenus; -- cgit v1.2.3-70-g09d2