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

Вниз

Свой коллекшен айтем...   Найти похожие ветки 

← →
Fernis   (2002-12-13 04:32) [0]

Подскажите (или покажите какой-нибудь пример), как можно сделать компонент TmyCollItem = class (TcollectionItem) с дополнительными пропертями и чтобы Коллекция работала с ним корректно. Не генерировалась ошибка не совпадения типов.

---

← →
Matolch   (2002-12-13 06:50) [1]

unit Unit2;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, StdCtrls;

type

TGlobalPapa = class;

TButtonItem = class(TCollectionItem)
private
FButton: TButton;
public
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
end;

TButtons = class(TCollection)
private
FGlobalPapa: TGlobalPapa;
function GetItem(Index: integer): TButtonItem;
procedure SetItem(Index: integer; const Value: TButtonItem);
public
constructor Create(MyGlobalPapa: TGlobalPapa);
function Add: TButtonItem;
property Items[Index: integer]: TButtonItem read GetItem write SetItem; default;
end;

TGlobalPapa = class(TScrollBox)
private
FButtons: TButtons;
FButtonWidth: integer;
procedure SetButtons(const Value: TButtons);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure AlignButtons;
published
property Buttons: TButtons read FButtons write SetButtons;
end;

implementation

{ TButtonItem }

constructor TButtonItem.Create(Collection: TCollection);
begin
inherited;
FButton := TButton.Create(TButtons(Collection).FGlobalPapa);
with TButtons(Collection).FGlobalPapa do
begin
FButton.Width := FButtonWidth;
FButton.Anchors := [akLeft, akTop, akRight];
FButton.Parent := TButtons(Collection).FGlobalPapa;
AlignButtons;
end;
end;

destructor TButtonItem.Destroy;
begin
FButton.Free;
inherited;
end;

{ TButtons }

function TButtons.Add: TButtonItem;
begin
Result := TButtonItem.Create(Self);
end;

constructor TButtons.Create;
begin
Inherited Create(TButtonItem);
FGlobalPapa := MyGlobalPapa;
end;

function TButtons.GetItem(Index: integer): TButtonItem;
begin
Result := TButtonItem(Inherited GetItem(Index));
end;

procedure TButtons.SetItem(Index: integer; const Value: TButtonItem);
begin
inherited SetItem(Index, Value);
end;

{ TGlobalPapa }

procedure TGlobalPapa.AlignButtons;
var I: integer;
begin
FButtonWidth := ClientWidth;
for I:=0 to Buttons.Count-1 do
with Buttons[I] do
begin
if I=0
then
FButton.Top := 0
else
FButton.Top := Buttons[I-1].FButton.Top + Buttons[I-1].FButton.Height;
FButton.Width := ClientWidth;
end;
end;

constructor TGlobalPapa.Create;
begin
inherited Create(AOwner);
FButtonWidth := Width - GetSystemMetrics(SM_CXEDGE);
FButtons := TButtons.Create(Self);
end;

destructor TGlobalPapa.Destroy;
begin
FButtons.Free;
inherited Destroy;
end;

procedure TGlobalPapa.SetButtons(const Value: TButtons);
begin
FButtons.Assign(Value);
end;

end.

---

← →
Matolch   (2002-12-13 06:56) [2]

Дополнительные проперти:


TButtonItem = class(TCollectionItem)
private
FButton: TButton;
function GetCaption: TCaption;
procedure SetCaption(const Value: TCaption);
published
property Caption: TCaption read GetCaption write SetCaption;
...............

function TButtonItem.GetCaption: TCaption;
begin
Result := FButton.Caption;
end;

procedure TButtonItem.SetCaption(const Value: TCaption);
begin
FButton.Caption := Value;
end;

---

← →
Matolch   (2002-12-13 07:19) [3]

И ещё небольшая поправка: все элементы коллекции должны иметь поле FButton производное от TButton. Иначе говоря, след делать так:

type

TMyButton = class(TButton);

TGlobalPapa = class;

TMyButtonItem = class(TCollectionItem)
private
FButton: TMyButton;

..далее по тексту..
и переопределить один метод:


TGlobalPapa = class(TScrollBox)
private
..............
public
..............
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
end;

impl...

procedure TGlobalPapa.GetChildren(Proc: TGetChildProc;
Root: TComponent);
var I: Integer;
begin
for I:=0 to ControlCount-1 do
if not (Controls[I] is TMyButton) then
Proc(TComponent(Controls[I]));
end;

---

← →
Юрий Зотов   (2002-12-13 11:58) [4]

А если нужны пояснения, то см. здесь:
http://www.delphikingdom.com/helloworld/tcollection.htm

---

← →
Fernis   (2002-12-13 15:05) [5]

Спасибо за помощь.
Моя проблема была в неправильном понимании построения стуктуры коллекции. В пробнике все работает чудесно, как что не перекраиваешь..))
Еще раз спасибо.

---

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

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

Наверх

Память: 0.46 MB
Время: 0.009 c