Recent

Author Topic: DefineProperties(Filer: TFiler) not triggered  (Read 3923 times)

freeman35

  • Jr. Member
  • **
  • Posts: 92
DefineProperties(Filer: TFiler) not triggered
« on: February 01, 2013, 11:45:25 am »
TOwnedCollection 's DefineProperties procedure not triggered. why? whats wrong in this code, its work on delphi
I'm using lazarus and FPC SVN verison on debian wheezy amd64
Code: [Select]
type
  TAnyCollection = class(TOwnedCollection)
  private
    FAnyClass: TStringList;
    FCurrentClass: TCollectionItemClass;
    procedure SetCurrentClass(const Value: TCollectionItemClass);
    procedure SetAnyClass(const Value: TStringList);
    procedure ReadData(Reader: TReader);
    procedure WriteData(Writer: TWriter);
  protected
    procedure DefineProperties(Filer: TFiler); override;
    procedure Added(var Item: TCollectionItem); //override; on delphi class has but lazarus class not have
    procedure Deleting(Item: TCollectionItem); //override;
    procedure Notify(Item: TCollectionItem; Action: TCollectionNotification); override;
    function GetItemClass: TCollectionItemClass; virtual;

  public
    constructor Create(AOwner: TPersistent; ItemClass: TCollectionItemClass);
    destructor Destroy; override;
    function AddEx: TCollectionItem;

    function GetAttrCount: Integer; override;
    function GetAttr(Index: Integer): string; override;
    function GetItemAttr(Index, ItemIndex: Integer): string; override;

    property AnyClass: TStringList read FAnyClass write SetAnyClass;
    property CurrentClass: TCollectionItemClass read FCurrentClass write SetCurrentClass;
  end;

Code: [Select]
procedure TAnyCollection.DefineProperties(Filer: TFiler);

    function DoWrite: Boolean;
    begin
      if Filer.Ancestor <> nil then begin
        Result := True;
        if Filer.Ancestor is TStrings then
          Result := not FAnyClass.Equals(TStrings(Filer.Ancestor))
      end else Result := Count > 0;
    end;
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('Classes', ReadData, WriteData, DoWrite);
end;

This from delphi Classes property writed but on lazarus not working
Quote
object TDummyStorage
  Items.Classes = (
    'TMyItemEdit'
    'TMyItemFloat')
  Items = <
    item
      Caption = 'Capt...'
      CaptionWidth = 60
      BevelOuter = bvLowered
      Alignment = taRightJustify
      FieldType = ftString
      UpperFunc = 'upper'
      CaseInsensitive = True
      CharCase = ecNormal
    end
    item
      CaptionWidth = 60
      BevelOuter = bvLowered
      Alignment = taRightJustify
      FieldType = ftFloat
    end>
end

this result on lazarus, classes property not writed,
Quote
object TDummyStorage
  Items = <
    item
      Caption = 'Capt...'
      CaptionWidth = 60
      BevelOuter = bvLowered
      Alignment = taRightJustify
      FieldType = ftString
      UpperFunc = 'upper'
      CaseInsensitive = True
      CharCase = ecNormal
    end
    item
      CaptionWidth = 60
      BevelOuter = bvLowered
      Alignment = taRightJustify
      FieldType = ftFloat
    end>
end

extra bug  :o
   
Code: [Select]
procedure Notify(Item: TCollectionItem; Action: TCollectionNotification); override;
when triggered "cnDeleting" action, Item.Index is rigth, but when triggered action "cnAdded" Item.Index ALWAYS  setted -1

 

TinyPortal © 2005-2018