Autor Téma: Jak vytvorit pro vlastni komponentu kolekci polozek se zpetnou notifikaci?  (Přečteno 176 krát)

Offline Delfin

  • Hrdina
  • ****
  • Příspěvků: 431
  • Karma: 21
  • SW konzultant
    • Verze Delphi: 2009, Tokyo
Pred casem me kontaktoval jeden uzivatel s dotazem jak se da vytvorit kolekce polozek pro vlastni komponentu, resp. jak reflektovat zmeny takove kolekce v komponente. Tady je kratka komentovana ukazka toho jak vyrobit komponente kolekci se zpetnou notifikaci:

Kód: Delphi [Vybrat]
  1. unit MyControl;
  2.  
  3. interface
  4.  
  5. uses
  6.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.StdCtrls;
  7.  
  8. type
  9.   TMyItem = class;
  10.   TMyItems = class;
  11.   TMyControl = class;
  12.  
  13.   TMyItem = class(TCollectionItem)
  14.   private
  15.     FTheBoolean: Boolean; { ← pole hodnoty property TheBoolean }
  16.     FTheInteger: Integer; { ← pole hodnoty property TheInteger }
  17.     procedure SetTheBoolean(Value: Boolean); { ← setter property TheBoolean }
  18.     procedure SetTheInteger(Value: Integer); { ← setter property TheInteger }
  19.   public
  20.     constructor Create(Collection: TCollection); override; { ← konstruktor pro inicializaci vychozich hodnot polozky }
  21.     procedure Assign(Source: TPersistent); override; { ← implementace prirazeni hodnot polozky }
  22.   published
  23.     property TheBoolean: Boolean read FTheBoolean write SetTheBoolean default False; { ← property TheBoolean }
  24.     property TheInteger: Integer read FTheInteger write SetTheInteger default 0; { ← property TheInteger }
  25.   end;
  26.  
  27.   TMyItems = class(TCollection)
  28.   private
  29.     [Weak] FOwner: TMyControl; { ← vlastnik kolekce; weak reference kvuli ARC }
  30.     function GetItem(Index: Integer): TMyItem; { ← getter property Items[Index: Integer] }
  31.     procedure SetItem(Index: Integer; Value: TMyItem); { ← setter property Items[Index: Integer] }
  32.   protected
  33.     function GetOwner: TPersistent; override; { ← metoda ziskani vlastnika kolekce }
  34.     procedure Update(Item: TCollectionItem); override; { ← metoda notifikace zmen polozek (1 nebo vice) }
  35.     procedure Notify(Item: TCollectionItem; Action: TCollectionNotification); override; { ← metoda notifikace zmen v kolekci }
  36.   public
  37.     constructor Create(Owner: TMyControl); reintroduce; { ← konstruktor upraveny jen pro predani vkastnika }
  38.     property Items[Index: Integer]: TMyItem read GetItem write SetItem; default; { ← indexovana property Items }
  39.   end;
  40.  
  41.   TMyControl = class(TCustomControl)
  42.   private
  43.     FItems: TMyItems; { ← kolekce polozek FItems }
  44.     FTexts: TListBox; { ← list box pro logovani notifikacnich metod }
  45.     procedure SetItems(Value: TMyItems); { ← setter property Items }
  46.     procedure AppendText(const Text: string; const Args: array of const); { ← metoda pro logovani notifikacnich metod }
  47.   protected
  48.     procedure DoListChange; virtual; { ← metoda volana pri zmene kolekce FItems }
  49.     procedure DoItemAppend(Item: TCollectionItem); virtual; { ← metoda volana pri pridani polozky do kolekce FItems }
  50.     procedure DoItemDelete(Item: TCollectionItem); virtual; { ← metoda volana pred smazanim polozky za pouziti FItems.Delete }
  51.     procedure DoItemRemove(Item: TCollectionItem); virtual; { ← metoda volana pred odebranim polozky z kolekce FItems }
  52.     procedure DoItemUpdate(Item: TCollectionItem); virtual; { ← metoda volana pri zmene polozky z kolekce FItems }
  53.   public
  54.     constructor Create(Owner: TComponent); override; { ← konstruktor komponenty }
  55.     destructor Destroy; override; { ← destruktor komponenty }
  56.   published
  57.     property Items: TMyItems read FItems write SetItems; { ← property kolekce Items }
  58.   end;
  59.  
  60. procedure Register;
  61.  
  62. implementation
  63.  
  64. { TMyItem }
  65.  
  66. constructor TMyItem.Create(Collection: TCollection);
  67. begin
  68.   inherited;
  69.   FTheBoolean := False;
  70.   FTheInteger := 0;
  71. end;
  72.  
  73. procedure TMyItem.SetTheBoolean(Value: Boolean);
  74. begin
  75.   if FTheBoolean <> Value then { ← jen pri zmene hodnoty... }
  76.   begin
  77.     FTheBoolean := Value; { ← nastavime hodnotu interniho pole }
  78.     Changed(False); { ← a notifikujeme kolekci o zmene polozky; takove volani vyvola metodu Update kolekce }
  79.   end;
  80. end;
  81.  
  82. procedure TMyItem.SetTheInteger(Value: Integer);
  83. begin
  84.   if FTheInteger <> Value then { ← jen pri zmene hodnoty... }
  85.   begin
  86.     FTheInteger := Value; { ← nastavime hodnotu interniho pole }
  87.     Changed(False); { ← a notifikujeme kolekci o zmene polozky; takove volani vyvola metodu Update kolekce }
  88.   end;
  89. end;
  90.  
  91. procedure TMyItem.Assign(Source: TPersistent);
  92. begin
  93.   if Source is TMyItem then { ← pokud jde o kompatibilni tridu, pak... }
  94.   begin
  95.     FTheBoolean := TMyItem(Source).TheBoolean; { ← pro jednoduchost bez porovnani puvodnich hodnot upravime primo hodnoty poli }
  96.     FTheInteger := TMyItem(Source).TheInteger; { ← pro jednoduchost bez porovnani puvodnich hodnot upravime primo hodnoty poli }
  97.     Changed(False); { ← a vyvolame notifikaci o zmene jen teto polozky; EMBT tady pouziva blok Collection.BeginUpdate/EndUpdate }
  98.   end
  99.   else { ← nejde o kompatibilni tridu, takze... }
  100.     inherited Assign(Source); { ← nechame prirazeni na predkovi tridy }
  101. end;
  102.  
  103. { TMyItems }
  104.  
  105. constructor TMyItems.Create(Owner: TMyControl);
  106. begin
  107.   inherited Create(TMyItem); { ← nastavime tridu kolekce }
  108.   FOwner := Owner; { ← a ulozime vlastnika kolekce }
  109. end;
  110.  
  111. function TMyItems.GetItem(Index: Integer): TMyItem;
  112. begin
  113.   Result := TMyItem(inherited GetItem(Index)); { ← vratime pretypovanou polozku (pokud existuje) }
  114. end;
  115.  
  116. procedure TMyItems.SetItem(Index: Integer; Value: TMyItem);
  117. begin
  118.   inherited SetItem(Index, Value); { ← nastavime polozku (pokud existuje) }
  119. end;
  120.  
  121. function TMyItems.GetOwner: TPersistent;
  122. begin
  123.   Result := FOwner; { ← vratime vlastnika kolekce }
  124. end;
  125.  
  126. procedure TMyItems.Update(Item: TCollectionItem);
  127. begin
  128.   if Assigned(FOwner) and not (csDestroying in FOwner.ComponentState) then { ← pokud existuje vlastnik a neni prave nicen, pak... }
  129.     if not Assigned(Item) then { ← pokud jde o notifikaci zmeny vice polozek, pak... }
  130.       FOwner.DoListChange { ← zavolame vlastnikovi metodu DoListChange }
  131.     else { ← jinak jde o notifikaci zmeny 1 konkretni polozky, takze... }
  132.       FOwner.DoItemUpdate(Item); { ← zavolame vlastnikovi DoItemUpdate s instanci modifikovane polozky v parametru }
  133. end;
  134.  
  135. procedure TMyItems.Notify(Item: TCollectionItem; Action: TCollectionNotification);
  136. begin
  137.   if Assigned(FOwner) and not (csDestroying in FOwner.ComponentState) then { ← pokud existuje vlastnik a neni prave nicen, pak... }
  138.     case Action of
  139.       cnAdded: FOwner.DoItemAppend(Item); { ← polozka Item byla pridana do kolekce; zavolame vlastnikovi metodu DoItemAppend }
  140.       cnDeleting: FOwner.DoItemDelete(Item); { ← polozka Item je mazana metodou Delete; zavolame vlastnikovi metodu DoItemDelete }
  141.       cnExtracting: FOwner.DoItemRemove(Item); { ← polozka Item je odebirana z kolekce; zavolame vlastnikovi metodu DoItemRemove }
  142.     end;
  143. end;
  144.  
  145. { TMyControl }
  146.  
  147. constructor TMyControl.Create(Owner: TComponent);
  148. begin
  149.   inherited; { ← konstruktor predka }
  150.  
  151.   Width := 185; { ← nastaveni vychozi velikosti komponenty }
  152.   Height := 200; { ← nastaveni vychozi velikosti komponenty }
  153.  
  154.   FItems := TMyItems.Create(Self); { ← vytvoreni kolekce s predanim vlastnika kolekce }
  155.  
  156.   FTexts := TListBox.Create(Self); { ← vytvoreni logovaciho list boxu }
  157.   FTexts.SetSubComponent(True); { ← nastaveni logovaciho list boxu jako subkomponent }
  158.   FTexts.Parent := Self; { ← nastaveni rodice logovacimu list boxu }
  159.   FTexts.Align := alClient; { ← nastaveni "zarovnani" list boxu }
  160. end;
  161.  
  162. destructor TMyControl.Destroy;
  163. begin
  164.   FTexts.Free; { ← uvolneni logovaciho list boxu }
  165.   FItems.Free; { ← uvolneni kolekce }
  166.   inherited; { ← destruktor predka }
  167. end;
  168.  
  169. procedure TMyControl.SetItems(Value: TMyItems);
  170. begin
  171.   FItems.Assign(Value); { ← prirazeni kolekce }
  172. end;
  173.  
  174. procedure TMyControl.AppendText(const Text: string; const Args: array of const);
  175. begin
  176.   if not (csDestroying in ComponentState) then { ← pokud neni komponenta nicena, pak... }
  177.   begin
  178.     FTexts.Items.Add(Format(Text, Args)); { ← pridani polozky do logovaciho list boxu }
  179.     FTexts.Perform(WM_VSCROLL, SB_BOTTOM, 0); { ← zaskrolovani logovaciho list boxu na konec }
  180.     FTexts.Perform(WM_VSCROLL, SB_ENDSCROLL, 0); { ← ukonceni skrolovani logovaciho list boxu }
  181.   end;
  182. end;
  183.  
  184. procedure TMyControl.DoListChange;
  185. begin
  186.   AppendText('DoListChange', []); { ← logovani notifikacni metody }
  187. end;
  188.  
  189. procedure TMyControl.DoItemAppend(Item: TCollectionItem);
  190. begin
  191.   AppendText('DoItemAppend: Items[%d]', [Item.Index]); { ← logovani notifikacni metody }
  192. end;
  193.  
  194. procedure TMyControl.DoItemDelete(Item: TCollectionItem);
  195. begin
  196.   AppendText('DoItemDelete: Items[%d]', [Item.Index]); { ← logovani notifikacni metody }
  197. end;
  198.  
  199. procedure TMyControl.DoItemRemove(Item: TCollectionItem);
  200. begin
  201.   AppendText('DoItemRemove: Items[%d]', [Item.Index]); { ← logovani notifikacni metody }
  202. end;
  203.  
  204. procedure TMyControl.DoItemUpdate(Item: TCollectionItem);
  205. begin
  206.   AppendText('DoItemUpdate: Items[%d]', [Item.Index]); { ← logovani notifikacni metody }
  207. end;
  208.  
  209. procedure Register;
  210. begin
  211.   RegisterComponents('Samples', [TMyControl]); { ← registrace komponenty }
  212. end;
  213.  
  214. end.

