Manche Entwickler sind der Meinung, das das Singleton schlechter Programmierstil sei, ein Hinweis auf Designschwächen. Ich sehe das anders. Es gibt nun mal manchmal die Notwendigkeit, dass man nur eine Instanz von einem Objekt haben darf. Wenn dem so ist, dann ist dass Singleton die beste Lösung.

Der grundsätzliche Lösungsansatz ist folgender:

1. Der Constructor wird als private deklariert, damit von dem Objekt nicht mehr „von Außen“ eine Instanz erstellt werden kann.
2. Dafür wird eine Methode GetInstance eingeführt, welche bei Bedarf (also beim ersten Aufruf) das Objekt erstellt und zurück gibt. Existiert bereits diese Instanz, wird sie lediglich zur Verfügung gestellt.

Hier ein Beispiel:

{ *********************************************************************** }
{                                                                         }
{ Delphi Entwursmustersammlung  -- Singleton                              }
{                                                                         }
{ Autor: Thomas Gröschke                                                  }
{ Erstellt: 23.09.2008                                                    }
{                                                                         }
{ *********************************************************************** }

unit Unit_Singelton;

interface

type
  TSingleton = class
  strict private
    constructor Create;
  class var
    FInstance:TSingleton;
  public
    class function GetInstance: TSingleton;
    procedure MeldeDich;
  end;

implementation

uses Dialogs;

constructor TSingleton.Create;
begin
  inherited;
end;

class function TSingleton.GetInstance: TSingleton;
begin
  If FInstance = nil Then
  begin
    FInstance := TSingleton.Create();
  end;
  Result := FInstance;
end;

procedure TSingleton.MeldeDich;
begin
  ShowMessage('Hier bin ich');
end;

end.

Testen zum Beispiel mit zwei Buttons auf einem Formular:

procedure TForm1.Button1Click(Sender: TObject);
var
  FObj : TSingleton;
begin
  FObj := TSingleton.GetInstance;
  FObj.MeldeDich;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  TSingleton.GetInstance.MeldeDich;
end;

Anzumerken ist noch, dass dieser Ansatz nicht Threadsicher ist. Da ich noch nie mit Threads gearbeitet habe und ich deswegen von dem Thema keine Ahnung habe, lass ich es an dieser Stelle so stehen.

Weblinks:

delphipraxis: was bringt mir ein singleton?

Wikipedia Man beachte die Nachteile!

Im Buch „Entwurfsmuster von Kopf bis Fuß“ ist das sehr schön mit verschiedenen Enten und ihren unterschiedlichen Flug- und Quakverhalten erklärt. Ich versuche es hier, wiederum inspiriert aus dem Buch, mit einem Computerspiel. Ich möchte zwei Varianten beschreiben. Ein mal mit Hilfe eines Interfaces und ein mal mit einer Klasse.

Gegeben seine Spielfiguren (Ritter, Bauer Troll) mit ihren Waffen (Schwert und Messer). Die Spielfiguren verhalten sich abhängig von Ihren Waffen im Kampf unterschiedlich.

Variante1:

// --------------
//
// Delphi Entwursmustersammlung  -- Strategy (mit Interface)
//
// Autor: Thomas Groeschke
// Erstellt: 24.08.2008
//
// --------------
unit Strategy01;

interface

uses Dialogs;

type

// ---------------
// Waffenverhalten
// ---------------

  IWaffenVerhalten = interface(IInterface)
    procedure VerwendeWaffe;
  end;

  TAxtVerhalten = class(TInterfacedObject, IWaffenVerhalten)
    procedure VerwendeWaffe;
  end;

  TMesserVerhalten = class(TInterfacedObject, IWaffenVerhalten)
    procedure VerwendeWaffe;
  end;

// ---------------
// Figuren
// ---------------

  TFigur = class(TObject)
  private
    FWaffenVerhalten: IWaffenVerhalten;
    Name: string;
  public
    constructor Create(iName: string; iActWaffenVerhalten: IWaffenVerhalten);
    destructor Destroy; override;
    procedure Kaempfen; virtual; abstract;
    procedure SetWaffe(iActWaffenVerhalten: IWaffenVerhalten);
  end;

  TRitter = class(TFigur)
    procedure Kaempfen; override;
  end;

  TBauer = class(TFigur)
  public
    procedure Kaempfen; override;
  end;

  TTroll = class(TFigur)
    procedure Kaempfen; override;
  end;

