Poslední příspěvky

Stran: 1 ... 8 9 [10]
91
Obecné / Jak vytvorit pro vlastni komponentu kolekci polozek se zpetnou notifikaci?
« Poslední příspěvek od Delfin kdy 07-12-2017, 00:23:26 »
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)
92
Obecné / Re:Funkce Now nevrací správný čas.
« Poslední příspěvek od martinnr kdy 06-12-2017, 09:59:02 »
tu by som ešte pripomenul možný nesúlad pri zápise časových značiek, pokiaľ budú na nejaký server prichádzať informácie z viacerých staníc. resp. stačí že z dvoch. pokiaľ záleží na "každej milisekunde", tak v žiadnom prípade sa nespoliehať na to, že by zápisy sedeli v časovom slede.
mám na mysli situáciu, keď niečo do logu pošle jeden počítač a pošle svoju časovú značku a potom niečo pošle iný počítač, alebo sám server niečo zapíše.
rozdiel v nastavenom čase na dvoch počítačoch býva často extrémny (samozrejme pre isté situácie, niekedy na tom nemusí záležať).
len aby sa na to myslelo...
93
Obecné / Re:Použitý skin nevykresľuje komponenty
« Poslední příspěvek od Stanislav Hruška kdy 06-12-2017, 08:39:15 »
OT: odkedy používam TMS, tak také problémy nepoznám
94
Obecné / Re:Použitý skin nevykresľuje komponenty
« Poslední příspěvek od JaroB kdy 06-12-2017, 07:23:30 »
Pro XE2 je vhodné k úpravě stylů použít úpravy dle Rodriga Ruze, opravuje různé drobnosti v zobrazení a v podstatě stačí tuto knihovnu dát do cesty překladači - ale je vhodné na unity explicitně ukázat v projektu v uses, např.

Kód: Delphi [Vybrat]
  1.   Vcl.Styles.Utils.SysControls in '..\Styles\Vcl.Styles.Utils.SysControls.pas',
  2.   Vcl.Styles.Utils.SysStyleHook in '..\Styles\Vcl.Styles.Utils.SysStyleHook.pas',
  3.   Vcl.Styles.Utils.Menus in '..\Styles\Vcl.Styles.Utils.Menus.pas',
  4.  

já to používal hlavně kvůli menu.
A pravidlo, pokud je použit nějaký page control, je potřeba každý sheet podložit na celou plochu panelem a vypnou u něj backgroundparent (s vědomím, že na jeho liště záložek, pokud by i zde měl být uložen nějaká control, to stejně nebude fungovat)
95
Obecné / Re:Použitý skin nevykresľuje komponenty
« Poslední příspěvek od Slavomir kdy 06-12-2017, 07:12:06 »
Celý panel FILTER, ktorý je na obrázku, sa skladá väčšinou len z komponent TPanel, TLabel, TCombobox a prípadne TBitButton. Iba dátum má komponent TPageControl. Keby sa neprekresľoval iba tento komponent, viem to pochopiť. Ale tam sa po spustení programu nezobrazuje nič!  >:(
Ďalší komponent TPageControl, ktorého časť je na obrázku vpravo, nemá nič spoločné s panelom FILTER (súvisí s vedľajšou tabuľkou, ktorú nie je vidno).
96
Obecné / Re:Použitý skin nevykresľuje komponenty
« Poslední příspěvek od Delfin kdy 05-12-2017, 20:27:30 »
Co se tyce vertikalniho page control, tak si pamatuju, ze nebyly skinovane ani bez VCL Styles.
97
Obecné / Použitý skin nevykresľuje komponenty
« Poslední příspěvek od Slavomir kdy 05-12-2017, 20:23:06 »
Ahojte, prosím o radu. V mojom programe (v Delphi XE2) sa pokúšam použiť ľubovoľný skin (ono sa to síce v Delphi volá Style - napr. Smokey Quartz Kamri).
Spustím z menu Project / Options / Appearance - zaškrtnem daný štýl, nastavím ho ako default a uložím. Ale bieda.
Po spustení programu väčšina jednoduchý okien má daný štýl bez chyby, ale tie komplikovanejšie (s viacerými komponentami) sa neprekresľujú takmer vôbec (viď priložený obrázok).

Sú v ňom vlastne tri náhľady:
1) vľavo - štýl použitý, po zobrazení okna nikde žiadny komponent
2) v strede - štýl použitý, po prejdení myšou ponad komponenty sa niektoré zobrazia
3) vpravo - okno bez štýlu (klasický Windows - síce škaredý, ale je tam všetko)  :).
Budem vďačný za každú radu.

98
Obecné / Re:Funkce Now nevrací správný čas.
« Poslední příspěvek od age.new kdy 05-12-2017, 08:59:11 »
Tak problém s datem u souboru vyřešený. V jednom případě se soubor přepisoval jiným (jakousi pracovní zálohou) a tím došlo k vytvoření chybného času. Původně hlavní problém s ukládání času do databáze mi v tomto případě zaslepil oči. Doufám, že řešení bude opět nějaká hloupá chyba. Hodnoty do databáze ukládám jako jednoduchý SQL příkaz s type double (TDateTime).   
99
Obecné / Re:Funkce Now nevrací správný čas.
« Poslední příspěvek od age.new kdy 05-12-2017, 07:15:28 »
Děkuji za rady. Na Now máme postavený celý logovací systém a nepamatuji se, že bych narazil na špatný časový zápis. Kódem pro změnu času souboru to prochází vždy (zjištěno přes debug režim) a funkce FileSetDate vrátí 0, takže soubor by neměl být "uzamčený". Databázi máme v embeded režimu přímo na stanici, tj. bez serveru. Ještě to budu testovat... 
100
Obecné / Re:Funkce Now nevrací správný čas.
« Poslední příspěvek od Radek Červinka kdy 04-12-2017, 20:15:48 »
Upřímně moc nevěřím, že Now má chybu. Díval jsem se na implementaci v Delphi 5, XE a Tokio a všude je stejná. Pochybuji, že by během 20 let na tu chybu někdo nenarazil.

Spíše si myslím, že někdo do toho souboru zapíše, nebo ho nějak zavřeš později, nebo je zamknutý někým jiným.

Měl jsem podobný problém, a nakonec z toho vylezto, že inkriminovaný log byl v adresaáři, na který dával pozor dropbox nebo googledrive a způsobovalo problém.
Stran: 1 ... 8 9 [10]