Recent

Author Topic: Nested/Sub Events property editor  (Read 4591 times)

siegfriedn

  • New member
  • *
  • Posts: 22
Nested/Sub Events property editor
« on: February 24, 2010, 11:40:36 pm »
Hi,

I am trying to create a property Editor for a class that has several event properties

e.g.
<code>
  TMyEvents = class
  private
    FKeyEvent: TKeyEvent;
    FKeyPressEvent: TKeyPressEvent;
    procedure KeyPressAction(Sender: TObject; var Key: char); stdcall; virtual;
    procedure KeyEventAction(Sender: TObject; var Key: Word; Shift: TShiftState); stdcall; virtual;
  published
    property OnKeyPressAction: TKeyPressEvent read FKeyPressEvent write FKeyPressEvent;
    property OnKeyEventAction: TKeyEvent read FKeyEvent write FKeyEvent;
  end;

</code>

So when a component has this property it should show the events as nested..
As in
TMyComponent = class(TComponent)
..
published
  property MyEvents: TMyEventw read FMyEvents write FMyEvents;
end;

In the events Object Inspector shown as in the Events tab.

'MyEvens - OnKeyPressAction
               OnKeyEventAction
'
I have tried to create and register with a TMethodProperty but could not get it to work. :(

Question: Does anyone have a simple example I can learn from which demonstrates this?

Thanks a lot,

Siegfried

siegfriedn

  • New member
  • *
  • Posts: 22
Re: Nested/Sub Events property editor
« Reply #1 on: February 25, 2010, 11:26:54 pm »
Ok, I have made a lot of progress. :) I found some Delphi example code by Serge Dosyukov which I managed to convert to FPC/Lazarus. The only problem I have is when it needs to create a new method from the object inspector. Error: 'Method name '' must be an identifier' probably something I am doing wrong with the PropertyHook.CreateMethod() routine ?

//
// Thanks to http://www.dragonsoft.us/articles.php?id=dgwckpgv_27dgb8gfc2
// for Example code
//
unit MyProperty;

interface

uses
  SysUtils, Classes, TypInfo, PropEdits;

type
  TCustomExtendedEventProperty = class(TNestedProperty)
  private
    FParent: TPropertyEditor;
    FPropInfo: PPropInfo;

    function GetInstance: TPersistent; virtual; abstract;
  protected
    constructor Create(Parent: TPropertyEditor; APropInfo: PPropInfo); reintroduce;

    property Instance: TPersistent read GetInstance;
  public
    function  GetName: shortstring; override;
  end;

  TExtendedEventProperty = class(TCustomExtendedEventProperty)
  private
    function  GetInstance: TPersistent; override;
  protected
  public
    function  AllEqual: Boolean; override;
    procedure Edit; override;
    function  GetAttributes: TPropertyAttributes; override;
    function  GetEditLimit: Integer; override;
    function  GetValue: string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
  end;

  TExtendedParentEventProperty = class(TCustomExtendedEventProperty)
  private
    FOwner: TPersistent;
    function GetInstance: TPersistent; override;
  protected
    constructor Create(Parent: TPropertyEditor; aOwner: TPersistent; aPropInfo: PPropInfo); reintroduce;
  public
    function  GetAttributes: TPropertyAttributes; override;
    procedure GetProperties(Proc: TGetPropEditProc); override;
    function  GetValue: string; override;
  end;

  TExtendedMethodProperty = class(TMethodProperty)
  protected
    function GetInstance: TPersistent; virtual;
  public
    function  GetAttributes: TPropertyAttributes; override;
    function  GetName: shortstring; override;
    procedure GetProperties(Proc: TGetPropEditProc); override;
    function  GetValue: string; override;

    property Instance: TPersistent read GetInstance;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterPropertyEditor(TypeInfo(TNotifyEvent), TComponent, 'MyProperty', TExtendedMethodProperty);
end;

procedure IntGetProperties(aPropertyEditor: TPropertyEditor; aInstance: TPersistent;
  aProc: TGetPropEditProc);
