summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--extras/code_templates/lazarus.dci55
-rw-r--r--extras/tiopf/demos/Common/Model_View.pas14
-rw-r--r--extras/tiopf/demos/EditControlsDemo/frmMain.pas1
-rw-r--r--extras/tiopf/demos/ListControlDemo/frmMain.pas242
-rw-r--r--extras/tiopf/demos/ListControlDemo/listcontroldemo.lpi77
-rw-r--r--extras/tiopf/demos/ListControlDemo/listcontroldemo.lpr26
-rw-r--r--extras/tiopf/demos/readme.txt29
-rw-r--r--extras/tiopf/gui/tiDialogs.pas4
-rw-r--r--extras/tiopf/gui/tiGenericListMediators.pas585
-rw-r--r--extras/tiopf/tiOPFfpGUI.lpk14
-rw-r--r--extras/tiopf/tiOPFfpGUI.pas3
-rw-r--r--src/corelib/fpgfx.pas20
-rw-r--r--src/corelib/gfx_widget.pas2
-rw-r--r--src/corelib/x11/gfx_x11.pas8
-rw-r--r--src/gui/gui_combobox.pas32
-rw-r--r--src/gui/gui_listbox.pas2
-rw-r--r--src/gui/gui_menu.pas4
17 files changed, 1061 insertions, 57 deletions
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 @@
+<?xml version="1.0"?>
+<CONFIG>
+ <ProjectOptions>
+ <PathDelim Value="/"/>
+ <Version Value="5"/>
+ <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"/>
+ <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+ <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+ </PublishOptions>
+ <RunParams>
+ <local>
+ <FormatVersion Value="1"/>
+ <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+ </local>
+ </RunParams>
+ <RequiredPackages Count="1">
+ <Item1>
+ <PackageName Value="tiOPFfpGUI"/>
+ <MinVersion Major="2" Release="3" Valid="True"/>
+ </Item1>
+ </RequiredPackages>
+ <Units Count="5">
+ <Unit0>
+ <Filename Value="listcontroldemo.lpr"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="listcontroldemo"/>
+ </Unit0>
+ <Unit1>
+ <Filename Value="frmMain.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="frmMain"/>
+ </Unit1>
+ <Unit2>
+ <Filename Value="../Common/Model_View.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="Model_View"/>
+ </Unit2>
+ <Unit3>
+ <Filename Value="../Common/Constants.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="Constants"/>
+ </Unit3>
+ <Unit4>
+ <Filename Value="../Common/Model.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="Model"/>
+ </Unit4>
+ </Units>
+ </ProjectOptions>
+ <CompilerOptions>
+ <Version Value="5"/>
+ <SearchPaths>
+ <OtherUnitFiles Value="../Common/"/>
+ </SearchPaths>
+ <CodeGeneration>
+ <Generate Value="Faster"/>
+ </CodeGeneration>
+ <Other>
+ <CustomOptions Value="-FUunits
+"/>
+ <CompilerPath Value="$(CompPath)"/>
+ </Other>
+ </CompilerOptions>
+</CONFIG>
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 @@
<License Value="Mozilla Public License v1.1
"/>
<Version Major="2" Release="3"/>
- <Files Count="5">
+ <Files Count="6">
<Item1>
<Filename Value="gui/tiGUIUtils.pas"/>
<UnitName Value="tiGUIUtils"/>
@@ -42,19 +42,23 @@
<Filename Value="gui/tiGUIConstants.pas"/>
<UnitName Value="tiGUIConstants"/>
</Item5>
+ <Item6>
+ <Filename Value="gui/tiGenericListMediators.pas"/>
+ <UnitName Value="tiGenericListMediators"/>
+ </Item6>
</Files>
<RequiredPkgs Count="3">
<Item1>
- <PackageName Value="fpgui_package"/>
- <MinVersion Minor="5" Valid="True"/>
+ <PackageName Value="FCL"/>
+ <MinVersion Major="1" Valid="True"/>
</Item1>
<Item2>
<PackageName Value="tiOPF"/>
<MinVersion Major="2" Release="3" Valid="True"/>
</Item2>
<Item3>
- <PackageName Value="FCL"/>
- <MinVersion Major="1" Valid="True"/>
+ <PackageName Value="fpgui_package"/>
+ <MinVersion Minor="5" Valid="True"/>
</Item3>
</RequiredPkgs>
<UsageOptions>
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;
generated by cgit v1.2.3-70-g09d2 (git 2.47.0) at 2024-10-16 15:22:25 +0000