0
votes

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.

2
A property setter fires when you set that property, you never assign anything to 'HeaderOptions'.Sertac Akyuz
@SertacAkyuz, The line FHeaderOptions.Assign(Value); in the TMyControl.SetHeaderOptions procedure should call the overrided Assign in the TMyControlHeaderOptions class.Craig
the property is HeaderOptions, not FHeaderOptions.Sertac Akyuz

2 Answers

3
votes

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.

-1
votes

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;