Budu rad za pripadnou revizi ;) - minimalne TMyItem.Assign resim jinak nez EMBT (co jsem videl tak notifikuji zmenu cele kolekce pres TCollection.EndUpdate, namisto toho vyvolavam notifikaci zmeny jen modifikovane polozky - prijde mi to logictejsi; ke zmene indexu polozky tam nedojde a obecne by Assign polozky modifikovat kolekci nemel - jen hodnoty sebe sama jako polozky)
« Poslední změna: 07-12-2017, 00:31:58 od Delfin »
A co chudinky ovce? Koupíš jim snad plovací vesty? Nebo jim nasadíš chůdy? Ještě lepší, kdybys je zkřížil s delfíny na ovce hopkavé!

Offline Radek Červinka

  • Administrátoři
  • Padawan
  • *****
  • Příspěvků: 1780
  • Karma: 72
    • Verze Delphi: D5,D2007, DXE, DXE2 + 2 poslední (Tokyo)
    • O Delphi v češtině
Excellent
Rated 1 time
Není ta notifikace přes EndUpdate náhodou k vůli tomu, aby při hromadné změně položek to např. pro každou položku nepřekresloval, ale kreslil až na konec? Aspoň já si to tak pamatuji.
Embarcadero MVP - Czech republic

Offline pf1957

  • Padawan
  • ******
  • Příspěvků: 1866
  • Karma: 91
    • Verze Delphi: D2007, XE3, DX10
