Коллекции

← →
Navi (2004-10-09 17:05) [0]

Здравствуйте!
Делаю компонент:

Tbox = class(TGraphicControl)
private
FOnPaint: TNotifyEvent;
FLayers: TLayersCollection;
FCurLayer: TLayer;
procedure SetLayers(const Value: TLayersCollection);
protected
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property CurLayer: TLayer read FCurLayer write FCurLayer;
published
property Layers: TLayersCollection read FLayers write SetLayers;
end;

Где:
TLayersCollection = class(TCollection);
TLayer = class(TCollectionItem);

FCurLayer при создании должен указывать на самый первый элемент FLayers. Конструктор
делаю так:

constructor Tbox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle:= ControlStyle + [csReplicatable];
Width:= 105;
Height:= 105;
FLayers:= TLayersCollection.Create(Self);
FCurLayer:= FLayers.Add;
end;

Но при использовании этого компонента обращение к св-ву CurLayer вызывает
Access Violation in user32.dll. Эффект не постоянный, отчего зависит не понял. Я
привел кусок не готового компонента. В готовом - 2 коллекции, реализация и
объявления абсолютно аналогичные. Access Violation всегда только при обращении
к CurLayer. Хелп читал (может криво), решения не нашел.

Помогите лечить.
Спасибо.

← →
Гаврила © (2004-10-09 17:34) [1]

приведенной информации недостаточно для ответа.
Что из себя представляет TLayer ?

← →
Navi (2004-10-09 17:36) [2]

TLayer = class(TCollectionItem)
private
FName: String;
FVisible: Boolean;
procedure SetName(const Value: String);
procedure SetVisible(const Value: Boolean);
public
constructor Create(Collection: TCollection); override;
published
property Name: String read FName write SetName;
property Visible: Boolean read FVisible write SetVisible default True;
end;

{ TLayer }

constructor TLayer.Create(Collection: TCollection);
begin
inherited;
FName:= "0";
FVisible:= True;
end;

procedure TLayer.SetName(const Value: String);
begin
if FName <> Value then
begin
FName:= Value;
Changed(False);
end;
end;

procedure TLayer.SetVisible(const Value: Boolean);
begin
if FVisible <> Value then
begin
FVisible:= Value;
Changed(False);
end;
end;

← →
Семен Сорокин © (2004-10-09 17:46) [3]

нехватает еще описания TLayersCollection.

ЗЫ. что происходит в процедуре
procedure SetLayers(const Value: TLayersCollection);

-уничтожается ли старый TLayersCollection
-переопределяется ли FCurLayer на новый элемент
-существует ли элемент TLayer у Value

← →
Гарвила (2004-10-09 17:48) [4]

Нет тут никакого криминала, по карйней мере не вижу
значит ошибка в другом месте

← →
Navi (2004-10-09 18:23) [5]

TLayersCollection = class(TCollection)
private
FPage: Tbox;
FOnItemChange: TItemChangeEvent;
protected
function GetItem(Index: Integer): TLayer;
procedure SetItem(Index: Integer; const Value: TLayer);
function GetOwner: TPersistent; override;
procedure Update(Item: TCollectionItem); override;
procedure DoItemChange(Item: TCollectionItem); dynamic;
public
constructor Create(APage: Tbox);
function Add: TLayer;
property Items[Index: Integer]: TLayer read GetItem write SetItem; default;
published
property OnItemChange: TItemChangeEvent read FOnItemChange write FOnItemChange;
end;

{ TLayerCollection }

function TLayersCollection.Add: TLayer;
begin
Result:= TLayer(inherited Add);
end;

constructor TLayersCollection.Create(APage: Tbox);
begin
inherited Create(TLayer);
FPage:= APage;
end;

procedure TLayersCollection.DoItemChange(Item: TCollectionItem);
begin
if Assigned(FOnItemChange) then FOnItemChange(Item);
end;

function TLayersCollection.GetItem(Index: Integer): TLayer;
begin
Result:= TLayer(inherited GetItem(Index));
end;

function TLayersCollection.GetOwner: TPersistent;
begin
Result:= FPage;
end;

procedure TLayersCollection.SetItem(Index: Integer; const Value: TLayer);
begin
inherited SetItem(Index, Value);
end;

procedure TLayersCollection.Update(Item: TCollectionItem);
begin
inherited Update(Item);
DoItemChange(Item);
end;

procedure Tbox.SetLayers(const Value: TLayersCollection);
begin
FLayers.Assign(Value);
end;

procedure Tbox.Paint;
begin
Canvas.Font:= Font;
Canvas.Brush.Color:= Color;
if csDesigning in ComponentState then
with Canvas do
begin
Pen.Style:= psDash;
Brush.Style:= bsClear;
Rectangle(0, 0, Width, Height);
end;
if Assigned(FOnPaint) then FOnPaint(Self);
end;

destructor Tbox.Destroy;
begin
FLayers.Free;
inherited Destroy;
end;

← →
Navi (2004-10-09 18:26) [6]

При создании формы хочу считать CurLayer.Name. Вот здеь и AV. Прохожу по F7 - на CurLayer Inaccessible Value.

← →
Семен Сорокин © (2004-10-09 18:29) [7]

