《GOF设计模式》—享元（FLYWEIGHT）—Delphi源码示例：享元接口

示例：享元接口

说明：

（1）、定义

运用共享技术有效地支持大量细粒度的对象。

（2）、结构

 

享元对象

Flyweight：描述一个接口，通过这个接口flyweight可以接受并作用于外部状态。

ConcreteFlyweight：实现Flyweight接口，并为内部状态（如果有的话）增加存储空间。ConcreteFlyweight对象必须是可共享的。它所存储的状态必须是内部的；即，它必须独立于ConcreteFlyweight对象的场景。

UnsharedConcreteFlyweight：并非所有的Flyweight子类都需要被共享。Flyweight接口使共享成为可能，但它并不强制共享。在Flyweight对象结构的某些层次，UnsharedConcreteFlyweight对象通常将ConcreteFlyweight对象作为子节点。

对象工厂

FlyweightFactory：创建并管理flyweight对象。确保合理地共享flyweight。当用户请求一个flyweight时，FlyweightFactory对象提供一个已创建的实例或者创建一个（如果不存在的话）。

客户端

Client：维持一个对flyweight的引用。计算或存储一个（多个）flyweight的外部状态。

代码：

unit uFlyweight;

 

interface

 

uses

    SysUtils,Classes,Dialogs,Contnrs;

 

type

    TState = string;

    TStates = array of TState;

 

    TContext = class;

 

    TFlyweight = class

    public

        procedure Operation(extrinsicState: TContext); virtual; abstract;

    end;

 

    TConcreteFlyweight = class(TFlyweight)

    private

        FIntrinsicState: TState;

    public

        constructor Create(AIntrinsicState: TState);

        //---

        procedure Operation(extrinsicState: TContext); override;

        //---

        property IntrinsicState: TState read FIntrinsicState;

    end;

 

    TUnsharedConcreteFlyweight = class(TFlyweight)

    private

        FAllState: TStates;

        function GetAllState(Index: Integer): TState;

        procedure SetAllState(Index: Integer; const Value: TState);

    public

        procedure Operation(extrinsicState: TContext); override;

        //---

        property AllState[Index: Integer]: TState read GetAllState write SetAllState;

    end;

 

    TConcreteFlyweights = class(TObjectList)

    private

        function GetItems(Index: Integer): TConcreteFlyweight;

    public

        function Find(Key: TState): TConcreteFlyweight;

        //---

        property Items[Index: Integer]: TConcreteFlyweight read GetItems;

    end;

 

    TFlyweightFactory = class

    private

        FFlyweights: TConcreteFlyweights;

    public

        constructor Create;

        destructor Destroy; override;

        //---

        class function Instance: TFlyweightFactory;

        //---

        function GetFlyweight(Key: TState): TConcreteFlyweight; overload;

        function GetFlyweight: TUnsharedConcreteFlyweight; overload;

    end;

 

    TContext = class

    private

        FIndex: Integer;

    public

        procedure Next(const AStep: Integer = 1);

        function GetInfo(AState: TState): string;

    end;

 

implementation

 

var

    FlyweightFactory: TFlyweightFactory;

 

constructor TFlyweightFactory.Create;

begin

    if FlyweightFactory = nil then

    begin

        FlyweightFactory := Self;

        FFlyweights := TConcreteFlyweights.Create;

    end

    else

        raise Exception.Create('Error');

end;

 

destructor TFlyweightFactory.Destroy;

begin

    FFlyweights.Free;

    FlyweightFactory := nil;

    //---

    inherited;

end;

 

function TFlyweightFactory.GetFlyweight(Key: TState): TConcreteFlyweight;

var

    AFlyweight: TConcreteFlyweight;

begin

    AFlyweight := FFlyweights.Find(Key);

    if not Assigned(AFlyweight) then

    begin

        AFlyweight := TConcreteFlyweight.Create(Key);

        FFlyweights.Add(AFlyweight);

    end;

    //---

    Result := AFlyweight;

end;

 

function TFlyweightFactory.GetFlyweight: TUnsharedConcreteFlyweight;

begin

    Result := TUnsharedConcreteFlyweight.Create;

end;

 

class function TFlyweightFactory.Instance: TFlyweightFactory;

begin

    if FlyweightFactory = nil then

        FlyweightFactory := TFlyweightFactory.Create;

    //---

    Result := FlyweightFactory;

end;

 

function TConcreteFlyweights.Find(Key: TState): TConcreteFlyweight;

var

    i: integer;

begin

    for i := 0 to self.Count - 1 do

    begin

        if self.Items[i].IntrinsicState = Key then

        begin

            Result := self.Items[i];

            exit;

        end;

    end;

    //---

    Result := nil;

end;

 

function TConcreteFlyweights.GetItems(Index: Integer): TConcreteFlyweight;

begin

    Result := TConcreteFlyweight(inherited Items[Index]);

end;

 

constructor TConcreteFlyweight.Create(AIntrinsicState: TState);

begin

    inherited Create;

    //---

    FIntrinsicState := AIntrinsicState;

end;

 

procedure TConcreteFlyweight.Operation(extrinsicState: TContext);

begin

    ShowMessage(extrinsicState.GetInfo(FIntrinsicState));

end;

 

function TUnsharedConcreteFlyweight.GetAllState(Index: Integer): TState;

begin

    Result := FAllState[Index];

end;

 

procedure TUnsharedConcreteFlyweight.Operation(extrinsicState: TContext);

var

    i:integer;

begin

    for i := low(FAllState)  to High(FAllState) do

    begin

        TFlyweightFactory.Instance.GetFlyweight(FAllState[i]).Operation(extrinsicState);

        extrinsicState.Next;

    end;

end;

 

procedure TUnsharedConcreteFlyweight.SetAllState(Index: Integer; const Value:

    TState);

var

    ACount: integer;

begin

    ACount := Length(FAllState);

    if Index >= ACount then

    begin

        SetLength(FAllState,ACount + 1);

        FAllState[ACount] := Value;

    end

    else

        FAllState[Index] := Value;

end;

 

function TContext.GetInfo(AState: TState): string;

begin

    if FIndex < 2 then

        Result := LowerCase(AState)

    else

        Result := AState;

end;

 

procedure TContext.Next(const AStep: Integer);

begin

    FIndex := FIndex + AStep;

end;

 

initialization

    FlyweightFactory := nil;

 

finalization

    if FlyweightFactory <> nil then

        FlyweightFactory.Free;

 

end.

 

procedure TfmDoc.Button1Click(Sender: TObject);

var

    AFlyweight: TUnsharedConcreteFlyweight;

    AContext: TContext;

    s:string;

    i:integer;

begin

    AFlyweight := TUnsharedConcreteFlyweight.Create;

    AContext := TContext.Create;

    try

        with AFlyweight do

        begin

            s := 'AABBCCde';

            for i := 1 to length(s) do

                AllState[i - 1] := s[i];

        end;

        AFlyweight.Operation(AContext);

    finally

        AFlyweight.Free;

        AContext.Free;

    end;

end;