Není ta notifikace přes EndUpdate náhodou k vůli tomu, aby při hromadné změně položek to např. pro každou položku nepřekresloval, ale kreslil až na konec? Aspoň já si to tak pamatuji.
Taky bych ocekaval, ze to po BeginUpdate nebude plivat zadne eventy.

Asi by to melo mit oboje: pokud to neni locknute, tak plivat individualni zmeny, pokud je, tak je otazka, co bude delat binding individualnich properties v pripade, ze by se pri EndUpdate plivla jedna souhrnna event.  Jak je udelany Binding v Delphi nevim.

Offline Delfin

  • Hrdina
  • ****
  • Příspěvků: 431
  • Karma: 21
  • SW konzultant
    • Verze Delphi: 2009, Tokyo
Není ta notifikace přes EndUpdate náhodou k vůli tomu, aby při hromadné změně položek to např. pro každou položku nepřekresloval, ale kreslil až na konec? Aspoň já si to tak pamatuji.

Pro hromadne upravy polozek se pouziva explicitni zamek. Tohle je prirazeni jen jedne polozky a zamek a odemceni je jen okolo prirazovani hodnot. Spis to vypada jako naznak potencionalniho zamku pro pristup z vice vlaken. Nebo se bali notifikaci za kazdou property - coz bych mohl taky, ale hodnoty prirazuju primo polim.

