26. 8. 2011

 

Singleton v Delphi

Poslední dobou se dost zajímám o Design patterns a tak člověka napadne, jak by ten který implementoval Delphi. Jako první jsem si vybral singleton (i když o něm někteří říkají, že je to anti-pattern):

unit Singleton; interface type TSingleton = class sealed strict private class var FInstance: TSingleton; public // Global point of access to the unique instance class function Create: TSingleton; destructor Destroy; override; end; implementation { TSingleton } class function TSingleton.Create: TSingleton; begin if FInstance = nil then FInstance := inherited Create as Self; Result := FInstance; end; destructor TSingleton.Destroy; begin FInstance := nil; inherited; end; end.

Štítky: , ,

20. 8. 2011

 

Duck typing v Delphi

Našel jsem ve Wikipedii (pro mě) podivný termín: Duck typing. Tak mě zajímalo co to je a jestli by to šlo implementovat v Delphi. Zde je výsledek:

/// This is example of duck typing in Delphi.
/// Based on: http://en.wikipedia.org/wiki/Duck_typing

program DuckTyping;

{$APPTYPE CONSOLE}

uses ObjComAuto;

{$METHODINFO ON} // important

type
  TDuck = class
  public
    procedure Quack;
    procedure Feathers;
  end;
  TPerson = class
  public
    procedure Quack;
    procedure Feathers;
  end;
procedure TDuck.Quack;
begin
  Writeln('Quaaaaaack!');
end;
procedure TDuck.Feathers;
begin
  Writeln('The duck has white and gray feathers.');
end;

procedure TPerson.Quack;
begin
  Writeln('The person imitates a duck.');
end;
procedure TPerson.Feathers;
begin
  Writeln('The person takes a feather from the ground and shows it.');
end;

procedure InTheForest(V: Variant);
begin
  V.Quack;
  V.Feathers;
end;
procedure Game;
var
  Duck, Person: Variant; // or IDispatch
begin
  Duck := TObjectDispatch.Create(TDuck.Create, True) as IDispatch;
  Person := TObjectDispatch.Create(TPerson.Create, True) as IDispatch;

  InTheForest(Duck);
  InTheForest(Person);
end;

begin
  Game;
end.

Štítky: ,

This page is powered by Blogger. Isn't yours?

Přihlášení k odběru Příspěvky [Atom]