var
  oClassType: TClass;
  iCount: Integer;
  oPropList: TPropList;
  i: integer;
begin
  if aInstance = nil then
    Exit;

  iCount := GetPropList(aInstance.ClassInfo, [tkMethod], @oPropList);
  for i := 0 to iCount - 1 do
    aProc(TExtendedEventProperty.Create(APropertyEditor, oPropList));

  iCount := GetPropList(aInstance.ClassInfo, [tkClass], @oPropList);
  for i := 0 to iCount - 1 do
  begin
    oClassType := GetTypeData(oPropList^.PropType)^.ClassType;
    if not oClassType.InheritsFrom(TComponent)
      and oClassType.InheritsFrom(TPersistent)
      and (GetPropList(oClassType.ClassInfo, [tkMethod], nil) <> 0) then
      aProc(TExtendedParentEventProperty.Create(aPropertyEditor, aInstance, oPropList));
  end;
end;

{ TCustomExtendedEventProperty }

constructor TCustomExtendedEventProperty.Create(Parent: TPropertyEditor; APropInfo: PPropInfo);
begin
  inherited Create(Parent);
  FPropInfo := APropInfo;
  FParent := Parent;
end;

function TCustomExtendedEventProperty.GetName: shortstring;
begin
  Result := FPropInfo^.Name;
end;

{ TExtendedEventProperty }

function TExtendedEventProperty.AllEqual: Boolean;
var
  i: integer;
  oMethodValue: TMethod;
  oMethodValueAt: TMethod;
begin
  Result := True;
  if PropCount > 1 then
  begin
    oMethodValue := GetMethodValue;
    for i := 1 to PropCount - 1 do
    begin
      oMethodValueAt := GetMethodValueAt(i);
      if (oMethodValueAt.Code <> oMethodValue.Code) or (oMethodValueAt.Data <> oMethodValue.Data) then
      begin
        Result := False;
        Break;
      end;
    end;
  end;
end;

procedure TExtendedEventProperty.Edit;
var
  sFormMethodName: string;
  i: Integer;
  sName: string;
  oPropertyEditor: TPropertyEditor;
begin
  sFormMethodName := GetValue;
  if (sFormMethodName = '')
    or PropertyHook.MethodFromAncestor(GetMethodValue) then
  begin
    if sFormMethodName = '' then
    begin
      if GetComponent(0) = PropertyHook.LookupRoot then
      begin
        if Assigned(PropertyHook.LookupRoot) then
          sFormMethodName := PropertyHook.GetRootClassName
        else
          sFormMethodName := '';

        if SameText(Copy(sFormMethodName, 1, 1), 'T') then
          Delete(sFormMethodName, 1, 1);
      end
      else
      begin
        sFormMethodName := PropertyHook.GetObjectName(GetComponent(0));
        for i := Length(sFormMethodName) downto 1 do
          if sFormMethodName in ['.', '[', ']', '-', '>'] then
            Delete(sFormMethodName, i, 1);
      end;

      if sFormMethodName = '' then
        raise EPropertyError.Create('Can not find Form Method Name !');

      sName := '';
      oPropertyEditor := Self;
      while oPropertyEditor <> nil do
      begin
        if oPropertyEditor is TCustomExtendedEventProperty then
          oPropertyEditor := TCustomExtendedEventProperty(oPropertyEditor).FParent
        else
          oPropertyEditor := nil;
        if Assigned(oPropertyEditor) then
          sName := oPropertyEditor.GetName + sName;
      end;
      sFormMethodName := sFormMethodName + sName;

      sName := GetName;
      if SameText(Copy(sName, 1, 2), 'On') then
        Delete(sName, 1, 2);
      sFormMethodName := sFormMethodName + sName;
    end;
   
    if sFormMethodName = '' then
      raise EPropertyError.Create('Can not find Form Method Name !');
     
    SetValue(sFormMethodName);
  end;
  PropertyHook.ShowMethod(sFormMethodName);
end;

function TExtendedEventProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paMultiSelect, paValueList, paSortList, paRevertable];
end;

