I would like to update the default value of a private variable linked to a public property only during design-time, in case it's possible.
TMyComp = class(TComponent)
private
FColumnWidth: Integer;
FColumnWidthDef: Integer;
protected
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property ColumnWidth: Integer read FColumnWidth write SetColumnWidth default 50;
end;
...
constructor TMyComponent.Create(AOwner: TComponent);
begin
inherited;
FColumnWidth:= 50;
FColumnWidthDef:= FColumnWidth;
end;
destructor TMyComponent.Destroy;
begin
FColumnWidth:= 0;
FColumnWidthDef:= 0;
inherited;
end;
procedure TMyComponent.SetColumnWidth(const Value: Integer);
begin
if FColumnWidth <> Value then
begin
FColumnWidth:= Value;
FColumnWidthDef:= FColumnWidth; //<-- how to run this only during design-time?
end;
end;
What I would like to do is to store in a private variable the default value for the property ColumnWidth. Inside of run-time code of the component there is a reset button that should change the property to default value FColumnWidthDef. If I do it like the code from above, this value will be updated in design-time and also in run-time.
procedure TMyComponent.SetColumnWidth(const Value: Integer);
begin
if FColumnWidth <> Value then
begin
FColumnWidth:= Value;
if csDesigning in ComponentState then
FColumnWidthDef:= FColumnWidth;
end;
end;
but this do not go to dfm file and when you run app your def will be gone
why not to put this as another published property?
or better write "stored" function like it is done many times in delphi source code like this
property BorderIcons: TBorderIcons read FBorderIcons write SetBorderIcons stored IsForm
default [biSystemMenu, biMinimize, biMaximize];
Related
I have a set of components, that share some global variables to control common properties, e.g. style features.
These are currently accessed at run-time via a global class, e.g. MyCompsSettings().SomeProperty.
I thought it might be useful to allow users to configure some of these properties at design-time, so I converted the global class to a component, and because these properties need to be shared between MyCompsSettings() and instances of my TMyCompsSettings component(s), I used global vars to store the state, e.g.
type
TMyCompsSettings = class(TComponent)
private
function GetBackgroundColor(): TColor;
procedure SetBackgroundColor(const v: TColor);
function GetTitleText(): string;
procedure SetTitleText(const v: string);
published
property BackgroundColor: TColor read GetBackgroundColor write SetBackgroundColor;
property TitleText: string read GetTitleText write SetTitleText;
end;
implementation
var
gBackgroundColor: TColor;
gTitleText: string;
function TIEGlobalSettings.GetBackgroundColor(): TColor;
begin
Result := gBackgroundColor;
end;
procedure TIEGlobalSettings.SetBackgroundColor(const v: TColor);
begin
gBackgroundColor := v;
end;
function TIEGlobalSettings.GetTitleText(): string;
begin
Result := gTitleText;
end;
procedure TIEGlobalSettings.SetTitleText(const v: string);
begin
gTitleText := v;
end;
However, I overlooked that the IDE will also maintain the var states, so when I:
Add a TMyCompsSettings component to a form
Set MyCompsSettings1.TitleText to 'ABC' in the object inspector
Open a different project
Add a TMyCompsSettings component to a form
-> MyCompsSettings1.TitleText is already 'ABC'!
Obvious of course, but I didn't consider that, and it breaks my whole model.
Is there a correct way to do this? e.g. Fields at design-time, vars at run-time, e.g.
type
TMyCompsSettings = class(TComponent)
private
FAuthoritative: Boolean; // Set to true for first instance, which will be MyCompsSettings()
FBackgroundColor: TColor;
FTitleText: string;
function GetBackgroundColor(): TColor;
procedure SetBackgroundColor(const v: TColor);
function GetTitleText(): string;
procedure SetTitleText(const v: string);
published
property BackgroundColor: TColor read GetBackgroundColor write SetBackgroundColor;
property TitleText: string read GetTitleText write SetTitleText;
end;
implementation
function TIEGlobalSettings.GetBackgroundColor(): TColor;
begin
if FAuthoritative or ( csDesigning in ComponentState ) then
Result := FBackgroundColor
else
Result := MyCompsSettings().BackgroundColor;
end;
procedure TIEGlobalSettings.SetBackgroundColor(const v: TColor);
begin
if FAuthoritative or ( csDesigning in ComponentState ) then
FBackgroundColor := v
else
MyCompsSettings().BackgroundColor := v;
end;
function TIEGlobalSettings.GetTitleText(): string;
begin
if FAuthoritative or ( csDesigning in ComponentState ) then
Result := FTitleText
else
Result := MyCompsSettings().TitleText;
end;
procedure TIEGlobalSettings.SetTitleText(const v: string);
begin
if FAuthoritative or ( csDesigning in ComponentState ) then
FTitleText := v
else
MyCompsSettings().TitleText := v;
end;
As the IDE is a process, global variables in the process will remain in the process.
If you want to be able to track the settings between different projects in the IDE (which, if they're in a project group, could both have forms open at the same time) then you will need to find a way of tracking them.
Probably the simplest way is to have the settings held in an object - there can be a global object loaded in an initialization section and freed in a finalization section. Your form based TComponents can check if they are in design mode or not and if they are in design mode then they create a new separate copy of the object, if not they connect to the global instance of the object.
Other components that then access those settings will all use the global object - to ensure that the contents of the object match the design time version you would need to overwrite the global object with any form loaded version. You can do this in the TComponent's Loaded routine.
This code is unchecked, but should give you an outline of how it might work.
implementation
type
TMySettings = class(TPersistent) // so you can .Assign
protected
FOwner: TPersistent;
function GetOwner(): TPersistent; override;
public
constructor Create(AOwner: TPersistent); reintroduce;
property
Owner: TPersistent read GetOwner();
end;
TMySettingsComponent = class(TComponent)
protected
procedure Loaded(); override;
public
destructor Destroy(); override;
procedure AfterConstruction(); override;
end;
implementation
var
gpMySettings: TMySettings;
constructor TMySettings.Create(AOwner: TPersistent);
begin
Self.FOwner:=AOwner;
inherited Create();
end;
function TMySettins.GetOwner(): TPersistent;
begin
Result:=Self.FOwner;
end;
destructor TMySettingsComponent.Destroy;
begin
if(Self.FSettings.Owner = Self) then
FreeAndNIl(Self.FSettings);
inherited;
end;
procedure TMySettingsComponent.AfterConstruction();
begin
// our ComponentState will not yet be set
if( (Self.Owner <> nil) And
(csDesigning in Self.Owner.ComponentState) ) then
Self.FSettings:=TMySettings.Create(Self)
else
Self.FSettings:=gpMySettings;
inherited;
end;
procedure TMySettingsComponent.Loaded;
begin
if( (Self.FMySettings.Owner=Self) And
(gpMySettings<>nil) ) then
gpMySettings.Assign(Self.FMySettings);
end;
initialization
gpMySettings:=TMySettings.Create(nil);
finalization
FreeAndNIl(gpMySettings);
You would also want to ensure that in your TMySettingsComponent you update the global object when the user is changing the properties. This could be as simple as:
procedure TMyComponentSettings.SetBackgroundColour(FNewValue: TColor);
begin
if(Self.FSettings.FBkColour<>FNewValue) then
begin
Self.FSettings.FBkColour:=FNewValue;
if( (Self.FSettings.Owner=Self) And
(gpMySettings<>nil) ) then
gpMySettings.Assign(Self.FSettings);
// -- or use gpMySettings.FBkColour:=FNewValue;
end;
end;
In Delphi 7, descend a new component from TGraphicControl, and add a TFont property, implement the paint method to write some string using the TFont property. Install the component.
At design time when you change the TFont property using the property dialog, it will be reflected in your component instantaneously. But when you change individual properties of TFont like Color or Size, your component will not be repainted until you hover over it.
How do I correctly handle changes in fields of object properties?
Assign an event handler to the TFont.OnChange event. In the handler, Invalidate() your control to trigger a repaint. For example:
type
TMyControl = class(TGraphicControl)
private
FMyFont: TFont;
procedure MyFontChanged(Sender: TObject);
procedure SetMyFont(Value: TFont);
protected
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property MyFont: TFont read FMyFont write SetMyFont;
end;
constructor TMyControl.Create(AOwner: TComponent);
begin
inherited;
FMyFont := TFont.Create;
FMyFont.OnChange := MyFontChanged;
end;
destructor TMyControl.Destroy;
begin
FMyFont.Free;
inherited;
end;
procedure TMyControl.MyFontChanged(Sender: TObject);
begin
Invalidate;
end;
procedure TMyControl.SetMyFont(Value: TFont);
begin
FMyFont.Assign(Value);
end;
procedure TMyControl.Paint;
begin
// use MyFont as needed...
end;
Overview
I have a TCustomControl I am working on in Lazarus and outside of this class I have a separate TPersistent class which will be used for some properties.
The TPersistent class when published from the TCustomControl should show in the Object Inspector as sub-properties as I don't want certain properties to be shown from the top level, basically this is putting some properties into its own group within the TCustomControl.
The structure of this code is as follows:
type
TMyControlHeaderOptions = class(TPersistent)
private
FOnChange: TNotifyEvent;
FHeight: Integer;
FVisible: Boolean;
procedure SetHeight(const Value: Integer);
procedure SetVisible(const Value: Boolean);
protected
procedure Changed;
public
constructor Create(AOwner: TComponent); virtual;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
published
property Height: Integer read FHeight write SetHeight default 20;
property Visible: Boolean read FVisible write SetVisible default True;
end;
TMyControl = class(TCustomControl)
private
FHeaderOptions: TMyControlHeaderOptions;
procedure SetHeaderOptions(const Value: TMyControlHeaderOptions);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Align;
property BorderStyle default bsSingle;
property HeaderOptions: TMyControlHeaderOptions read FHeaderOptions write SetHeaderOptions;
end;
Here is the code for TMyControlHeaderOptions:
constructor TMyControlHeaderOptions.Create(AOwner: TComponent);
begin
FHeight := 20;
FVisible := True;
end;
destructor TMyControlHeaderOptions.Destroy;
begin
inherited Destroy;
end;
// this method never fires (see TMyControl.SetHeaderOptions)
procedure TMyControlHeaderOptions.Assign(Source: TPersistent);
begin
if (Source is TMyControlHeaderOptions) then
begin
FHeight := (Source as TMyControlHeaderOptions).Height;
FVisible := (Source as TMyControlHeaderOptions).Visible;
end
else
inherited Assign(Source);
end;
procedure TMyControlHeaderOptions.Changed;
begin
if Assigned(FOnChange) then
begin
FOnChange(Self);
end;
end;
procedure TMyControlHeaderOptions.SetHeight(const Value: Integer);
begin
if Value <> FHeight then
begin
FHeight := Value;
Changed;
end;
end;
procedure TMyControlHeaderOptions.SetVisible(const Value: Boolean);
begin
if Value <> FVisible then
begin
FVisible := Value;
Changed;
end;
end;
And the TCustomControl code:
constructor TMyControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FHeaderOptions := TMyControlHeaderOptions.Create(Self);
Self.ControlStyle := Self.ControlStyle + [csAcceptsControls];
Self.BorderStyle := bsSingle;
Self.Height := 200;
Self.Width := 250;
end;
destructor TMyControl.Destroy;
begin
FHeaderOptions.Free;
inherited Destroy;
end;
// this method never fires which is why TMyControlHeaderOptions.Assign
// never fires either. So the task is understanding and solving why this
// procedure never gets fired?
procedure TMyControl.SetHeaderOptions(const Value: TMyControlHeaderOptions);
begin
FHeaderOptions.Assign(Value);
end;
Problem
The property HeaderOptions never triggers or gets fired at designtime or runtime and I just can't understand or see why not? As you can see from the comments included in the code above SetHeaderOptions doesn't appear to be doing anything at all, it never responds to changes made at designtime or runtime.
I don't have Delphi installed to compare or test with but the code has been taken from custom controls I had been previously working on and I am pretty much certain it should work, I don't seem to have missed anything out that I can see. My only assumption at this point is the differences in Lazarus and Delphi and so the problem possibly lies within Lazarus?
Question
So my question is why does the property setter HeaderOptions never get fired and what can be done to make sure it does?
I sense something simple or obvious but I just cannot figure out what it is.
When you change a property inside this TPersistent, it fires the property setter of that particular property. It's not supposed to call the setter of the TPersistent itself. That only occurs in two scenarios: a) When the DFM is streamed in on creation, or b) when you manually assign a new value to the actual TPersistent. If you want to capture when any property is changed, you need to capture on each property individually, perhaps triggering an OnChange notify event which feeds back to its owner. That's actually how things such as the TFont or TStrings work.
Take a look at some of the built-in classes, such as TFont and TStrings - they use a TNotifyEvent named OnChange to handle such changes.
I am still perplexed as to why this was not working in Lazarus as I am almost certain it did work in Delphi.
I managed to come up with a workaround in the meantime:
TMyControl = class(TCustomControl)
private
FHeaderOptions: TMyControlHeaderOptions;
procedure HeaderOptionsChanged(Sender: TObject); // added this line
procedure SetHeaderOptions(const Value: TMyControlHeaderOptions); // removed this procedure
published
property Align;
property BorderStyle default bsSingle;
property HeaderOptions: TMyControlHeaderOptions read FHeaderOptions write FHeaderOptions; // changed this
end;
Then added this in the constructor:
constructor TMyControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FHeaderOptions := TMyControlHeaderOptions.Create(Self);
FHeaderOptions.OnChange := #HeaderOptionsChanged; // added this line
Self.ControlStyle := Self.ControlStyle + [csAcceptsControls];
Self.BorderStyle := bsSingle;
Self.Height := 200;
Self.Width := 250;
end;
Code for the new HeaderOptionsChanged procedure:
procedure TMyControl.HeaderOptionsChanged(Sender: TObject);
begin
// header options changed
Invalidate;
end;
I have my own component (TNiftyRVFrameWithPopups) with a TOwnedCollection as a property (TagList).
Every time I add items to TagList the same item should be added to another object (FMenu). This is performed by the procedure RefreshMenu called from TNiftyRVFrameWithPopups.Loaded on design time.
My issue is I cannot add items on runtime, because TNiftyRVFrameWithPopups.Loaded is not called.
I thought one solution would be Postmessage but I didn't manage to make it work.
The following is the source:
TNiftyListTag = class(TCollectionItem)
private
FTagValue: string;
FDisplayTextTag: string;
public
procedure Assign(Source: TPersistent); override;
published
property DisplayTag: string read FDisplayTextTag write FDisplayTextTag;
property Value: string read FTagValue write FTagValue;
end;
TNiftyListTags = class(TOwnedCollection)
protected
function GetItem(Index: Integer): TNiftyListTag;
procedure SetItem(Index: Integer; Value: TNiftyListTag);
public
constructor Create(AOwner: TPersistent; ItemClass: TCollectionItemClass);
function Add: TNiftyListTag;
end;
TNiftyRVFrameWithPopups = class(TRVEditFrame)
private
FMenu: TAdvSmoothListBox;
FMenuList: TStringList;
FCollectionTags: TNiftyListTags;
procedure SetCollectionTags(const Value: TNiftyListTags);
procedure RefreshMenu;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
procedure Loaded; override;
published
property TagList: TNiftyListTags read FCollectionTags write SetCollectionTags;
end;
implementation
constructor TNiftyRVFrameWithPopups.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FMenuList := TStringList.Create;
FCollectionTags := TNiftyListTags.Create(Self, TNiftyListTag);
end;
procedure TNiftyRVFrameWithPopups.SetCollectionTags(const Value: TNiftyListTags);
begin
FCollectionTags.Assign(Value);
end;
procedure TNiftyRVFrameWithPopups.RefreshMenu;
var
i: Integer;
begin
FMenu.Items.Clear;
for i := 0 to FCollectionTags.Count - 1 do
begin
FMenu.Items.Add;
FMenu.Items.Items[i].Caption := FCollectionTags.Items[i].FDisplayTextTag;
end;
end;
procedure TNiftyRVFrameWithPopups.Loaded;
begin
inherited Loaded;
if Assigned(FRVEditor) then
begin
RefreshMenu;
end;
end;
{ TNiftyListTag }
procedure TNiftyListTag.Assign(Source: TPersistent);
begin
if Source is TNiftyListTag then
begin
FTagValue := TNiftyListTag(Source).FTagValue;
FDisplayTextTag := TNiftyListTag(Source).FDisplayTextTag;
end
else
inherited;
end;
{ TNiftyListTags }
function TNiftyListTags.Add: TNiftyListTag;
begin
Result := TNiftyListTag(inherited Add);
end;
constructor TNiftyListTags.Create(AOwner: TPersistent; ItemClass: TCollectionItemClass);
begin
inherited Create(AOwner, ItemClass);
end;
procedure TNiftyListTags.SetItem(Index: Integer; Value: TNiftyListTag);
begin
inherited SetItem(index, Value);
end;
function TNiftyListTags.GetItem(Index: Integer): TNiftyListTag;
begin
Result := TNiftyListTag(inherited GetItem(Index));
end;
EDIT
After Deltics' advice I have amended my code:
TNiftyListTag = class(TCollectionItem)
private
FTagValue: string;
FDisplayTextTag: string;
public
procedure Assign(Source: TPersistent); override;
published
property DisplayTag: string read FDisplayTextTag write FDisplayTextTag;
property Value: string read FTagValue write FTagValue;
end;
TNiftyListTags = class(TOwnedCollection)
private
fOnChanged: TNotifyEvent;
procedure DoOnChanged;
protected
function GetItem(Index: Integer): TNiftyListTag;
procedure SetItem(Index: Integer; Value: TNiftyListTag);
public
constructor Create(AOwner: TPersistent; ItemClass: TCollectionItemClass);
function Add: TNiftyListTag;
procedure AppendItem(const aDisplayText, aTag: string);
end;
TNiftyRVFrameWithPopups = class(TRVEditFrame)
private
FMenu: TAdvSmoothListBox;
FMenuList: TStringList;
FCollectionTags: TNiftyListTags;
procedure RefreshMenu;
procedure SetCollectionTags(const Value: TNiftyListTags);
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Loaded; override;
published
property TagList: TNiftyListTags read FCollectionTags write SetCollectionTags;
end;
implementation
constructor TNiftyRVFrameWithPopups.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FMenuList := TStringList.Create;
FCollectionTags := TNiftyListTags.Create(Self, TNiftyListTag);
FCollectionTags.fOnChanged := RefreshMenu;
end;
destructor TNiftyRVFrameWithPopups.Destroy;
begin
FreeAndNil(FMenuList);
FCollectionTags.Free;
inherited;
end;
procedure TNiftyRVFrameWithPopups.RefreshMenu;
var
i: Integer;
begin
FMenu.Items.Clear;
for i := 0 to FCollectionTags.Count - 1 do
begin
FMenu.Items.Add;
FMenu.Items.Items[i].Caption := FCollectionTags.Items[i].FDisplayTextTag;
end;
end;
procedure TNiftyRVFrameWithPopups.Loaded;
begin
inherited Loaded;
RefreshMenu(Self);
end;
procedure TNiftyRVFrameWithPopups.RefreshMenu;
var
i: Integer;
begin
if Assigned(FRVEditor) then
begin
(FRVEditor as TCustomRichViewEdit).OnRVMouseUp := OnMouseUp;
FMenu.Parent := FRVEditor;
fmenu.Items.Clear;
for i := 0 to FCollectionTags.Count - 1 do
begin
FMenu.Items.Add;
FMenu.Items.Items[i].Caption := FCollectionTags.Items[i].FDisplayTextTag;
end;
end;
end;
procedure TNiftyRVFrameWithPopups.SetCollectionTags(const Value: TNiftyListTags);
begin
FCollectionTags.Assign(Value);
end;
{ TNiftyListTag }
procedure TNiftyListTag.Assign(Source: TPersistent);
begin
if Source is TNiftyListTag then
begin
FTagValue := TNiftyListTag(Source).FTagValue;
FDisplayTextTag := TNiftyListTag(Source).FDisplayTextTag;
end
else
inherited;
end;
{ TNiftyListTags }
function TNiftyListTags.Add: TNiftyListTag;
begin
Result := TNiftyListTag(inherited Add);
end;
procedure TNiftyListTags.AppendItem(const aDisplayText, aTag: string);
var
a: TNiftyListTag;
begin
a := TNiftyListTag(inherited Add);
a.FTagValue := aTag;
a.FDisplayTextTag := aDisplayText;
DoOnChanged;
end;
constructor TNiftyListTags.Create(AOwner: TPersistent; ItemClass: TCollectionItemClass);
begin
inherited Create(AOwner, ItemClass);
end;
procedure TNiftyListTags.DoOnChanged;
begin
if Assigned(fOnChanged) then
fOnChanged(self);
end;
procedure TNiftyListTags.SetItem(Index: Integer; Value: TNiftyListTag);
begin
inherited SetItem(index, Value);
end;
function TNiftyListTags.GetItem(Index: Integer): TNiftyListTag;
begin
Result := TNiftyListTag(inherited GetItem(Index));
end;
procedure TNiftyListTags.SetItem(Index: Integer; Value: TNiftyListTag);
begin
inherited SetItem(index, Value);
DoOnChanged;
end;
end.
Items can be added at run time in the following way:
var
a:TNiftyRVFrameWithPopups;
begin
a:=TNiftyRVFrameWithPopups.Create(self);
.....
a.TagList.AppendItem('a','b');
a.TagList.AppendItem('c','d');
end
Your TNiftyListTags is owned by the TNiftyRVFrameWithPopups.
Your only 'problem' is that the TOwnedCollection class does not provide a typed reference to the owner, by which to invoke the necessary method(s) to refresh the owner when the collection changes.
There are a number of ways to achieve what you want. However, before presenting options, whatever you do I suggest you do not call Loaded to achieve your update/refresh since this method has specific meaning. Whilst your code in the overridden method may be safe in this context, the inherited implementation may not be.
I would suggest moving the if Assigned(fRVEditor) pre-condition check to RefreshMenu itself. Loaded then simply calls RefreshMenu as may any other code that may need to also call RefreshMenu, with the necessary pre-condition checked by the method itself.
Now, as for how and when to call the RefreshMenu method, one simple mechanism is to directly invoke the refresh method whenever the content of the collection changes. e.g. in the Add method of the collection. Since you are using a TOwnedCollection as the base class, you could simply type-cast the Owner:
function TNiftyListTags.Add: TNiftyListTag;
begin
Result := TNiftyListTag(inherited Add);
TNiftyRVFrameWithPopups(Owner).RefreshMenu;
end;
However, this couples your collection class directly to the specific component acting as the owner. If your collection is specialised to this class specifically then this may be valid, but it is still undesirable.
To de-couple the collection from the component you could alternatively introduce an OnChange event on the collection. A simple TNotifyEvent will usually suffice.
Whichever component then owns the collection may then install a handler for this event. Whenever the collection changes, invoke the OnChange handler. In this case the TNiftyRVFrameWithPopups component will respond to those changes by calling its own RefreshMenu method.
procedure TNiftyListTags.DoOnChanged;
begin
if Assigned(fOnChanged) then
fOnChanged(self);
end;
function TNiftyListTags.Add: TNiftyListTag;
begin
Result := TNiftyListTag(inherited Add);
DoOnChanged;
end;
procedure TNiftyRVFrameWithPopups.OnTagsChanged(Sender: TObject);
begin
RefreshMenu;
end;
This is typically the approach I adopt and I make the OnChange event a private implementation detail, with the handler specified in the constructor by the component instantiating the collection. This prevents anyone from inadvertently replacing the event handler via any public property etc.
constructor TNiftyRVFrameWithPopups.Create(Owner: TComponent);
begin
inherited Create(self);
fTags := TNiftyListTags.Create(self, OnTagsChanged);
..
end;
To facilitate this you obviously need a custom constructor to accept the event handler:
TNiftyListTags = class(TOwnedCollection)
..
private
fOnChanged: TNotifyEvent;
public
constructor Create(aOwner: TPersistent; aOnChange: TNotifyEvent); reintroduce;
..
end;
constructor TNiftyListTags.Create(aOwner: TPersistent;
aOnChange: TNotifyEvent);
begin
inherited Create(aOwner, TNiftyListTag);
fOnChange := aOnChange;
end;
Note that the inherited constructor also accepts two parameters, the second being the class of the collection items. Sine you are introducing a custom constructor you can remove this from the parameters of your own constructor and simply specify the item class in the inherited Create call.
NOTE: This does not increase the coupling between the collection and the item class - they are already tightly coupled, by definition (and design).
What do I need to do for adding actions support to my component. It is a button component but I guess it is the same for whatever component type it is. Any information or how to will help.
That depends on how you define action support. There is two kinds:
A possibly customized Action property of your component, which is assignable by an Action component
The Action component itself.
An action property
Every TControl descendant has an Action property which execution is by default linked to a left mouse button click. This link is managed by an ActionLink. The default ActionLink is of the type TControlActionLink which takes care of the synchronization of the caption, the hint, the enabled state, etc... of both the Action and that of the Control. If this basis functionality is all that you want, then simply publish the Action property in your component type declaration and the Delphi framework takes care of all, like Serg and LU RD already answered.
If you want your own Action property to be linked to some other condition or event (i.e. other than Click), or if you want to implement an Action property for a specific sub element of your component (that is not a TControl descendant), then you can implement your own custom Action property by defining and implementing a custom ActionLink class.
Suppose your component is some kind of grid which has columns and you want every column to have an action property that should be invoked when the user clicks the title of a column. Since such columns are likely to be of a TCollectionItem type, the column type does not have an action property by default. So you have to implement one yourself. Consider the next example which links the action's caption to the column's title, links the action's enabled state inversely to the column's readonly property and so on...:
unit Unit1;
interface
uses
Classes, ActnList, SysUtils;
type
TColumn = class;
TColumnActionLink = class(TActionLink)
protected
FClient: TColumn;
procedure AssignClient(AClient: TObject); override;
function IsCaptionLinked: Boolean; override;
function IsEnabledLinked: Boolean; override;
function IsOnExecuteLinked: Boolean; override;
function IsVisibleLinked: Boolean; override;
procedure SetCaption(const Value: String); override;
procedure SetEnabled(Value: Boolean); override;
procedure SetOnExecute(Value: TNotifyEvent); override;
procedure SetVisible(Value: Boolean); override;
end;
TColumnActionLinkClass = class of TColumnActionLink;
TColumn = class(TCollectionItem)
private
FActionLink: TColumnActionLink;
FGrid: TComponent;
FOnTitleClick: TNotifyEvent;
FReadOnly: Boolean;
FTitle: String;
FVisible: Boolean;
function DefaultTitleCaption: String;
procedure DoActionChange(Sender: TObject);
function GetAction: TBasicAction;
function IsOnTitleClickStored: Boolean;
function IsReadOnlyStored: Boolean;
function IsVisibleStored: Boolean;
procedure SetAction(Value: TBasicAction);
protected
procedure ActionChanged(Sender: TObject; CheckDefaults: Boolean); dynamic;
procedure DoTitleClick; virtual;
function GetActionLinkClass: TColumnActionLinkClass; virtual;
property ActionLink: TColumnActionLink read FActionLink write FActionLink;
public
destructor Destroy; override;
procedure InitiateAction; virtual;
published
property Action: TBasicAction read GetAction write SetAction;
property OnTitleClick: TNotifyEvent read FOnTitleClick write FOnTitleClick
stored IsOnTitleClickStored;
property ReadOnly: Boolean read FReadOnly write FReadOnly
stored IsReadOnlyStored;
property Title: String read FTitle write FTitle;
property Visible: Boolean read FVisible write FVisible
stored IsVisibleStored;
end;
implementation
{ TColumnActionLink }
procedure TColumnActionLink.AssignClient(AClient: TObject);
begin
FClient := TColumn(AClient);
end;
function TColumnActionLink.IsCaptionLinked: Boolean;
begin
Result := inherited IsCaptionLinked and (Action is TCustomAction) and
(FClient.Title = TCustomAction(Action).Caption);
end;
function TColumnActionLink.IsEnabledLinked: Boolean;
begin
Result := inherited IsEnabledLinked and (Action is TCustomAction) and
(FClient.ReadOnly <> TCustomAction(Action).Enabled);
end;
function TColumnActionLink.IsOnExecuteLinked: Boolean;
begin
Result := inherited IsOnExecuteLinked and
(#FClient.OnTitleClick = #Action.OnExecute);
end;
function TColumnActionLink.IsVisibleLinked: Boolean;
begin
Result := inherited IsVisibleLinked and (Action is TCustomAction) and
(FClient.Visible = TCustomAction(Action).Visible);
end;
procedure TColumnActionLink.SetCaption(const Value: string);
begin
if IsCaptionLinked then
FClient.Title := Value;
end;
procedure TColumnActionLink.SetEnabled(Value: Boolean);
begin
if IsEnabledLinked then
FClient.ReadOnly := not Value;
end;
procedure TColumnActionLink.SetOnExecute(Value: TNotifyEvent);
begin
if IsOnExecuteLinked then
FClient.OnTitleClick := Value;
end;
procedure TColumnActionLink.SetVisible(Value: Boolean);
begin
if IsVisibleLinked then
FClient.Visible := Value;
end;
{ TColumn }
procedure TColumn.ActionChanged(Sender: TObject; CheckDefaults: Boolean);
begin
if Sender is TCustomAction then
with TCustomAction(Sender) do
begin
if not CheckDefaults or (Caption = DefaultTitleCaption) then
FTitle := Caption;
if not CheckDefaults or (not ReadOnly) then
ReadOnly := not Enabled;
if not CheckDefaults or not Assigned(FOnTitleClick) then
FOnTitleClick := OnExecute;
if not CheckDefaults or (Self.Visible = True) then
Self.Visible := Visible;
Changed(False);
end;
end;
function TColumn.DefaultTitleCaption: String;
begin
Result := 'Column' + IntToStr(Index);
end;
destructor TColumn.Destroy;
begin
FreeAndNil(FActionLink);
inherited Destroy;
end;
procedure TColumn.DoActionChange(Sender: TObject);
begin
if Sender = Action then
ActionChanged(Sender, False);
end;
procedure TColumn.DoTitleClick;
begin
if Assigned(FOnTitleClick) then
if (Action <> nil) and (#FOnTitleClick <> #Action.OnExecute) then
FOnTitleClick(Self)
else if FActionLink = nil then
FOnTitleClick(Self)
else if FActionLink <> nil then
if (FGrid <> nil) and not (csDesigning in FGrid.ComponentState) then
begin
if not FActionLink.Execute(FGrid) then
FOnTitleClick(Self);
end
else
if not FActionLink.Execute(nil) then
FOnTitleClick(Self);
end;
function TColumn.GetAction: TBasicAction;
begin
if FActionLink <> nil then
Result := FActionLink.Action
else
Result := nil;
end;
function TColumn.GetActionLinkClass: TColumnActionLinkClass;
begin
Result := TColumnActionLink;
end;
procedure TColumn.InitiateAction;
begin
if FActionLink <> nil then
FActionLink.Update;
end;
function TColumn.IsOnTitleClickStored: Boolean;
begin
Result := (FActionLink = nil) or not ActionLink.IsOnExecuteLinked;
end;
function TColumn.IsReadOnlyStored: Boolean;
begin
Result := (FActionLink = nil) or not FActionLink.IsEnabledLinked;
if Result then
Result := FReadOnly;
end;
function TColumn.IsVisibleStored: Boolean;
begin
Result := (FActionLink = nil) or not FActionLink.IsVisibleLinked;
if Result then
Result := not Visible;
end;
procedure TColumn.SetAction(Value: TBasicAction);
begin
if Value = nil then
FreeAndNil(FActionLink)
else
begin
if FActionLink = nil then
FActionLink := GetActionLinkClass.Create(Self);
FActionLink.Action := Value;
FActionLink.OnChange := DoActionChange;
ActionChanged(Value, csLoading in Value.ComponentState);
if FGrid <> nil then
Value.FreeNotification(FGrid);
end;
Changed(False);
end;
end.
Note that this code is stripped to only the applicable action parts.
Source: www.nldelphi.com.
An action component
An action component is assignable to the action property of an arbitrary component. But since explaining all that is involved with writing such an action component is pretty comprehensive, I will make it easy for myself in providing the example below.
Suppose you want to make a control that provides zoom capabilities and that you also want the corresponding ZoomIn and ZoomOut actions that can be assigned to toolbar buttons.
unit Zoomer;
interface
uses
Classes, Controls, ActnList, Forms, Menus, Windows;
type
TZoomer = class;
TZoomAction = class(TCustomAction)
private
FZoomer: TZoomer;
procedure SetZoomer(Value: TZoomer);
protected
function GetZoomer(Target: TObject): TZoomer;
procedure Notification(AComponent: TComponent; Operation: TOperation);
override;
public
destructor Destroy; override;
function HandlesTarget(Target: TObject): Boolean; override;
procedure UpdateTarget(Target: TObject); override;
published
property Caption;
property Enabled;
property HelpContext;
property HelpKeyword;
property HelpType;
property Hint;
property ImageIndex;
property ShortCut;
property SecondaryShortCuts;
property Visible;
property OnExecute; { This property could be omitted. But if you want to be
able to override the default behavior of this action
(zooming in on a TZoomer component), then you need to
assign this event. From within the event handler
you could invoke the default behavior manually. }
property OnHint;
property OnUpdate;
property Zoomer: TZoomer read FZoomer write SetZoomer;
end;
TZoomInAction = class(TZoomAction)
public
constructor Create(AOwner: TComponent); override;
procedure ExecuteTarget(Target: TObject); override;
end;
TZoomer = class(TCustomControl)
public
procedure ZoomIn;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('RoyMKlever', [TZoomer]);
RegisterActions('Zoomer', [TZoomInAction], nil);
end;
{ TZoomAction }
destructor TZoomAction.Destroy;
begin
if FZoomer <> nil then
FZoomer.RemoveFreeNotification(Self);
inherited Destroy;
end;
function TZoomAction.GetZoomer(Target: TObject): TZoomer;
begin
if FZoomer <> nil then
Result := FZoomer
else if (Target is TZoomer) and TZoomer(Target).Focused then
Result := TZoomer(Target)
else if Screen.ActiveControl is TZoomer then
Result := TZoomer(Screen.ActiveControl)
else
{ This should not happen! HandlesTarget is called before ExecuteTarget,
or the action is disabled }
Result := nil;
end;
function TZoomAction.HandlesTarget(Target: TObject): Boolean;
begin
Result := ((FZoomer <> nil) and FZoomer.Enabled) or
((FZoomer = nil) and (Target is TZoomer) and TZoomer(Target).Focused) or
((Screen.ActiveControl is TZoomer) and Screen.ActiveControl.Enabled);
end;
procedure TZoomAction.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FZoomer) then
FZoomer := nil;
end;
procedure TZoomAction.SetZoomer(Value: TZoomer);
begin
if FZoomer <> Value then
begin
if FZoomer <> nil then
FZoomer.RemoveFreeNotification(Self);
FZoomer := Value;
if FZoomer <> nil then
FZoomer.FreeNotification(Self);
end;
end;
procedure TZoomAction.UpdateTarget(Target: TObject);
begin
Enabled := HandlesTarget(Target);
end;
{ TZoomInAction }
constructor TZoomInAction.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Caption := 'Zoom in';
Hint := 'Zoom in|Zooms in on the selected zoomer control';
ShortCut := Menus.ShortCut(VK_ADD, [ssCtrl]);
end;
procedure TZoomInAction.ExecuteTarget(Target: TObject);
begin
GetZoomer(Target).ZoomIn;
{ For safety, you cóuld check if GetZoomer <> nil. See remark in GetZoomer. }
end;
{ TZoomer }
procedure TZoomer.ZoomIn;
begin
{ implementation of zooming in }
end;
end.
Activating this action (with a click on a toolbar button, or choosing a menu item) calls in the following priority the ZoomIn routine of:
the Zoomer control that you manually have set in the relating property of the action, if done so, and if the action is enabled, otherwise:
the by the application requested Target, but only if that target is a focused Zoomer control, or otherwise:
the active control in the entire application, but only if that is an enabled Zoomer control.
Subsequently, the ZoomOut action is simply added:
type
TZoomOutAction = class(TZoomAction)
public
constructor Create(AOwner: TComponent); override;
procedure ExecuteTarget(Target: TObject); override;
end;
{ TZoomOutAction }
constructor TZoomOutAction.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Caption := 'Zoom out';
Hint := 'Zoom out|Zooms out on the selected zoomer control';
ShortCut := Menus.ShortCut(VK_SUBTRACT, [ssCtrl]);
end;
procedure TZoomOutAction.ExecuteTarget(Target: TObject);
begin
GetZoomer(Target).ZoomOut;
end;
Note that action components require registration in the IDE for being able to use them design time.
Applicable read food in the Delphi help:
Writing action components,
How actions find their targets,
Registering actions,
What happens when an action fires,
Updating actions,
Setting up action lists.
Source: www.nldelphi.com.
Basic action support is implemented in TControl class, so in the most simple case all you have to do is to inherit your component from TControl descendant and declare Action property as published, ex:
type
TMyGraphicControl = class(TGraphicControl)
published
property Action;
end;
If your component has additional properties that should be linked to TAction properties you should also override ActionChange method.
If your component is already a descendant of TButton then the action support is inherited.
All you need to do is declare the action property as published.