Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Creating custom TSetProperty property editor

Tags:

delphi

I'm trying to create a custom property editor for some custom component. The custom property editor is intended to edit some set property, like

type
  TButtonOption = (boOption1, boOption2, boOption3);
  TButtonOptions = set of TButtonOption;

my property editor descends from TSetProperty class. The problem is: my custom property editor doesn't get registered and Delphi IDE seems to use its own default set property editor, because ShowMessage() calls inside property editor methods never executes! I've created a sample package/component from scratch, as simple as possible, showing this issue. Here is the code:

unit Button1;

interface

uses
  System.SysUtils, System.Classes, Vcl.Controls, Vcl.StdCtrls, DesignIntf, DesignEditors;

type
  TButtonOption = (boOption1, boOption2, boOption3);

  TButtonOptions = set of TButtonOption;

  TButtonEx = class(TButton)
  private
    FOptions: TButtonOptions;
    function GetOptions: TButtonOptions;
    procedure SetOptions(Value: TButtonOptions);
  published
    property Options: TButtonOptions read GetOptions write SetOptions default [];
  end;

  TMySetProperty = class(TSetProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetProperties(Proc: TGetPropProc); override;
    function GetValue: string; override;
  end;

procedure Register;

implementation

uses
  Dialogs;

// TButtonEx - sample component

function TButtonEx.GetOptions: TButtonOptions;
begin
  Result := FOptions;
end;

procedure TButtonEx.SetOptions(Value: TButtonOptions);
begin
  if FOptions <> Value then
  begin
    FOptions := Value;
  end;
end;

// register stuff

procedure Register;
begin
  RegisterComponents('Samples', [TButtonEx]);
  RegisterPropertyEditor(TypeInfo(TButtonOptions), nil, '', TMySetProperty);
end;

function TMySetProperty.GetAttributes: TPropertyAttributes;
begin
  ShowMessage('GetAttributes');
  Result := inherited GetAttributes;
end;

procedure TMySetProperty.GetProperties(Proc: TGetPropProc);
begin
  ShowMessage('GetProperties');
  inherited;
end;

function TMySetProperty.GetValue: string;
begin
  ShowMessage('GetValue');
  Result := inherited GetValue;
end;

end.

Please note that:

  1. I'm registering the new property editor (TMySetProperty) for ALL components having a TButtonOptions property. I also tried to do it for TButtonEx only, but the result is the same.
  2. I've added ShowMessage() calls inside all overriden methods of my custom property editor and those methods NEVER get called.
  3. I've already debugged the package and RegisterPropertyEditor() executes. Nevertheless, my custom code in overridden methods never execute.
  4. I've seen other 3rd party components using such property editor (TSetProperty descendants) running in older Delphi IDEs and I could not find any relevant difference in code. Maybe Delphi XE2+ requires something else?

So the question is: Why my custom property editor does not register/work?

Note: This issue happens in Delphi XE2, XE3, XE4 and also XE5 at least. Other IDEs were not tested but probably have the same behavior.

like image 436
Alexandre M Avatar asked Apr 08 '14 13:04

Alexandre M


1 Answers

Finally I got a solution... After testing everything I could imagine - without success - I started searching for something "new" in DesignEditors.pas and DesignIntf.pas units. Reading GetEditorClass() function, I discovered that it first checks for a PropertyMapper. A property mapper can be registered using RegisterPropertyMapper() function. Using it instead of RegisterPropertyEditor() works just as expected. Here is my modified, working code, also showing some interesting application for this: show or hide some options of my set-based property, based on some criteria:

unit Button1;

interface

uses
  System.SysUtils, System.Classes, Vcl.Controls, Vcl.StdCtrls,
  DesignIntf, DesignEditors;

type
  TButtonOption = (boOptionA, boOptionB, boOptionC);
  TButtonOptions = set of TButtonOption;

type
  TButtonEx = class(TButton)
  private
    FOptions: TButtonOptions;
    function GetOptions: TButtonOptions;
    procedure SetOptions(Value: TButtonOptions);
  published
    property Options: TButtonOptions read GetOptions write SetOptions default [];
  end;

  TMySetProperty = class(TSetProperty)
  private
    FProc: TGetPropProc;
    procedure InternalGetProperty(const Prop: IProperty);
  public
    procedure GetProperties(Proc: TGetPropProc); override;
  end;

procedure Register;

implementation

uses
  TypInfo;

// TButtonEx - sample component

function TButtonEx.GetOptions: TButtonOptions;
begin
  Result := FOptions;
end;

procedure TButtonEx.SetOptions(Value: TButtonOptions);
begin
  if FOptions <> Value then
  begin
    FOptions := Value;
  end;
end;

// Returns TMySetProperty as the property editor used for Options in TButtonEx class
function MyCustomPropMapper(Obj: TPersistent; PropInfo: PPropInfo): TPropertyEditorClass;
begin
  Result := nil;
  if Assigned(Obj) and (Obj is TButtonEx) and SameText(String(PropInfo.Name), 'Options') then begin
    Result := TMySetProperty;
  end;
end;

procedure Register;
begin
  RegisterComponents('Samples', [TButtonEx]);
  // RegisterPropertyEditor does not work for set-based properties.
  // We use RegisterPropertyMapper instead
  RegisterPropertyMapper(MyCustomPropMapper);
end;

procedure TMySetProperty.GetProperties(Proc: TGetPropProc);
begin
  // Save the original method received
  FProc := Proc;
  // Call inherited, but passing our internal method as parameter
  inherited GetProperties(InternalGetProperty);
end;

procedure TMySetProperty.InternalGetProperty(const Prop: IProperty);
var
  i: Integer;
begin
  if not Assigned(FProc) then begin   // just in case
    Exit;
  end;

  // Now the interesting stuff. I just want to show boOptionA and boOptionB in Object inspector
  // So I call the original Proc in those cases only
  // boOptionC still exists, but won't be visible in object inspector
  for i := 0 to PropCount - 1 do begin
    if SameText(Prop.GetName, 'boOptionA') or SameText(Prop.GetName, 'boOptionB') then begin
      FProc(Prop);       // call original method
    end;
  end;
end;

end.
like image 55
Alexandre M Avatar answered Oct 13 '22 17:10

Alexandre M