A s optimalizovanym kreslenim by se tady malovalo naopak vic. Priradil bys jednu polozku a namisto notifikace a prekresleni jen te jedne polozky bys dostal od EMBT verze notifikaci o zmene cele kolekce a tudiz bys musel prekreslit polozky vsechny. Coz je IMHO spatne. Jasne, pokud bys kolekci explicitne zamknul, pak je notifikace o zmene cele kolekce na miste.

Tedy pri prirazeni jedne polozky s odemcenou kolekci, ve vyse uvedenem kodu:

Kód: Delphi [Vybrat]
  1. procedure TMyItem.Assign(Source: TPersistent);
  2. begin
  3.   ...
  4.   ... { ← prirazeni hodnot ze Source do Self }
  5.   Changed(False); { ← vyvola TCollection.Update ale jen pokud je kolekce odemcena }
  6.   ...
  7. end;

A takto to ma EMBT (na vice mistech):

Kód: Delphi [Vybrat]
  1. procedure TMyItem.Assign(Source: TPersistent);
  2. begin
  3.   ...
  4.   if Assigned(Collection) then Collection.BeginUpdate;
  5.   try
  6.     ... { ← prirazeni hodnot ze Source do poli hodnot Self }
  7.   finally
  8.     if Assigned(Collection) then Collection.EndUpdate; { ← tady nastane notifikace o zmene cele kolekce, ne jen 1 polozky }
  9.   end
  10.   ...
  11. end;

