unit MyControl;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.StdCtrls;
type
TMyItem = class;
TMyItems = class;
TMyControl = class;
TMyItem = class(TCollectionItem)
private
FTheBoolean: Boolean; { ← pole hodnoty property TheBoolean }
FTheInteger: Integer; { ← pole hodnoty property TheInteger }
procedure SetTheBoolean(Value: Boolean); { ← setter property TheBoolean }
procedure SetTheInteger(Value: Integer); { ← setter property TheInteger }
public
constructor Create(Collection: TCollection); override; { ← konstruktor pro inicializaci vychozich hodnot polozky }
procedure Assign(Source: TPersistent); override; { ← implementace prirazeni hodnot polozky }
published
property TheBoolean: Boolean read FTheBoolean write SetTheBoolean default False; { ← property TheBoolean }
property TheInteger: Integer read FTheInteger write SetTheInteger default 0; { ← property TheInteger }
end;
TMyItems = class(TCollection)
private
[Weak] FOwner: TMyControl; { ← vlastnik kolekce; weak reference kvuli ARC }
function GetItem(Index: Integer): TMyItem; { ← getter property Items[Index: Integer] }
procedure SetItem(Index: Integer; Value: TMyItem); { ← setter property Items[Index: Integer] }
protected
function GetOwner: TPersistent; override; { ← metoda ziskani vlastnika kolekce }
procedure Update(Item: TCollectionItem); override; { ← metoda notifikace zmen polozek (1 nebo vice) }
procedure Notify(Item: TCollectionItem; Action: TCollectionNotification); override; { ← metoda notifikace zmen v kolekci }
public
constructor Create(Owner: TMyControl); reintroduce; { ← konstruktor upraveny jen pro predani vkastnika }
property Items[Index: Integer]: TMyItem read GetItem write SetItem; default; { ← indexovana property Items }
end;
TMyControl = class(TCustomControl)
private
FItems: TMyItems; { ← kolekce polozek FItems }
FTexts: TListBox; { ← list box pro logovani notifikacnich metod }
procedure SetItems(Value: TMyItems); { ← setter property Items }
procedure AppendText(const Text: string; const Args: array of const); { ← metoda pro logovani notifikacnich metod }
protected
procedure DoListChange; virtual; { ← metoda volana pri zmene kolekce FItems }
procedure DoItemAppend(Item: TCollectionItem); virtual; { ← metoda volana pri pridani polozky do kolekce FItems }
procedure DoItemDelete(Item: TCollectionItem); virtual; { ← metoda volana pred smazanim polozky za pouziti FItems.Delete }
procedure DoItemRemove(Item: TCollectionItem); virtual; { ← metoda volana pred odebranim polozky z kolekce FItems }
procedure DoItemUpdate(Item: TCollectionItem); virtual; { ← metoda volana pri zmene polozky z kolekce FItems }
public
constructor Create(Owner: TComponent); override; { ← konstruktor komponenty }
destructor Destroy; override; { ← destruktor komponenty }
published
property Items: TMyItems read FItems write SetItems; { ← property kolekce Items }
end;
procedure Register;
implementation
{ TMyItem }
constructor TMyItem.Create(Collection: TCollection);
begin
inherited;
FTheBoolean := False;
FTheInteger := 0;
end;
procedure TMyItem.SetTheBoolean(Value: Boolean);
begin
if FTheBoolean <> Value then { ← jen pri zmene hodnoty... }
begin
FTheBoolean := Value; { ← nastavime hodnotu interniho pole }
Changed(False); { ← a notifikujeme kolekci o zmene polozky; takove volani vyvola metodu Update kolekce }
end;
end;
procedure TMyItem.SetTheInteger(Value: Integer);
begin
if FTheInteger <> Value then { ← jen pri zmene hodnoty... }
begin
FTheInteger := Value; { ← nastavime hodnotu interniho pole }
Changed(False); { ← a notifikujeme kolekci o zmene polozky; takove volani vyvola metodu Update kolekce }
end;
end;
procedure TMyItem.Assign(Source: TPersistent);
begin
if Source is TMyItem then { ← pokud jde o kompatibilni tridu, pak... }
begin
FTheBoolean := TMyItem(Source).TheBoolean; { ← pro jednoduchost bez porovnani puvodnich hodnot upravime primo hodnoty poli }
FTheInteger := TMyItem(Source).TheInteger; { ← pro jednoduchost bez porovnani puvodnich hodnot upravime primo hodnoty poli }
Changed(False); { ← a vyvolame notifikaci o zmene jen teto polozky; EMBT tady pouziva blok Collection.BeginUpdate/EndUpdate }
end
else { ← nejde o kompatibilni tridu, takze... }
inherited Assign(Source); { ← nechame prirazeni na predkovi tridy }
end;
{ TMyItems }
constructor TMyItems.Create(Owner: TMyControl);
begin
inherited Create(TMyItem); { ← nastavime tridu kolekce }
FOwner := Owner; { ← a ulozime vlastnika kolekce }
end;
function TMyItems.GetItem(Index: Integer): TMyItem;
begin
Result := TMyItem(inherited GetItem(Index)); { ← vratime pretypovanou polozku (pokud existuje) }
end;
procedure TMyItems.SetItem(Index: Integer; Value: TMyItem);
begin
inherited SetItem(Index, Value); { ← nastavime polozku (pokud existuje) }
end;
function TMyItems.GetOwner: TPersistent;
begin
Result := FOwner; { ← vratime vlastnika kolekce }
end;
procedure TMyItems.Update(Item: TCollectionItem);
begin
if Assigned(FOwner) and not (csDestroying in FOwner.ComponentState) then { ← pokud existuje vlastnik a neni prave nicen, pak... }
if not Assigned(Item) then { ← pokud jde o notifikaci zmeny vice polozek, pak... }
FOwner.DoListChange { ← zavolame vlastnikovi metodu DoListChange }
else { ← jinak jde o notifikaci zmeny 1 konkretni polozky, takze... }
FOwner.DoItemUpdate(Item); { ← zavolame vlastnikovi DoItemUpdate s instanci modifikovane polozky v parametru }
end;
procedure TMyItems.Notify(Item: TCollectionItem; Action: TCollectionNotification);
begin
if Assigned(FOwner) and not (csDestroying in FOwner.ComponentState) then { ← pokud existuje vlastnik a neni prave nicen, pak... }
case Action of
cnAdded: FOwner.DoItemAppend(Item); { ← polozka Item byla pridana do kolekce; zavolame vlastnikovi metodu DoItemAppend }
cnDeleting: FOwner.DoItemDelete(Item); { ← polozka Item je mazana metodou Delete; zavolame vlastnikovi metodu DoItemDelete }
cnExtracting: FOwner.DoItemRemove(Item); { ← polozka Item je odebirana z kolekce; zavolame vlastnikovi metodu DoItemRemove }
end;
end;
{ TMyControl }
constructor TMyControl.Create(Owner: TComponent);
begin
inherited; { ← konstruktor predka }
Width := 185; { ← nastaveni vychozi velikosti komponenty }
Height := 200; { ← nastaveni vychozi velikosti komponenty }
FItems := TMyItems.Create(Self); { ← vytvoreni kolekce s predanim vlastnika kolekce }
FTexts := TListBox.Create(Self); { ← vytvoreni logovaciho list boxu }
FTexts.SetSubComponent(True); { ← nastaveni logovaciho list boxu jako subkomponent }
FTexts.Parent := Self; { ← nastaveni rodice logovacimu list boxu }
FTexts.Align := alClient; { ← nastaveni "zarovnani" list boxu }
end;
destructor TMyControl.Destroy;
begin
FTexts.Free; { ← uvolneni logovaciho list boxu }
FItems.Free; { ← uvolneni kolekce }
inherited; { ← destruktor predka }
end;
procedure TMyControl.SetItems(Value: TMyItems);
begin
FItems.Assign(Value); { ← prirazeni kolekce }
end;
procedure TMyControl.AppendText(const Text: string; const Args: array of const);
begin
if not (csDestroying in ComponentState) then { ← pokud neni komponenta nicena, pak... }
begin
FTexts.Items.Add(Format(Text, Args)); { ← pridani polozky do logovaciho list boxu }
FTexts.Perform(WM_VSCROLL, SB_BOTTOM, 0); { ← zaskrolovani logovaciho list boxu na konec }
FTexts.Perform(WM_VSCROLL, SB_ENDSCROLL, 0); { ← ukonceni skrolovani logovaciho list boxu }
end;
end;
procedure TMyControl.DoListChange;
begin
AppendText('DoListChange', []); { ← logovani notifikacni metody }
end;
procedure TMyControl.DoItemAppend(Item: TCollectionItem);
begin
AppendText('DoItemAppend: Items[%d]', [Item.Index]); { ← logovani notifikacni metody }
end;
procedure TMyControl.DoItemDelete(Item: TCollectionItem);
begin
AppendText('DoItemDelete: Items[%d]', [Item.Index]); { ← logovani notifikacni metody }
end;
procedure TMyControl.DoItemRemove(Item: TCollectionItem);
begin
AppendText('DoItemRemove: Items[%d]', [Item.Index]); { ← logovani notifikacni metody }
end;
procedure TMyControl.DoItemUpdate(Item: TCollectionItem);
begin
AppendText('DoItemUpdate: Items[%d]', [Item.Index]); { ← logovani notifikacni metody }
end;
procedure Register;
begin
RegisterComponents('Samples', [TMyControl]); { ← registrace komponenty }
end;
end.
