Еще раз к вопросу SubProperties элементов коллекции

← →
VladP (2002-11-05 07:26) [0]

Здравствуйте!
Ну не сохраняются они! При сохранении говорят "Stream read error"! Переписал пример на Delphi, все та же песня.
Посмотрите, кто разбирается (заранее извиняюсь за размер).

unit MyPanel; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, DsgnIntf; type TMyLabel = class(TCustomLabel) published property Left; property Top; property Caption; end; TSubProperty = class (TClassProperty) public function GetAttributes :TPropertyAttributes; override; end; TMyItem = class(TCollectionItem) private FLabel:TMyLabel; procedure SetLabel(const Value: TMyLabel); protected procedure LoadLbl(Reader: TReader); procedure StoreLbl(Writer: TWriter); procedure DefineProperties(Filer: TFiler); override; public constructor Create(Collection: TCollection); override; destructor Destroy; override; published property Lbl:TMyLabel read FLabel write SetLabel; end; TMyPanel = class; TMyCollection = class(TCollection) private Owner: TMyPanel; function GetItem(Index: Integer): TCollectionItem; procedure SetItem(Index: Integer; const Value: TCollectionItem); protected function GetOwner:TPersistent;override; public constructor Create(own: TMyPanel); function Add: TMyItem; property Items[Index:Integer]:TCollectionItem read GetItem write SetItem; default; end; TMyPanel = class(TPanel) FLabels: TMyCollection; private procedure SetLabels(const Value: TMyCollection); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; published property Labels: TMyCollection read FLabels write SetLabels; end; procedure Register; implementation procedure Register; begin RegisterPropertyEditor(TypeInfo(TMyLabel),TMyItem,"Lbl",TSubProperty); RegisterComponents("Vlad", [TMyPanel]); end; { TMyItem } constructor TMyItem.Create(Collection: TCollection); begin inherited Create(Collection); FLabel := TMyLabel.Create(nil); end; procedure TMyItem.DefineProperties(Filer: TFiler); begin inherited DefineProperties(Filer); Filer.DefineProperty("Lbl",LoadLbl,StoreLbl,true); end; destructor TMyItem.Destroy; begin FLabel.Free; inherited; end; procedure TMyItem.LoadLbl(Reader: TReader); begin if Reader.ReadBoolean then begin // Reader.ReadListBegin; Lbl.Left := Reader.ReadInteger(); Lbl.Top := Reader.ReadInteger(); Lbl.Caption := Reader.ReadString(); // Reader.ReadListEnd; end; end; procedure TMyItem.StoreLbl(Writer: TWriter); begin Writer.WriteBoolean(Lbl <> nil); if Lbl <> nil then begin // Writer.WriteListBegin; Writer.WriteInteger(Lbl.Left); Writer.WriteInteger(Lbl.Top); Writer.WriteString(Lbl.Caption); // Writer.WriteListEnd; end; end; procedure TMyItem.SetLabel(const Value: TMyLabel); begin FLabel.Assign(Value); end; { TMyCollection } function TMyCollection.Add: TMyItem; begin Result := TMyItem(inherited Add); end; constructor TMyCollection.Create(own: TMyPanel); begin inherited Create(TMyItem); Owner:=own; end; function TMyCollection.GetItem(Index: Integer): TCollectionItem; begin Result := TMyItem(inherited GetItem(Index)); end; function TMyCollection.GetOwner: TPersistent; begin Result := Owner; end; procedure TMyCollection.SetItem(Index: Integer; const Value: TCollectionItem); begin inherited SetItem(Index,Value); end; { TMyPanel } constructor TMyPanel.Create(AOwner: TComponent); begin inherited Create(AOwner); FLabels := TMyCollection.Create(Self); end; destructor TMyPanel.Destroy; begin Labels.Free; inherited Destroy; end; procedure TMyPanel.SetLabels(const Value: TMyCollection); begin FLabels.Assign(Value); end; { TSubProperty } function TSubProperty.GetAttributes: TPropertyAttributes; begin Result := [paSubProperties]; end; end.

Спасибо, что просмотрели до конца.
С уважением.

← →
Юрий Зотов (2002-11-07 11:13) [1]

Ниже привожу работающий вариант. Сравните - все увидите сами.

Ошибка (точнее две ошибки) возникала вот почему:
1. Delphi САМА пыталась сохранить published-свойство Lbl, своим стандартным образом. То есть, пыталась записать в поток контрол, у которого нет ни Owner"а, ни Parent"а.
2. Read(Write)ListBegin(End) нужны. Вы же пишете ОДНО свойство, а не три отдельных, поэтому нужны "скобки".

Обратите внимание на методы Assign - без них код нерабочий. Дополнительно я убрал ненужные свойства из Object Inspector и запретил их сохранение.

← →
Юрий Зотов (2002-11-07 11:15) [2]

type
TMyLabel = class(TCustomLabel)
public
procedure Assign(Source: TPersistent); override;
published
property Caption;
property Cursor stored False;
property Height stored False;
property Hint stored False;
property Left;
property Name stored False;
property Tag stored False;
property Top;
property Width stored False;
end;