Není ta notifikace přes EndUpdate náhodou k vůli tomu, aby při hromadné změně položek to např. pro každou položku nepřekresloval, ale kreslil až na konec? Aspoň já si to tak pamatuji.
Taky bych ocekaval, ze to po BeginUpdate nebude plivat zadne eventy.

Asi by to melo mit oboje: pokud to neni locknute, tak plivat individualni zmeny, pokud je, tak je otazka, co bude delat binding individualnich properties v pripade, ze by se pri EndUpdate plivla jedna souhrnna event.  Jak je udelany Binding v Delphi nevim.

Ano, to se i deje. Pokud si vyptas zmenu jedne polozky a kolekce je zamcena, notifikaci nedostanes. Ja proste nechapu proc se zamyka a odemyka kolekce pri prirazovani hodnot jedne polozky (viz. vyse zjednoduseny kod).

Nicmene dobra poznamka ohledne Live Bindings. Mozna je to tam kvuli tomu. Mozna je to neco nadcasoveho z dob Borlandu kdy planovali pouziti pro vice vlaken. Nebo se boji ze budou prirazovat hodnoty pres property, ne primo poli s hodnotou (u me jsem v komentari napsal "upravime primo hodnoty poli"); v takovem pripade by s odemcenou kolekci mohli dostat za kazdou property notifikaci.
« Poslední změna: 07-12-2017, 14:55:52 od Delfin »
A co chudinky ovce? Koupíš jim snad plovací vesty? Nebo jim nasadíš chůdy? Ještě lepší, kdybys je zkřížil s delfíny na ovce hopkavé!

Offline Delfin

  • Hrdina
  • ****
  • Příspěvků: 431
  • Karma: 21
  • SW konzultant
    • Verze Delphi: 2009, Tokyo
Dostal jsem "svrchovanou" odpoved ze se kolekce v pripade prirazeni jedne polozky zamyka kvuli vicenasobne zmeny objektu pres property (kde by doslo k notifikacim za kazdou zmenu hodnoty property).

V pripade uvedeneho kodu tedy neni treba protoze se zapisuje primo do poli. V pripade EMBT s pristupem pres property by bylo tez efektivnejsi kdyby na konci neemitovali notifikaci zmeny kolekce ale jen polozky (napr. parametrem metody TCollection.EndUpdate rozhodujicim o notifikaci).
A co chudinky ovce? Koupíš jim snad plovací vesty? Nebo jim nasadíš chůdy? Ještě lepší, kdybys je zkřížil s delfíny na ovce hopkavé!

 

S rychlou odpovědí můžete používat BB kódy a emotikony jako v běžném okně pro odpověď, ale daleko rychleji.

Jméno: E-mail:
Ověření:
Datový typ v Delphi, který má True a False: