How to make subcomponent TAction-s available at design time? - delphi

In my custom component I created some TAction-s as subcomponents. They're all published, but I could not assign them at design time since they were not available through object inspector.
How do you make them "iterable" by the object inspector? I have tried to set the Owner of the actions to the Owner of the custom component (which is the hosting Form) to no success.
EDIT: It looks like Embarcadero changed Delphi IDE behaviour related with this problem. If you are using Delphi versions prior XE, you should use solution from my own answer. For XE and above, you should use solution from Craig Peterson.
EDIT: I've added my own answer that solves the problem, i.e. by creating a TCustomActionList instance in my custom component and setting its Owner to the hosting form (owner of the custom component). However I am not too happy with this solution, since I think the instance of TCustomActionList is kind of redundant. So I am still hoping to get better solution.
EDIT: Add code sample
uses
.., ActnList, ..;
type
TVrlFormCore = class(TComponent)
private
FCancelAction: TBasicAction;
FDefaultAction: TBasicAction;
FEditAction: TBasicAction;
protected
procedure DefaultActionExecute(ASender: TObject); virtual;
procedure CancelActionExecute(ASender: TObject); virtual;
procedure EditActionExecute(ASender: TObject); virtual;
public
constructor Create(AOwner: TComponent); override;
published
property DefaultAction: TBasicAction read FDefaultAction;
property CancelAction : TBasicAction read FCancelAction;
property EditAction : TBasicAction read FEditAction;
end;
implementation
constructor TVrlFormCore.Create(AOwner: TComponent);
begin
inherited;
FDefaultAction := TAction.Create(Self);
with FDefaultAction as TAction do
begin
SetSubComponent(True);
Caption := 'OK';
OnExecute := DefaultActionExecute;
end;
FCancelAction := TAction.Create(Self);
with FCancelAction as TAction do
begin
SetSubComponent(True);
Caption := 'Cancel';
OnExecute := Self.CancelActionExecute;
end;
FEditAction := TAction.Create(Self);
with FEditAction as TAction do
begin
SetSubComponent(True);
Caption := 'Edit';
OnExecute := Self.EditActionExecute;
end;
end;

As far as I can tell you're not supposed to do it that way.
The easy way to do what you want is to create new standalone actions that can work with any TVrlFormCore component and set the target object in the HandlesTarget callback. Take a look in StdActns.pas for examples. The actions won't be available automatically when sommeone drops your component on the form, but they can add them to their action list manually using the New Standard Actions... command. There's a good article on registering standard actions here.
If you really want to auto-create the actions you need to set the action Owner property to the form and you need to set the Name property. That's all that's necessary, but it does introduce a bunch of issues you need to work around:
The form owns the actions so it will add them its declaration's published section and will auto-create them as part of the streaming process. To work around that you can just disable streaming by overwriting the action's WriteState method and skip the inherited behavior.
Since you aren't writing the state, none of the properties will be persisted. To avoid confusing your users you should switch make the actions descend from TCustomAction instead of TAction, so it doesn't expose anything. There may be way to make the action stream properly, but you didn't say whether it was necessary.
You need to register for free notifications in case the form frees the action before you can.
If someone drops more than one of your component on the action names will conflict. There's multiple ways to handle that, but the cleanest would probably be to override the component's SetName method and use its name as a prefix for the actions' names. If you do that you need to use RegisterNoIcon with the new class so they don't show up on the form.
In the IDE's Structure pane the actions will show up directly under the form, rather than nested like ActionList shows. I haven't found a way around that; none of SetSubComponent, GetParentComponent/HasParent, or GetChildren have any effect, so this may be hard-coded behavior. You can delete the action from the structure pane, separate from the component, too.
I'm sure it can be improved, but this works without any custom property editors:
type
TVrlAction = class(TCustomAction)
protected
procedure WriteState(Writer: TWriter); override;
end;
TVrlFormCore = class(TComponent)
private
FDefaultAction: TVrlAction;
protected
procedure DefaultActionExecute(ASender: TObject); virtual;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure SetName(const NewName: TComponentName); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
public
property DefaultAction: TVrlAction read FDefaultAction;
end;
procedure Register;
implementation
// TVrlAction
procedure TVrlAction.WriteState(Writer: TWriter);
begin
// No-op
end;
// TVrlFormCore
constructor TVrlFormCore.Create(AOwner: TComponent);
begin
inherited;
FDefaultAction := TVrlAction.Create(AOwner);
with FDefaultAction do
begin
FreeNotification(Self);
Name := 'DefaultAction';
Caption := 'OK';
OnExecute := DefaultActionExecute;
end;
end;
destructor TVrlFormCore.Destroy;
begin
FDefaultAction.Free;
inherited;
end;
procedure TVrlFormCore.DefaultActionExecute(ASender: TObject);
begin
end;
procedure TVrlFormCore.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited;
if Operation = opRemove then
if AComponent = FDefaultAction then
FDefaultAction := nil;
end;
procedure TVrlFormCore.SetName(const NewName: TComponentName);
begin
inherited;
if FDefaultAction <> nil then
FDefaultAction.Name := NewName + '_DefaultAction';
end;
procedure Register;
begin
RegisterComponents('Samples', [TVrlFormCore]);
RegisterNoIcon([TVrlAction]);
end;

EDIT: Use this solution for Delphi versions prior to Delphi XE. For XE and later, use Craig Peterson answer (which does not require redundant TCustomActionList instance).
After meddling around and using information from Craig Peterson's answer, I've decided to instantiate a TCustomActionList in my custom component. So far it is the only way to get list of actions in Object Inspector.
Here is the code:
uses
..., ActnList, ...;
type
TVrlAction=class(TCustomAction)
protected
procedure WriteState(Writer: TWriter); override;
published
property Caption;
end;
TVrlActionList=class(TCustomActionList)
protected
procedure WriteState(Writer: TWriter); override;
end;
TVrlFormCore = class(TVrlItemSource)
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure SetName(const NewName: TComponentName); override;
public
constructor Create(AOwner: TComponent); override;
end;
implementation
{ TVrlAction }
procedure TVrlAction.WriteState(Writer: TWriter);
begin
end;
{ TVrlActionList }
procedure TVrlActionList.WriteState(Writer: TWriter);
begin
end;
{ TVrlFormCore }
constructor TVrlFormCore.Create(AOwner: TComponent);
begin
inherited;
FActions := TVrlActionList.Create(AOwner);
FDefaultAction := TVrlAction.Create(AOwner);
with FDefaultAction as TVrlAction do
begin
FreeNotification(Self);
Caption := 'OK';
OnExecute := DefaultActionExecute;
end;
FActions.AddAction(TContainedAction(FDefaultAction));
FCancelAction := TVrlAction.Create(AOwner);
with FCancelAction as TVrlAction do
begin
FreeNotification(Self);
Caption := 'Cancel';
OnExecute := Self.CancelActionExecute;
end;
FActions.AddAction(TContainedAction(FCancelAction));
FEditAction := TVrlAction.Create(AOwner);
with FEditAction as TVrlAction do
begin
FreeNotification(Self);
Caption := 'Edit';
OnExecute := Self.EditActionExecute;
end;
FActions.AddAction(TContainedAction(FEditAction));
end;
procedure TVrlFormCore.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited;
if Operation=opRemove then
begin
if AComponent = FMaster then
FMaster := nil
else if (AComponent is TVrlFormCore) then
FDetails.Remove(TVrlFormCore(AComponent))
else if AComponent=FDefaultAction then
FDefaultAction := nil
else if AComponent=FCancelAction then
FCancelAction := nil
else if AComponent=FEditAction then
FEditAction := nil;
end;
end;
procedure TVrlFormCore.SetName(const NewName: TComponentName);
begin
inherited;
if FActions<>nil then
FActions.Name := NewName + '_Actions';
if FDefaultAction <> nil then
FDefaultAction.Name := NewName + '_DefaultAction';
if FCancelAction <> nil then
FCancelAction.Name := NewName + '_CancelAction';
if FEditAction <> nil then
FEditAction.Name := NewName + '_EditAction';
end;

You cannot assign them because they are read only by design:
property DefaultAction: TBasicAction read FDefaultAction;
property CancelAction : TBasicAction read FCancelAction;
property EditAction : TBasicAction read FEditAction;
You should change your class' interface to:
property DefaultAction: TBasicAction read FDefaultAction write FDefaultAction;
property CancelAction : TBasicAction read FCancelAction write FCancelAction;
property EditAction : TBasicAction read FEditAction write FEditAction;
or write appropriate setter for each action.
Edit:
What you need is then
to implement your 3 custom actions as Predefined Actions (See StdActns.pas for samples).
to register them by calling ActnList.RegisterActions. (See RAD Studio documentation)
to add to the form a TActionList and/or TActionManager to allow your Predefined Actions appear in the list of predefined actions in the action list editor of every TControl's descendent.
You may do extensive search on google for the topic and find some concrete example.

