Форум: "Основная";
Текущий архив: 2002.11.21;
Скачать: [xml.tar.bz2];

Вниз

Еще раз к вопросу 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]

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

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2002.11.21;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.48 MB
Время: 0.007 c