Geneza.
Pomysł który mam zamiar opisać w tym „artykule” wpadł do mojej głowy jakiś czas temu (co więcej został napisany na 2 różne sposoby w projektach nad którymi pracowałem). De facto jest to obejście problemu który mnie osobiście strasznie drażni w Delphi, a mianowicie jak zrobić aby jedna klasa implementowała wiele interfejsów ? Dla zdziwionych wiem że można dziedziczyć po wielu IUnknown i wiem co to są interfejsy w Delphi ale nie zmienia to faktu że nie są one tym co jest mi potrzebne na co dzień gdy nie sięgamy po kontrolki COM. Jako że zawodowo pisze w Javie tam sprawa wygląda dużo przyjemniej, ale koniec pitolenia teraz będzie pomysła. Otóż stworzymy sobie klasę która będzie udostępniała kilka interfejsów poprzez relacje HAS-A zamiast IS-A, wiem wiem żadna rewelacja ale nic to może się komuś spodoba…. (BTW pierwotna implementacja tego pomysłu została użyta w moim projekcie Gluton który pozwolę sobie tutaj zareklamować:
https://www.assembla.com/wiki/show/Gluton)
Pomysł.
Pomysł jest taki aby wykorzystać klasy abstrakcyjne do zdefiniowania interfejsów które wystawimy dla innych klas, w projekcie dołączonym do artsa znajdziemy je w unicie Interfejsiki.pas i wyglądają one następująco:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 |
TBeerCtrl = class abstract public procedure TakeBeerFromFridge;virtual;abstract; end; TChipsCtrl = class abstract public function DoWeHaveChips:boolean;virtual;abstract; procedure EatChips;virtual;abstract; end; |
teraz stworzymy sobie klaskę która będzie w pewien szczególny sposób implementowała całość, potrzebujemy niestety do tego 3 klas…. o takich:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 |
TImprezka = class public constructor Create; destructor Destroy;override; protected fBeerCtrl: TBeerCtrl; fChipsCtrl: TChipsCtrl; published property BeerCtrl: TBeerCtrl read fBeerCtrl; property ChipsCtr: TChipsCtrl read fChipsCtrl; end; TBeerCtrlImpl = class(TBeerCtrl) public constructor Create(const owner: TImprezka); procedure TakeBeerFromFridge;override; private fParent: TImprezka; end; TChipsCtrlImpl = class(TChipsCtrl) public constructor Create(const owner: TImprezka); function DoWeHaveChips:boolean;override; procedure EatChips;override; private fParent: TImprezka; end; |
Nie trudno się domyśleć że klasa TImprezka będzie w sobie agregowała obiekty typów TBeerCtrlImpl oraz TChipsCtrlImpl które są właściwą implementacją interfejsów TBeerCtrl i TChipsCtrl. Aby powyższe zdanie stało się prawdziwe zerknijmy na implementację:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 |
constructor TImprezka.Create; begin fBeerCtrl := TBeerCtrlImpl.Create(self); fChipsCtrl := TChipsCtrlImpl.Create(self); end; { TBeerCtrlImpl } constructor TBeerCtrlImpl.Create(const owner: TImprezka); begin fParent := owner; fParent.fBootles := 10; end; procedure TBeerCtrlImpl.TakeBeerFromFridge; begin inherited; if fParent.fBootles > 0 then Dec(fParent.fBootles) end; { TChipsCtrlImpl } constructor TChipsCtrlImpl.Create(const owner: TImprezka); begin fParent := owner; fParent.fChipsCount := 10; end; function TChipsCtrlImpl.DoWeHaveChips: boolean; begin Result := fParent.fChipsCount > 0; end; procedure TChipsCtrlImpl.EatChips; begin inherited; if fParent.fChipsCount >0 then Dec(fParent.fChipsCount); end; |
Wszystko zgodnie z przewidywaniami, teraz przejdźmy płynnie do pytania: Po cholerę mi to ? Ano tutaj zdania są podzielone… większość początkujących programistów stwierdzi że jest to do dupy i nic ciekawego, mogą już przestać się męczyć czytaniem dalej. Dla tych których to jednak intryguje jest reszta artsa.
Całość została stworzona pierwotnie bo:
- Męczące są problemy z Circular reference (implementacja w innym miejscu niż interfejsy)
- Daje to możliwość automatyzacji składania obiektów w bardziej złożone struktury.
- Daje to niezłe możliwości spięcia tego z XML’em
- Wymyśliłem jak na bazie tego zrobić w miarę uniwersalny Engine do gry (niestety w tym artcie o tym nie napisze)
- Jak się załapie o co mi chodzi można być bardziej leniwym ?
- Kod staje się ciut bardziej przejrzysty.
są też minusy:
- Brak relacji IS-A.
- Trzeba natrzepać ciut więcej kodu, na szczęście CTRL+C rządzi.
- Zakres widzialności pól czasami może być kłopotem.
- Kumpel wymieniał mi inne ale uznałem je za mało ważne i zapomniałem 😛
W tym momencie polecam zerkniecie do załączonego projektu, warto z grubsza oblukać zawartość unita Implementacja.pas, ma on wspomniane powyżej klasy rozszerzone o dodatkowe „umiejętności”. Skupmy się na klasach TImprezowicz i TSmarterImprezowicz. Są to klasy które mogą się „podłączyć” do TImprezka i korzystać z jej zasobów. Jak tego robią ?
Otóż pokazałem model troszeczkę zmiksowany, tzn. sięgają one normalnie do metod klasy (np. metody Join, Leave) jak i do jej kontrolerów (TBeerCtrl, TChipsCtrl) tyle że zamiast odwoływać się bezpośrednio do propertiesów BeerCtrl i ChipsCtr korzystają z metody GetControler. Dlaczego ? O tym za kilkanaście linijek tekstu. Docelowo można sobie wyobrazić klase TImprezka która ma tylko 3 metody publiczne tj: Create, Destroy oraz GetControler natomiast cała jej pozostała funkcjonalność dostępna jest przez publiczne kontrolery w stylu TBeerCtrl, TChipsCtrl jednakże ja putytaninem nie jestem (co widać w moim tekście) i wole model mieszany który postanowiłem przedstawić. Dobra, o co chodzi z GetControler ? jak zerkniemy mu w bebechy zobaczymy takie coś:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 |
function TImprezka.GetControler(const ctrlType: TClass): TObject; var Count, Loop: Integer; List: TPropList; ob: TObject; begin //skanujemy w poszukiwaniu znanych przylaczy Count := GetPropList(ClassInfo, tkAny, @List); for Loop := 0 to Pred(Count) do begin if List[Loop]^.PropType^.Kind = tkClass then begin ob := Pointer(GetOrdProp(self, List[Loop]^.Name)); if ob = nil then continue; if ob is ctrlType then begin Result := ob; exit; end; end; end; Result := nil; end; |
Jak widać metoda ta grzebie w swojej macierzystej klasie w poszukiwaniu propertiesów (musza być w sekcji published, i musi być włączony switch $M+) które są takiego samego typu jak żądany. Warto zwrócić uwagę na użycie operatora IS, jeśli klasa ma więcej propertiesów które dziedziczą w jakiś sposób po sobie (chodzi mi rzecz jasna o dziedziczenie typów) to warto zastanowić się który obiekt tak naprawdę zwróci ta metoda…. polecam eksperymenty. Wracając do tematu, metoda postara się zwrócić nam obiekt (w zamyśle kontroler) który implementuje żądaną klasę, po co nam ta metoda ? Otóż sprytny imprezowicz na to pokaże 😉 A tym czasem zerknijmy na metodę:
|
1 2 3 4 5 6 7 8 9 |
procedure TImprezowicz.GetResourceProviders; begin fBeerCtrl := TBeerCtrl(fParty.GetControler(TBeerCtrl)); fChipsCtrl := TChipsCtrl(fParty.GetControler(TChipsCtrl)); end; |
Mamy tutaj przykład łopatologicznego użycia metody GetControler, oczywiście moglibyśmy napisać tak:
|
1 2 3 4 5 6 7 8 9 |
procedure TImprezowicz.GetResourceProviders; begin fBeerCtrl := fParty.BeerCtrl; fChipsCtrl := fParty.ChipsCtrl; end; |
ale przeciek wspominałem o lenistwie… no a ponieważ lenistwo ważne jest to warto zobaczyć jak je rozwinąć… tak więc patrzymy do bardziej leniwej wersji metody w klasie pochodnej tj:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 |
procedure TSmarterImprezowicz.GetResourceProviders; var Count, Loop: Integer; List: TPropList; ob: TObject; td: PTypeData; begin //skanujemy w poszukiwaniu znanych przylaczy Count := GetPropList(ClassInfo, tkAny, @List); for Loop := 0 to Pred(Count) do begin if List[Loop]^.PropType^.Kind = tkClass then begin td := GetTypeData(List[Loop]^.PropType^); if List[Loop]^.SetProc = nil then continue; ob := fParty.GetControler(td.ClassType); if ob <> nil then begin SetObjectProp( self, List[Loop], ob, true ); end; end; end; end; |
Analizę kodu pozostawiam dociekliwym powiem co metoda robi, ano szuka ona w obiekcie TSmarterImprezowicz propertiesów typu obiektowego, a później automatycznie przypisuje do nich wartości analogicznych propertiesów z obiektu typy TImprezka. Czyli mówiąc wprost, jeśli obiekt TSmarterImprezowicz ma jakieś propertiesy typów zgodnych z kontrolerami TImprezka to zostaną one ustawione na wartości znalezione w obiekcie fParty. Teraz dla bardziej dociekliwych warto spojrzeć na wynik programu (okienko z napisem: Chips: 9, Beer: 8)… hmmm dlaczego 9,8 a nie 8,8 ? Podpowiem że warto zerknąć na to:
|
1 2 3 4 5 6 7 |
TSmarterImprezowicz = class(TImprezowicz) published property BeerCtrl: TBeerCtrl read fBeerCtrl write fBeerCtrl; end; |
niestety teraz trzeba samemu pokminić gdyż dziad ze mnie straszny i nie wytłumaczę nic więcej.
Koniec.
W tej części chciałbym ci podziękować drogi czytelniku że poświęciłeś swój czas na przeczytanie tego, mam nadzieje że pomysł cię zainteresował. Jeśli uważasz że jednak całość sux to cóż… muszę z tym żyć, zdaje sobie sprawę że mogłem więcej napisać dokładniej opisać i w ogóle kawę na ławę, ale niestety jak już pisałem straszny dziad ze mnie. Wiec jeśli całość wydaje ci się interesująca rozkmniń ją sam (załączyłem prosty przykład), jeśli nie to cóż może kiedyś zmienisz zdanie 😉
Toster
PS.
Nie napisałem zwalniania pamięci przy pobieraniu listy propertiesów trza dopisać 😐
Autor: toster