implementation

{$REGION 'Waffenverhalten'}

procedure TAxtVerhalten.VerwendeWaffe;
begin
  ShowMessage('Axt wird geschwungen');
end;

procedure TMesserVerhalten.VerwendeWaffe;
begin
  ShowMessage('Mit Messer wird gestochen');
end;

{$ENDREGION}

{$REGION 'Basisklasse Figur'}

constructor TFigur.Create(iName: string; iActWaffenVerhalten: IWaffenVerhalten);
begin
  inherited create;
  Name := iName;
  FWaffenVerhalten := iActWaffenVerhalten;
end;

destructor TFigur.Destroy;
begin
  // Das Verhalten darf nicht freigegeben werden, da es ja
  // von außen "reingereicht" worden ist.
  inherited;
end;

procedure TFigur.SetWaffe(iActWaffenVerhalten: IWaffenVerhalten);
begin
  FWaffenVerhalten := iActWaffenVerhalten;
end;

{$ENDREGION}

{$REGION 'Figuren Ritter, Troll und Bauer'}

procedure TRitter.Kaempfen;
begin
  if FWaffenVerhalten <> nil then
    FWaffenVerhalten.VerwendeWaffe;
  // weitere Aktionen...
end;

procedure TTroll.Kaempfen;
begin
  if FWaffenVerhalten <> nil then
    FWaffenVerhalten.VerwendeWaffe;
  // weitere Aktionen...
end;

procedure TBauer.Kaempfen;
begin
  if FWaffenVerhalten <> nil then
     FWaffenVerhalten.VerwendeWaffe
  // weitere Aktionen...
end;

{$ENDREGION}

Etwas Quellcode zum Testen:

procedure TForm1.Button1Click(Sender: TObject);
var
  Messer : IWaffenVerhalten;
  Axt : IWaffenVerhalten;
  Ritter1 : TFigur;
  Ritter2 : TFigur;
  Bauer : TFigur;
  Troll : TFigur;
begin
  // -----------
  // Nur hier, beim Erzeugen der konkreten Objekte, wird der tatsächliche
  // Typ (TMesser, TAxt, TRitter u.s.w. genannt.
  // -----------
  // Verhalten
  Messer := TMesserVerhalten.Create;
  Axt := TAxtVerhalten.Create;
  // Der Client
  Ritter1 := TRitter.Create('Gerhard, der Stolze',Messer);
  Ritter2 := TRitter.Create('Otto, der Dumme',nil);
  Bauer := TBauer.Create('Josef',nil);
  Troll := TTroll.Create('Rumpelstielzchen',Axt);

  Troll.Kaempfen;
  Ritter1.Kaempfen;
  Ritter2.Kaempfen;
  Bauer.Kaempfen;
  Troll.Kaempfen;

  // Ritter2 bekommt Messer
  Ritter2.SetWaffe(Messer);
  Ritter2.Kaempfen;

  Troll.Free;
  Bauer.Free;
  Ritter2.Free;
  Ritter1.Free;

end;

Variante2:

// --------------
//
// Delphi Entwursmustersammlung  -- Strategy (mit Klasse)
//
// Autor: Thomas Groeschke
// Erstellt: 24.08.2008
//
// --------------
unit Strategy02;

interface

uses Dialogs;

type

// ---------------
// Waffenverhalten
// ---------------

  TWaffenVerhalten02 = class(TObject)
  private
    name: string;
  public
    constructor create(iName:string);
    procedure VerwendeWaffe; virtual;
  end;

  TAxtVerhalten02 = class(TWaffenVerhalten02)
    procedure VerwendeWaffe; override;
  end;

  TMesserVerhalten02 = class(TWaffenVerhalten02)
    procedure VerwendeWaffe; override;
  end;