function TExtendedEventProperty.GetEditLimit: Integer;
begin
  Result := MaxIdentLength;
end;

function TExtendedEventProperty.GetValue: string;
begin
  Result := PropertyHook.GetMethodName(GetMethodProp(Instance, FPropInfo^.Name), PropertyHook.LookupRoot);
end;

procedure TExtendedEventProperty.GetValues(Proc: TGetStrProc);
begin
  PropertyHook.GetMethods(GetTypeData(FPropInfo^.PropType), Proc);
end;

procedure TExtendedEventProperty.SetValue(const Value: string);
var
  bNewMethod: Boolean;
  sCurValue: string;
  bMethodIsCompatible,
  bMethodIsPublished,
  bIndentIsMethod: Boolean;
begin
  sCurValue:= GetValue;
  if (sCurValue <> '') and (Value <> '')
    and ((CompareText(sCurValue, Value) = 0) or not PropertyHook.MethodExists(Value, GetTypeData(FPropInfo^.PropType), bMethodIsCompatible, bMethodIsPublished, bIndentIsMethod))
    and not PropertyHook.MethodFromAncestor(GetMethodValue) then
    PropertyHook.RenameMethod(sCurValue, Value)
  else
  begin
    bNewMethod := (Value <> '') and not PropertyHook.MethodExists(Value, GetTypeData(FPropInfo^.PropType), bMethodIsCompatible, bMethodIsPublished, bIndentIsMethod);
    SetMethodProp(Instance, FPropInfo, PropertyHook.CreateMethod(Value, FPropInfo^.PropType, GetComponent(0),GetPropertyPath(0)));
    if bNewMethod then
      PropertyHook.ShowMethod(Value);
    PropertyHook.Modified(GetComponent(0));
  end;
end;

function TExtendedEventProperty.GetInstance: TPersistent;
begin
  Result := nil;
  if FParent is TExtendedMethodProperty then
    Result := TExtendedMethodProperty(FParent).Instance;
  if FParent is TExtendedParentEventProperty then
    Result := TExtendedParentEventProperty(FParent).Instance;
end;

{ TExtendedParentEventProperty }

constructor TExtendedParentEventProperty.Create(Parent: TPropertyEditor;
  aOwner: TPersistent; aPropInfo: PPropInfo);
begin
  inherited Create(Parent, APropInfo);
  FOwner := AOwner;
end;

function TExtendedParentEventProperty.GetInstance: TPersistent;
begin
  Result := TPersistent(GetObjectValue);  //GetOrdProp(FOwner, FPropInfo);
end;

function TExtendedParentEventProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paMultiSelect, paSubProperties, paReadOnly, paRevertable];
end;

procedure TExtendedParentEventProperty.GetProperties(Proc: TGetPropEditProc);
begin
  IntGetProperties(Self, Instance, Proc);
end;

function TExtendedParentEventProperty.GetValue: string;
begin
  if Instance = nil then
    Result := '(None)'
  else
    Result := '(' + Instance.ClassName + ')';
end;

{ TExtendedMethodProperty }

function TExtendedMethodProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paMultiSelect, paSubProperties, paReadOnly, paRevertable];
end;

function TExtendedMethodProperty.GetInstance: TPersistent;
var
  oObject: TPersistent;
  oProperties: TObject;
begin
  oObject := GetComponent(0);

  oProperties := GetObjectProp(oObject, 'MyProperty', TPersistent);
  if Assigned(oProperties) then
    Result := TPersistent(oProperties)
  else
    Result := oObject;
end;

function TExtendedMethodProperty.GetName: shortstring;
begin
  Result := 'MyProperty';
end;

procedure TExtendedMethodProperty.GetProperties(Proc: TGetPropEditProc);
begin
  IntGetProperties(Self, Instance, Proc);
end;

function TExtendedMethodProperty.GetValue: string;
begin
  if Instance = nil then
    Result := '(None)'
  else
    Result := '(' + Instance.ClassName + ')';
end;

end.