Related

Delphi: delete inherited TStringGrid

I want to have a custom StringGrid element.
I created a class:
type
TClassStringGrid = class(TCustomControl)
...
with
constructor TClassStringGrid.Create(AOwner: TForm);
begin
inherited Create(nil);
myGroupBox1 := TGroupBox.Create(AOwner);
myGroupBox1.Parent := AOwner;
myStringGrid1 := TStringGrid.Create(self);
myStringGrid1.Parent := myGroupBox1;
myStringGrid1.Options := myStringGrid1.Options + [goEditing];
end;
destructor TClassStringGrid.Destroy;
begin
if myStringGrid1 <> nil then begin
FreeAndNil(myStringGrid1);
end;
if myGroupBox1 <> nil then begin
DestroyComponents;
FreeAndNil(myGroupBox1);
end;
// Call the parent class destructor
inherited;
end;
I created a class in Form1 and show it. It works. But if I put some value into the StringGrid (Form1) and then try to close Form1 I get an exception "the element has no parent window" in FreeAndNil(myStringGrid1);.
What is wrong by Destroy?
I would be thankfull for any information you can provide me.
Assuming you want to show a String grid in a Group box on this control, then this is how it should look like:
type
TMyStringGrid = class(TCustomControl)
private
FGroupBox: TGroupBox;
FStringGrid: TStringGrid;
public
constructor Create(AOwner: TComponent); override;
end;
constructor TMyStringGrid.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FGroupBox := TGroupBox.Create(Self);
FGroupBox.Parent := Self;
FStringGrid := TStringGrid.Create(Self);
FStringGrid.Parent := FGroupBox;
end;
In this manner, your newly designed control is owner and parent of the sub controls. Destruction is done automatically because of that.

Property setter never seems to fire in Lazarus?

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;

How to make my custom control be notified when his form or application receives and loses focus?

I want my control to receive distinct notifications only when it's parent form (not panel or something else, just the main form of this control) receives and loses focus. Doesn't matter if the focus is switched from another form of the application or between my application and other application, it must be received for both cases. Is it possible? I want to suspend some updates of the control when his form is not active and resume the updates when the form is activated.
Edit: In other words, the control must catch the (TForm.OnActivate + TApplication.OnActivate) and (TForm.OnDeactivate + TApplication.OnDeactivate)
Edit2: If it's not possible both, at least if I can make the control catch the events from TApplication. It's more important than those from TForm.
I want to suspend some updates of the control when his form is not active and resume the updates when the form is activated.
If those updates are done continuously, or are being triggered by a timer or actions, then you could be done with:
type
TMyControl = class(TControl)
private
procedure PerformUpdate;
end;
procedure TMyControl.PerformUpdate;
begin
if Application.Active and HasParent and GetParentForm(Self).Active then
//...
else
//...
end;
...at least if I can make the control catch the events from the application
Catching TApplication.OnActivate and TApplication.OnDeactivate is pretty easy with a TApplicationEvents component:
uses
Vcl.AppEvnts;
type
TMyControl = class(TControl)
private
FActive: Boolean;
FAppEvents: TApplicationEvents;
procedure ApplicationActiveChanged(Sender: TObject);
public
constructor Create(AOwner: TComponent); override;
end;
procedure TMyControl.ApplicationActiveChanged(Sender: TObject);
begin
FActive := Application.Active;
end;
constructor TMyControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FAppEvents := TApplicationEvents.Create(Self);
FAppEvents.OnActivate := ApplicationActiveChanged;
FAppEvents.OnDeactivate := ApplicationActiveChanged;
end;
...it's more important than those from the form
Catching the (de)activation of the parenting form can be done in Application.OnIdle. All this combined could result in something like this:
type
TMyControl = class(TControl)
private
FActive: Boolean;
FAppEvents: TApplicationEvents;
FParentForm: TCustomForm;
procedure ApplicationActiveChanged(Sender: TObject);
procedure ApplicationIdle(Sender: TObject; var Done: Boolean);
procedure UpdateActive;
protected
procedure SetParent(AParent: TWinControl); override;
public
constructor Create(AOwner: TComponent); override;
end;
procedure TMyControl.ApplicationActiveChanged(Sender: TObject);
begin
UpdateActive;
end;
procedure TMyControl.ApplicationIdle(Sender: TObject; var Done: Boolean);
begin
UpdateActive;
Done := True;
end;
constructor TMyControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FAppEvents := TApplicationEvents.Create(Self);
FAppEvents.OnActivate := ApplicationActiveChanged;
FAppEvents.OnDeactivate := ApplicationActiveChanged;
end;
procedure TMyControl.SetParent(AParent: TWinControl);
begin
inherited SetParent(AParent);
FParentForm := GetParentForm(Self);
end;
procedure TMyControl.UpdateActive;
var
SaveActive: Boolean;
begin
SaveActive := FActive;
FActive := Application.Active and (FParentForm <> nil) and FParentForm.Active;
if Application.Active then
FAppEvents.OnIdle := ApplicationIdle
else
FAppEvents.OnIdle := nil;
if FActive <> SaveActive then
Invalidate;
end;
Because using Application.OnIdle is quite a rigorous method, spare its use like I did above by only assigning it when necessary and speed up its implementation by caching function results like GetParentForm.