// ---------------
// Figuren
// ---------------

  TFigur02 = class(TObject)
  private
    FWaffenVerhalten02: TWaffenVerhalten02;
    Name: string;
  public
    constructor Create(iName: string; iActWaffenVerhalten02: TWaffenVerhalten02);
    destructor Destroy; override;
    procedure Kaempfen; virtual;
    procedure SetWaffe(iActWaffenVerhalten02: TWaffenVerhalten02);
  end;

  TRitter02 = class(TFigur02)
    procedure Kaempfen; override;
  end;

  TBauer02 = class(TFigur02)
  public
    procedure Kaempfen; override;
  end;

  TTroll02 = class(TFigur02)
    procedure Kaempfen; override;
  end;

implementation

{$REGION 'Waffenverhalten'}

constructor TWaffenVerhalten02.create(iName:string);
begin
  Name := iName;
end;

procedure TWaffenVerhalten02.VerwendeWaffe;
begin
  ShowMessage('Weglaufen');
end;

procedure TAxtVerhalten02.VerwendeWaffe;
begin
  ShowMessage('Axt wird geschwungen');
end;

procedure TMesserVerhalten02.VerwendeWaffe;
begin
  ShowMessage('Mit Messer wird gestochen');
end;

{$ENDREGION}

{$REGION 'Basisklasse Figur'}

constructor TFigur02.Create(iName: string; iActWaffenVerhalten02:
    TWaffenVerhalten02);
begin
  inherited create;
  Name := iName;
  FWaffenVerhalten02 := iActWaffenVerhalten02;
end;

destructor TFigur02.Destroy;
begin
  // Das Verhalten darf nicht freigegeben werden, da es ja
  // von außen "reingereicht" worden ist.
  inherited;
end;

procedure TFigur02.Kaempfen;
begin
  if FWaffenVerhalten02 <> nil then
    FWaffenVerhalten02.VerwendeWaffe;
end;

procedure TFigur02.SetWaffe(iActWaffenVerhalten02: TWaffenVerhalten02);
begin
  FWaffenVerhalten02 := iActWaffenVerhalten02;
end;

{$ENDREGION}

{$REGION 'Figuren Ritter, Troll und Bauer'}

procedure TRitter02.Kaempfen;
begin
  inherited;
  // weitere Aktionen
end;

procedure TTroll02.Kaempfen;
begin
  inherited;
  // weitere Aktionen
end;

procedure TBauer02.Kaempfen;
begin
  inherited;
  // weitere Aktionen
end;

{$ENDREGION}

end.

Und auch hier etwas zum Testen.

procedure TForm1.Button2Click(Sender: TObject);
var
  Messer : TWaffenVerhalten02;
  Axt : TWaffenVerhalten02;
  BasisWaffe : TWaffenVerhalten02;
  Ritter1 : TFigur02;
  Ritter2 : TFigur02;
  Bauer : TFigur02;
  Troll : TFigur02;
begin
  // -----------
  // Nur hier, beim Erzeugen der konkreten Objekte, wird der tatsächliche
  // Typ (TMesser, TAxt, TRitter u.s.w. genannt.
  // -----------
  // Verhalten
  Messer := TMesserVerhalten02.Create('Messer');
  Axt := TAxtVerhalten02.Create('Axt');
  BasisWaffe := TWaffenVerhalten02.create('Standardwaffe');
  // Der Client
  Ritter1 := TRitter02.Create('Gerhard, der Stolze',Messer);
  Ritter2 := TRitter02.Create('Otto, der Dumme',BasisWaffe);
  Bauer := TBauer02.Create('Josef',BasisWaffe);
  Troll := TTroll02.Create('Rumpelstielzchen',Axt);

  Troll.Kaempfen;
  Ritter1.Kaempfen;
  Ritter2.Kaempfen;
  Bauer.Kaempfen;
  Troll.Kaempfen;

  // Ritter2 bekommt Messer
  Ritter2.SetWaffe(Messer);
  Ritter2.Kaempfen;

  Troll.Free;
  Bauer.Free;
  Ritter2.Free;
  Ritter1.Free;
  BasisWaffe.Free;
  Axt.Free;
  Messer.Free;
end;

Links zum Thema:

Wikipedia

Hier der Quellcode für den Iterator:

// ------------------------------
//
// Delphi Entwursmustersammlung  -- Iterator
//
// Autor: Thomas Groeschke
// Erstellt: 12.08.2008
//
// ------------------------------
unit Iteratoren;

