Forum dyskusyjne  |  Kanał IRC | Użytkownicy | Hosting
Programowanie » Delphi » Ogólne
Interfejsy w Delphi trochę inaczej.
2009-05-17 18:42:03, wyświetleń: 1246 [ historia ]


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:



Kod:
   
   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:
Kod:

   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ę:

Kod:

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:

  1. Męczące są problemy z Circular reference (implementacja w innym miejscu niż interfejsy)

  2. Daje to możliwość automatyzacji składania obiektów w bardziej złożone struktury.

  3. Daje to niezłe możliwości spięcia tego z XML’em

  4. Wymyśliłem jak na bazie tego zrobić w miarę uniwersalny Engine do gry (niestety w tym artcie o tym nie napisze)

  5. Jak się załapie o co mi chodzi można być bardziej leniwym ?

  6. Kod staje się ciut bardziej przejrzysty.





są też minusy:

  1. Brak relacji IS-A.

  2. Trzeba natrzepać ciut więcej kodu, na szczęście CTRL+C rządzi.

  3. Zakres widzialności pól czasami może być kłopotem.

  4. Kumpel wymieniał mi inne ale uznałem je za mało ważne i zapomniałem :P



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ś:
Kod:

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ę:


Kod:
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:

Kod:

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:

Kod:

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:

Kod:

   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

Komentarze
Artykuły mogą być komentowane wyłącznie przez zarejestrowanych użytkowników.

Zaloguj się | Załóż nowe konto

Redakcja zastrzega sobie prawo do skracania, usuwania komentarzy o treściach wulgarnych, obraźliwych oraz niezgodnych z polskim i miedzynarodowym prawem. Unit1.pl Team nie ponosi odpowiedzialności za treść komentarza.