How to set CreateParams after the constructor has run?

TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
end;
TForm2 = class(TForm)
private
FAppWindow: Boolean;
protected
procedure CreateParams(var Params: TCreateParams); override;
public
property AppWindow: Boolean read FAppWindow write FAppWindow;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Form2 := TForm2.Create(Self);
Form2.AppWindow := True;
Form2.Show;
end;
procedure TForm2.CreateParams(var Params: TCreateParams);
begin
inherited;
if FAppWindow then begin
Params.Style := Params.Style or WS_EX_APPWINDOW;
Params.WndParent := 0;
end;
end;
This doesn't work, because the window handle is created during the constructor of TForm, so CreateParams is run too early and FAppWindow is always False.
Writing a custom constructor also doesn't work since you have to eventually call the inherited constructor which creates the handle before you can save any data to the instance:
constructor TForm2.CreateAppWindow(AOwner: TComponent);
begin
inherited Create(AOwner);
FAppWindow := True;
end;
Is there a way to:
Delay the creation of the window handle?
Alter the window style after creation of the window handle?
Recreate the window handle after the constructor has run?
Some other option I haven't thought of, yet?
How can I change the style of a form from the "outside" of the class?
The simplest solution is to pass the parameter to the form in its constructor, rather than wait until it has finished being created.
That means you need to introduce a constructor for TForm2 that accepts as parameters whatever information you need to pass on in CreateParams.
Make a note of any state before you call the inherited constructor. Also, there's no need to set WS_EX_APPWINDOW when you are setting the owner to be zero.
The nice thing about Delphi is that a derived constructor DOES NOT have to call the inherited constructor as its first statement. So you can set your FAppWindow member first, THEN call the inherited constructor to stream the DFM and create the window, eg:
procedure TForm1.FormCreate(Sender: TObject);
begin
Form2 := TForm2.CreateAppWindow(Self);
Form2.Show;
end;
constructor TForm2.CreateAppWindow(AOwner: TComponent);
begin
FAppWindow := True;
inherited Create(AOwner);
end;
This seems to work to recreate the handle, I got the idea from the RecreateAsPopup VCL method:
procedure TForm2.SetAppWindow(const Value: Boolean);
begin
FAppWindow := Value;
if HandleAllocated then
RecreateWnd
else
UpdateControlState;
end;

TComboBox 'Control has no parent window' in destructor