interface

uses Classes, Dialogs, sysutils, Contnrs;

type

  IIterator = interface(IInterface)
    procedure AddObj(iObj:TObject);
    function Count: Integer;
    function CurrentItem: TObject;
    function First: TObject;
    function HasNext: Boolean;
    function Next: TObject;
    function Prev: TObject;
  end;

  TListIterator = class(TInterfacedObject, IIterator)
  strict private
    FAggregate: TList;
    Index: Integer;
  public
    constructor Create(iValues:TList);
    destructor Destroy; override;
    procedure AddObj(iObj:TObject);
    function Count: Integer;
    function CurrentItem: TObject;
    function First: TObject;
    function HasNext: Boolean;
    function Next: TObject;
    function Prev: TObject;
  end;

implementation

constructor TListIterator.Create(iValues:TList);
var
  i: Integer;
begin
  inherited Create;
  FAggregate := TList.Create;
  if iValues <> nil then
    for i := 0 to iValues.Count - 1 do
      AddObj(iValues[i]);
  Index := -1;
end;

destructor TListIterator.Destroy;
begin
  FAggregate.Free;
  Inherited;
end;

procedure TListIterator.AddObj(iObj:TObject);
begin
  FAggregate.Add(iObj);
end;

function TListIterator.Count: Integer;
begin
  result := TList(FAggregate).Count;
end;

function TListIterator.CurrentItem: TObject;
begin
  if TList(FAggregate).Count <> 0 then
    result := TList(FAggregate).Items[Index]
  else
    result := nil;
end;

function TListIterator.First: TObject;
begin
  if TList(FAggregate).Count <> 0 then
  begin
    result := TList(FAggregate).Items[0];
    Index := 0;
  end
  else
  begin
    result := nil;
    Index := -1;
  end;
end;

function TListIterator.HasNext: Boolean;
begin
  if TList(FAggregate).Count > Index + 1 then
    result := true
  else
    result := false;
end;

function TListIterator.Next: TObject;
begin
  if HasNext then
  begin
    Inc(Index);
    result := TList(FAggregate).Items[Index];
  end
  else
    result := nil;
end;

function TListIterator.Prev: TObject;
begin
  if Index - 1 > 0 then
  begin
    dec(Index);
    result := TList(FAggregate).Items[Index];
  end
  else
    result := nil;
end;

Quergecheckt (Links zum Thema):
Wie werde ich ein Interface wieder los?
Wikibooks: Muster Iterator

Wenn ich mir zum Beispiel eine Rezeptur anschaue, so besteht die aus Baugruppen (Gewürz, Soße, Panade). Diese Baugruppen bestehen aus Artikeln (Salz, Wasser, Mehl) und/oder weiteren Baugruppen (Curry, Pfeffermischung). Nun soll es möglich sein Operationen auf Teile dieser Rezeptur oder auf das Ganze anzuwenden (Gib mir dein Gewicht, Gib mir deinen Wareneinsatz).

// ---------------------------
//
// Delphi Entwursmustersammlung  -- Composite
//
// Autor: Thomas Groeschke
// Erstellt: 09.08.2008
//
// ---------------------------
unit Composite;

interface

uses
  Messages, Classes, Dialogs, Contnrs;

type

  TComponent = class abstract(TObject)
  private
    Key  : string;
    Name : string;
  public
    function GetName: string; virtual;

    procedure Add(AComponent :TComponent);virtual;
    procedure Remove(AComponent :TComponent);virtual;
    function GetChild(i:integer) : TComponent; virtual;
    function GetCount : integer; virtual;
  end;

  TComposite = class(TComponent)
  private
    FComponent: TObjectList;
  public
    constructor Create(iKey, iName : string);
    function GetName: string; override;

    procedure Add(AComponent :TComponent); override;
    procedure Remove(AComponent :TComponent); override;
    function GetChild(i:integer) : TComponent ; override;
    function GetCount : integer; override;
  end;

  TLeaf = class(TComponent)
  public
    constructor Create(iKey, iName : string);
    function GetName: string; override;
    function GetCount : integer; override;
  end;

implementation

{$REGION 'TComponent'}

procedure TComponent.Remove(AComponent: TComponent);
begin
  ShowMessage('Error');