TSubProperty = class(TClassProperty)
public
function GetAttributes: TPropertyAttributes; override;
end;

TMyItem = class(TCollectionItem)
private
FLabel: TMyLabel;
procedure SetLabel(const Value: TMyLabel);
procedure ReadLabel(Reader: TReader);
procedure WriteLabel(Writer: TWriter);
protected
procedure DefineProperties(Filer: TFiler); override;
public
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
published
property Lbl: TMyLabel read FLabel write SetLabel stored False;
end;

TMyPanel = class;

TMyCollection = class(TCollection)
private
FOwner: TMyPanel;
function GetItem(Index: Integer): TMyItem;
procedure SetItem(Index: Integer; const Value: TMyItem);
protected
function GetOwner: TPersistent; override;
public
constructor Create(Owner: TMyPanel);
function Add: TMyItem;
property Owner: TMyPanel read FOwner;
property Items[Index:Integer]: TMyItem read GetItem write SetItem; default;
end;

TMyPanel = class(TPanel)
private
FLabels: TMyCollection;
procedure SetLabels(const Value: TMyCollection);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Labels: TMyCollection read FLabels write SetLabels;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents("Samples", [TMyPanel]);
RegisterPropertyEditor(TypeInfo(TCursor), TMyLabel, "Cursor", nil);
RegisterPropertyEditor(TypeInfo(integer), TMyLabel, "Height", nil);
RegisterPropertyEditor(TypeInfo(string), TMyLabel, "Hint", nil);
RegisterPropertyEditor(TypeInfo(TComponentName), TMyLabel, "Name", nil);
RegisterPropertyEditor(TypeInfo(integer), TMyLabel, "Tag", nil);
RegisterPropertyEditor(TypeInfo(integer), TMyLabel, "Width", nil);
RegisterPropertyEditor(TMyLabel.ClassInfo, TMyItem,"Lbl", TSubProperty)
end;

{ TMyItem }

constructor TMyItem.Create(Collection: TCollection);
begin
inherited Create(Collection);
FLabel := TMyLabel.Create(nil)
end;

procedure TMyItem.DefineProperties(Filer: TFiler);
begin
inherited DefineProperties(Filer);
Filer.DefineProperty("Label", ReadLabel, WriteLabel, FLabel <> nil)
end;

destructor TMyItem.Destroy;
begin
FLabel.Free;
inherited
end;

procedure TMyItem.ReadLabel(Reader: TReader);
begin
Reader.ReadListBegin;
FLabel.Left := Reader.ReadInteger;
FLabel.Top := Reader.ReadInteger;
FLabel.Caption := Reader.ReadString;
Reader.ReadListEnd
end;

procedure TMyItem.WriteLabel(Writer: TWriter);
begin
Writer.WriteListBegin;
try
Writer.WriteInteger(FLabel.Left);
Writer.WriteInteger(FLabel.Top);
Writer.WriteString(FLabel.Caption)
finally
Writer.WriteListEnd
end
end;

procedure TMyItem.SetLabel(const Value: TMyLabel);
begin
FLabel.Assign(Value)
end;

procedure TMyItem.Assign(Source: TPersistent);
begin
if Source is TMyItem then FLabel.Assign(TMyItem(Source).Lbl) else inherited
end;

{ TMyCollection }

function TMyCollection.Add: TMyItem;
begin
Result := TMyItem(inherited Add)
end;

constructor TMyCollection.Create(Owner: TMyPanel);
begin
inherited Create(TMyItem);
FOwner := Owner
end;

function TMyCollection.GetItem(Index: Integer): TMyItem;
begin
Result := TMyItem(inherited GetItem(Index))
end;

function TMyCollection.GetOwner: TPersistent;
begin
Result := FOwner
end;

procedure TMyCollection.SetItem(Index: Integer; const Value: TMyItem);
begin
inherited SetItem(Index, Value)
end;

{ TMyPanel }

constructor TMyPanel.Create(AOwner: TComponent);
begin
inherited;
FLabels := TMyCollection.Create(Self)
end;

destructor TMyPanel.Destroy;
begin
FLabels.Free;
inherited
end;

procedure TMyPanel.SetLabels(const Value: TMyCollection);
begin
FLabels.Assign(Value)
end;

{ TSubProperty }

function TSubProperty.GetAttributes: TPropertyAttributes;
begin
Result := [paSubProperties]
end;

{ TMyLabel }

procedure TMyLabel.Assign(Source: TPersistent);
begin
if Source is TCustomLabel then
with TCustomLabel(Source) do
begin
Self.Left := Left;
Self.Top := Top;
Self.Caption := Caption
end
else inherited
end;

← →
Юрий Зотов (2002-11-07 14:58) [3]

Добавление.

1. В классе TMyLabel свойства Left и Top лучше объявить так:
property Left default 0;
property Top default 0;

2. Вероятно, в классе TMyItem есть смысл заместить метод GetDisplayName:

if FLabel.Caption = ""
then Result : = inherited GetDisplayName
else Result : = FLabel.Caption

← →
VladP (2002-11-11 05:23) [4]

Искренне благодарю.

Еще раз к вопросу SubProperties элементов коллекции Найти похожие ветки