I'm using Delphi XE2. I build a custom TComboBox so that I can easily add key/string pairs and handle the cleanup in the component's destructor.
All if not (csDesigning in ComponentState) code is omitted for brevity.
interface
type
TKeyRec = class(TObject)
Key: string;
Value: string;
end;
TMyComboBox = class(TComboBox)
public
destructor Destroy; override;
procedure AddItemPair(const Key, Value: string);
end;
implementation
destructor TMyComboBox.Destroy;
var i: Integer;
begin
for i := 0 to Self.Items.Count - 1 do
Self.Items.Objects[i].Free;
Self.Clear;
inherited;
end;
procedure TMyComboBox.AddItemPair(const Key, Value: string);
var rec: TKeyRec;
begin
rec := TKeyRec.Create;
rec.Key := Key;
rec.Value := Value;
Self.Items.AddObject(Value, rec);
end;
When the application closes, the destructor is called, but the Items.Count property is inaccessible because the TComboBox must have a parent control to access this property. By the time the destructor is called, it no longer has a parent control.
I saw this problem once before and had to store the objects in a separate TList and free them separately. But that only worked because the order that I added them to the TList was always the same as the strings added to the combo box. When the user selected a string, I could use the combo box index to find the correlating object in the TList. If the combo box is sorted, then the indexes won't match, so I can't always use that solution.
Has anyone else seen this? How did you workaround the issue? It would be really nice to be able to free the objects in the component's destructor!
You can override function GetItemsClass:
function GetItemsClass: TCustomComboBoxStringsClass; override;
It is called by Combo to create Items (by default it is TComboBoxStrings probably).
Then you can create your own TComboBoxStrings descendant, for example TComboBoxStringObjects, where
you can free object linked with item (when item deleted).
After reading the link from Sertac (David Heffernan's comment and NGLN's answer), I believe a solution that stores the objects in a managed list and not in a GUI control is the best. To that end, I have create a combo box that descends from TCustomComboBox. This lets me promote all the properties except for Sorted to published. This keeps the internal FList in sync with the strings in the combo boxes Items property. I just make sure they are sorted the way I want before adding them...
The following shows what I did. I only included the essential code (less range checking) for brevity, but included some conditional logic that allows the combo box to be used without objects as well.
FList is properly destroyed in the destructor, freeing all objects without any run-time exceptions and the object list is managed within the component itself instead of having to manage it elsewhere -- making it very portable. It works when the control is added to a form at design-time, or when it is created at run-time. I hope this is useful to someone else!
interface
type
TMyComboBox = class(TCustomComboBox)
private
FList: TList;
FUsesObjects: Boolean;
function GetKey: string;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure AddItemPair(const Key, Value: string);
procedure ClearAllItems;
procedure DeleteItem(const Index: Integer);
property Key: string read GetKey;
published
// all published properties (except Sorted) from TComboBox
end;
implementation
type
TKeyRec = class(TObject)
Key: string;
Value: string;
end;
function TMyComboBox.GetKey: string;
begin
if not FUsesObjects then
raise Exception.Create('Objects are not used.');
Result := TKeyRec(FList.Items[ItemIndex]).Key;
end;
constructor TMyComboBox.Create(AOwner: TComponent);
begin
inherited;
if not (csDesigning in ComponentState) then
begin
FUsesObjects := False;
FList := TList.Create;
end;
end;
destructor TMyComboBox.Destroy;
begin
if not (csDesigning in ComponentState) then
begin
ClearAllItems;
FreeAndNil(FList);
end;
inherited;
end;
procedure TMyComboBox.AddItemPair(const Key, Value: string);
var rec: TKeyRec;
begin
FUsesObjects := True;
rec := TKeyRec.Create;
rec.Key := Key;
rec.Value := Value;
FList.Add(rec);
Items.Add(Value);
end;
procedure TMyComboBox.ClearAllItems;
var i: Integer;
begin
if not (csDesigning in ComponentState) then
begin
if FUsesObjects then
begin
for i := 0 to FList.Count - 1 do
TKeyRec(FList.Items[i]).Free;
FList.Clear;
end;
if not (csDestroying in ComponentState) then
Clear; // can't clear if the component is being destroyed or there is an exception, 'no parent window'
end;
end;
procedure TMyComboBox.DeleteItem(const Index: Integer);
begin
if FUsesObjects then
begin
TKeyRec(FList.Items[Index]).Free;
FList.Delete(Index);
end;
Items.Delete(Index);
end;
end.
There's a way that avoid the need of rewrite the component to use another list to save the objects. The solution is to use the WM_DESTROY message along with the ComponentState property.
When the component is about to be destroyed, its state change to csDestroying, so the next time it receives a WM_DESTROY message it will be not part of the window recreation process.
We use this method in our component library sucessfully.
TMyCombo = class(TCombobox)
...
procedure WMDestroy(var message: TMessage); message WM_DESTROY;
...
procedure TMyCombo.WMDestroy(var message: TMessage);
var
i: integer;
begin
if (csDestroying in ComponentState) then
for i:=0 to Items.Count - 1 do
Items.Objects[i].Free;
inherited;
end;

Resources