end;

function TComponent.GetCount: integer;
begin
  result := 0;
end;

function TComponent.GetChild(i: integer): TComponent;
begin
  ShowMessage('Error');
  result := nil;
end;

function TComponent.GetName: string;
begin
  result := Key + ', ' + Name;
end;

procedure TComponent.Add(AComponent: TComponent);
begin
  ShowMessage('Error');
end;

{$ENDREGION}

{$REGION 'TComposite' }

constructor TComposite.Create(iKey, iName: string);
begin
  inherited create;
  Key := iKey;
  Name := iName;
  FComponent := TObjectList.Create;
end;

procedure TComposite.Remove(AComponent: TComponent);
begin
  FComponent.Remove(AComponent);
end;

function TComposite.GetCount: integer;
begin
  result := FComponent.Count;
end;

function TComposite.GetChild(i: integer): TComponent;
begin
  result := TComponent(FComponent.Items[i]);
end;

function TComposite.GetName: string;
begin
  result := 'Kompositum: ' + Key + ', ' + Name;
end;

procedure TComposite.Add(AComponent: TComponent);
begin
  FComponent.Add(AComponent);
end;

{$ENDREGION}

{$REGION 'TLeaf' }

constructor TLeaf.Create(iKey, iName: string);
begin
  inherited create;
  Key := iKey;
  Name := iName;
end;

function TLeaf.GetCount: integer;
begin
  result := 0;
end;

function TLeaf.GetName: string;
begin
  result := 'Blatt: ' + Key + ', ' + Name;
end;

{$ENDREGION}

end.

Und hier der Quellcode zum Testen:

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls,
  Composite, Composite2, Iteratoren;

type
  TForm1 = class(TForm)
    TreeView1: TTreeView;
    Button1: TButton;
    TreeView2: TTreeView;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    Wurzel : TComponent;
    procedure CreateWurzel;
    procedure FillTree;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  FillTree;
end;

procedure TForm1.CreateWurzel;
var
  E1_Komponente : TComponent;
  E2_Komponente : TComponent;
  E3_Komponente : TComponent;
  E4_Komponente : TComponent;
begin
  Wurzel := TComposite.Create('Wurzel', 'Die Wurzel');
  E1_Komponente := TComposite.Create('E1', '#1 von Ebene 1');
  E2_Komponente := TComposite.Create('E2', '#1 von Ebene 2');
  E3_Komponente := TComposite.Create('E3', '#1 von Ebene 3');
  Wurzel.Add(E1_Komponente);
  E1_Komponente.Add(E2_Komponente);
  E2_Komponente.Add(E3_Komponente);

  E2_Komponente.Add(TLeaf.Create('B1','Blatt1 von E2'));
  E2_Komponente.Add(TLeaf.Create('B2','Blatt2 von E2'));
  E2_Komponente.Add(TLeaf.Create('B3','Blatt3 von E2'));

  E3_Komponente.Add(TLeaf.Create('B1','Blatt1 von E3'));

  E4_Komponente := TComposite.Create('E4', 'E4: Noch jemand da');
  Wurzel.Add(E4_Komponente);
  E4_Komponente.Add(TLeaf.Create('B1','Blatt1 von E4'));
end;

procedure TForm1.FillTree;

  procedure Recur(iActNode: TTreeNode; iKomponente:TComponent);
  var
    ActNode: TTreeNode;
    i : integer;
  begin
    if iKomponente <> nil then
      for i := 0 to iKomponente.GetCount - 1 do
      begin
        ActNode := TreeView1.Items.AddChildObject(iActNode, iKomponente.GetChild(i).GetName, iKomponente.GetChild(i));
        if iKomponente.GetChild(i).GetCount <> 0 then
           Recur(ActNode,iKomponente.GetChild(i));
      end;
  end;

begin
  TreeView1.Items.Clear;
  Recur(nil, Wurzel);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  CreateWurzel;
end;

end.

Ich werde später noch mal auf das Muster zurück kommen und es mit mehr Funktionalität und einem Iterator versehen.

Weiterführende Links:

http://www.klempert.de/nested_sets/

http://www.bluegate.at/tutorials-faqs/design-patterns/nested-sets-verstehen-und-anwenden/