> procedure Tbox.SetLayers(const Value: TLayersCollection);
> begin
> FLayers.Assign(Value);
> end;

вот после этого в CurLayer находится битая ссылка

← →
Семен Сорокин © (2004-10-09 18:32) [8]

> Navi (09.10.04 18:26) [6]
> При создании формы хочу считать CurLayer.Name. Вот здеь
> и AV. Прохожу по F7 - на CurLayer Inaccessible Value.

правильно а в Design-time был заведен хоть один элемент, если да, то см. [7]

← →
Семен Сорокин © (2004-10-09 18:35) [9]

procedure TBox.SetLayers(const Value: TLayersCollection); begin if FLayers <> Value then begin FLayers.Assign(Value); if FLayers.Count = 0 then FCurLayer := FLayers.Add else FCurLayer := FLayers[0] end end;

ЗЫ. Ахтунг, псевдокод :)

← →
Defunct © (2004-10-09 18:39) [10]

ошибка в программе.

нельзя же блин быть настолько недальновидным:

> обращение к св-ву CurLayer вызывает Access Violation in user32.dll.
> FCurLayer:= FLayers.Add;

> [3] нехватает еще описания TLayersCollection.

> [5]function TLayersCollection.Add: TLayer;
> begin
> Result:= TLayer(inherited Add);
> end;

> [6] При создании формы хочу считать CurLayer.Name. Вот здеь и AV.

Теперь нехватает реализации TCollection.Add и реализации обработчика FormCreate.

← →
Navi (2004-10-09 18:50) [11]

procedure TForm1.FillcbLayer;
var
i: Integer;
begin
cbLayer.Items.Clear; // cbLayer: TComboBox;
for i:= 0 to box.Layers.Count - 1 do // box: Tbox;
begin
cbLayer.Items.AddObject(box.Layers.Items[i].Name,
TObject(box.Layers.Items[i].ID));
end;
i:= cbLayer.Items.IndexOf(box.CurLayer.Name);
if i >= 0 then cbLayer.ItemIndex:= i else cbLayer.ItemIndex:= 0;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
FillcbLayer;
end;

← →
Семен Сорокин © (2004-10-09 18:54) [12]

Navi (09.10.04 18:50) [11]
даже вот так лучше будет:

procedure TBox.SetLayers(const Value: TLayersCollection); var _ind: integer; begin if FLayers <> Value then begin _ind := FCurLayer.Index; FLayers.Assign(Value); if _ind < FLayers.Count then FCurLayer := FLayers.Items[_ind] else if FLayers.Count = 0 then FCurLayer := FLayers.Add else FCurLayer := FLayers.Items[0] end end;

Так вот если вылетает в [11] на строчке:

> i:= cbLayer.Items.IndexOf(box.CurLayer.Name);

Это говорит о том, что Box.CurLayer = Nil.

Просмотрите все места, а их должно быть не так уж и много где изменяется CurLayer. Только просмотрите нормально, с учетом всех Inherited вызовов.

IMHO сделайте лучше нормальный выбор текущего слоя по индексу как во всех списочных компонентах:

Tbox = class(TGraphicControl)
private
FIndex : Integer; // Индекс текущего слоя
...
Function GetCurrentLayer:TLayer;
public
property CurLayer: TLayer read GetCurrentLayer;
..
End;

Function TBox.GetCurrentLayer;
Begin
If FIndex< Count Then Result := Collection.Items[FIndex]
Else Result := Nil;
End;

← →
Navi (2004-10-09 19:12) [15]

Defunct (09.10.04 18:57) [13]
Да нет совсем не Nil, а именно Inaccessible Value. Пробовал я в конструкторе TBox-а присваивать FCurLayer:= Nil. Тогда в
i:= cbLayer.Items.IndexOf(box.CurLayer.Name); (понятно почему) выскакивает AV, но уже не в user32.
Прошелся я по F7 до FillcbLayer не нашел. А CurLayer изменяется уже после первого вызова FillcbLayer.

Семен Сорокин © (09.10.04 18:54) [12] А какая разница в реализации SetLayers, если при FillcbLayer он не исп-ся, он же только на запись. И до первого применения FillcbLayer не вызывается.

> Navi (09.10.04 19:12) [15]
> А какая разница
> в реализации SetLayers, если при FillcbLayer он не исп-ся,
> он же только на запись. И до первого применения FillcbLayer
> не вызывается.

А вот здесь Вы не правы - он вызывается после чтения свойcтв из ресурсов dfm.

← →
Navi (2004-10-10 08:49) [17]

Делать как советует Defunct © (09.10.04 19:04) [14] я изначально не хотел, но если Мастер советует... Вобщем работает отлично. Попутно еще вопрос (может надо новую ветку делать, но вроде тема уже здесь разобрана). Вот в Navi (09.10.04 17:36) [2] конструктор TLayer дает имя слою "0". Так вот былобы идеально еслибы слой с именем 0 нельзя было удалить ни в инспекторе объектов ни програмно. Когда юзер грохает слой, я отслеживаю, чтобы не снес 0, а в инспекторе все удаляется легко. Как это сделать?
Спасибо.

Коллекции Найти похожие ветки