《GOF设计模式》—访问者（VISITOR）—Delphi源码示例：设备

示例：设备
代码：
 


unit uEquipment;

interface

uses
    SysUtils, Classes, Dialogs, Contnrs, uIterator;

type
    TEquipmentVisitor = class;

    {设备接口}
    TEquipment = class
    private
        FName: string;
    public
        constructor Create(const AName: string);
        //---
        {用电量}
        function Power(): Integer; virtual; abstract;
        {设备价格}
        function NetPrice(): Currency; virtual; abstract;
        {设备折扣价}
        function DiscountPrice(): Currency; virtual; abstract;
        //---
        procedure Add(const AEquipment: TEquipment); virtual;
        procedure Remove(const AEquipment: TEquipment); virtual;
        function CreateIterator(): TIterator; virtual;
        procedure Accept(AVisitor: TEquipmentVisitor); virtual; abstract;
        //---
        property Name: string read FName write FName;
    end;
    {组合设备}
    TCompositeEquipment = class(TEquipment)
    private
        FEquipments: TObjectList;
    public
        constructor Create(const AName: string);
        destructor Destroy; override;
        //---
        procedure Add(const AEquipment: TEquipment); override;
        procedure Remove(const AEquipment: TEquipment); override;
        function CreateIterator: TIterator; override;
        procedure Accept(AVisitor: TEquipmentVisitor); override;
    end;
    {机柜}
    TCabinet = class(TCompositeEquipment)
    public
        function Power(): Integer; override;
        function NetPrice(): Currency; override;
        function DiscountPrice(): Currency; override;
        //---
        procedure Accept(AVisitor: TEquipmentVisitor); override;
    end;
    {底盘}
    TChassis = class(TCompositeEquipment)
    public
        function Power(): Integer; override;
        function NetPrice(): Currency; override;
        function DiscountPrice(): Currency; override;
        //---
        procedure Accept(AVisitor: TEquipmentVisitor); override;
    end;
    {总线}
    TBus = class(TCompositeEquipment)
    public
        function Power(): Integer; override;
        function NetPrice(): Currency; override;
        function DiscountPrice(): Currency; override;
        //---
        procedure Accept(AVisitor: TEquipmentVisitor); override;
    end;
    {软驱}
    TFloppyDisk = class(TEquipment)
    public
        function Power(): Integer; override;
        function NetPrice(): Currency; override;
        function DiscountPrice(): Currency; override;
        //---
        procedure Accept(AVisitor: TEquipmentVisitor); override;
    end;
    {插件}
    TCard = class(TEquipment)
    public
        function Power(): Integer; override;
        function NetPrice(): Currency; override;
        function DiscountPrice(): Currency; override;
        //---
        procedure Accept(AVisitor: TEquipmentVisitor); override;
    end;

    TEquipmentVisitor = class
    public
        procedure VisitFloppyDisk(AFloppyDisk: TFloppyDisk); virtual;
        procedure VisitCard(ACard: TCard); virtual;
        procedure VisitChassis(AChassis: TChassis); virtual;
        procedure VisitBus(ABus: TBus); virtual;
        procedure VisitCabinet(ACabinet: TCabinet); virtual;
    end;
    {定价策略: 计算设备总费用}
    TPricingVisitor = class(TEquipmentVisitor)
    private
        FTotal: Currency;
        function GetTotalPrice: Currency;
    public
        procedure VisitBus(ABus: TBus); override;
        procedure VisitCabinet(ACabinet: TCabinet); override;
        procedure VisitCard(ACard: TCard); override;
        procedure VisitChassis(AChassis: TChassis); override;
        procedure VisitFloppyDisk(AFloppyDisk: TFloppyDisk); override;
        //---
        property TotalPrice: Currency read GetTotalPrice;
    end;
    {存货清单}
    TInventory = class
    private
        FList: TStringList;
        function GetText: string;
    public
        constructor Create();
        destructor Destroy; override;
        //---
        procedure Accumulate(e: TEquipment);
        //---
        property Text: string read GetText;
    end;
    {计算材料存货清单}
    TInventoryVisitor = class(TEquipmentVisitor)
    private
        FInventory: TInventory;
        function GetInventory: TInventory;
    public
        constructor Create();
        destructor Destroy; override;
        //---
        procedure VisitBus(ABus: TBus); override;
        procedure VisitCabinet(ACabinet: TCabinet); override;
        procedure VisitCard(ACard: TCard); override;
        procedure VisitChassis(AChassis: TChassis); override;
        procedure VisitFloppyDisk(AFloppyDisk: TFloppyDisk); override;
        //---
        property Inventory: TInventory read GetInventory;
    end;

procedure Test;
procedure Test1;
procedure Test2;

implementation

procedure Test;
var
    Cabinet: TCabinet;
    Chassis: TChassis;
    Bus: TBus;
    AVisitor: TPricingVisitor;
begin
    Cabinet := TCabinet.Create('PC Cabinet');
    try
        Chassis := TChassis.Create('PC Chassis');
        Cabinet.Add(Chassis);
        //---
        Bus := TBus.Create('MCA Bus');
        Bus.Add(TCard.Create('16Mbs Token Ring'));
        Chassis.Add(Bus);
        //---
        Chassis.Add(TFloppyDisk.Create('3.5in Floppy'));
        //---
        AVisitor := TPricingVisitor.Create;
        try
            Cabinet.Accept(AVisitor);
            ShowMessage(CurrToStr(AVisitor.TotalPrice));
        finally
            AVisitor.Free;
        end;
    finally
        Cabinet.Free;
    end;
end;

procedure Test1;
var
    Cabinet: TCabinet;
    Chassis: TChassis;
    Bus: TBus;
    AVisitor: TInventoryVisitor;
begin
    Cabinet := TCabinet.Create('PC Cabinet');
    try
        Chassis := TChassis.Create('PC Chassis');
        Cabinet.Add(Chassis);
        //---
        Bus := TBus.Create('MCA Bus');
        Bus.Add(TCard.Create('16Mbs Token Ring'));
        Bus.Add(TCard.Create('16Mbs Token Ring'));
        Chassis.Add(Bus);
        //---
        Chassis.Add(TFloppyDisk.Create('3.5in Floppy'));
        Chassis.Add(TFloppyDisk.Create('3.5in Floppy'));
        //---
        AVisitor := TInventoryVisitor.Create;
        try
            Cabinet.Accept(AVisitor);
            ShowMessage(AVisitor.Inventory.Text);
        finally
            AVisitor.Free;
        end;
    finally
        Cabinet.Free;
    end;
end;

procedure Test2;
var
    Componment: TEquipment;
    Visitor: TInventoryVisitor;
begin
    Componment := TCard.Create('Card');
    Visitor := TInventoryVisitor.Create;
    //---
    Componment.Accept(visitor);
    ShowMessage('Inventory ' + Componment.Name + ' ' + Visitor.Inventory.Text);
    //---
    Visitor.Free;
    Componment.Free;
end;

constructor TEquipment.Create(const AName: string);
begin
    FName := AName;
end;

procedure TEquipment.Add(const AEquipment: TEquipment);
begin
    raise Exception.Create('不支持该方法');
end;

procedure TEquipment.Remove(const AEquipment: TEquipment);
begin
    raise Exception.Create('不支持该方法');
end;

function TEquipment.CreateIterator(): TIterator;
begin
    Result := nil;
end;

procedure TFloppyDisk.Accept(AVisitor: TEquipmentVisitor);
begin
    AVisitor.VisitFloppyDisk(self);
end;

function TFloppyDisk.Power(): Integer;
begin
    Result := 1;
end;

function TFloppyDisk.NetPrice(): Currency;
begin
    Result := 1;
end;

function TFloppyDisk.DiscountPrice(): Currency;
begin
    Result := 1;
end;

constructor TCompositeEquipment.Create(const AName: string);
begin
    inherited;
    //---
    FEquipments := TObjectList.Create;
end;

destructor TCompositeEquipment.Destroy;
begin
    FEquipments.Free;
    //---
    inherited;
end;

procedure TCompositeEquipment.Accept(AVisitor: TEquipmentVisitor);
var
    AIterator: TIterator;
begin
    AIterator := self.CreateIterator;
    try
        with AIterator do
        begin
            First;
            while not IsDone do
            begin
                TEquipment(CurrentItem).Accept(AVisitor);
                Next;
            end;
        end;
    finally
        AIterator.free;
    end;
end;

procedure TCompositeEquipment.Add(const AEquipment: TEquipment);
begin
    FEquipments.Add(AEquipment);
end;

procedure TCompositeEquipment.Remove(const AEquipment: TEquipment);
begin
    FEquipments.Remove(AEquipment);
end;

function TCompositeEquipment.CreateIterator: TIterator;
begin
    Result := TListIterator.Create(FEquipments);
end;

procedure TChassis.Accept(AVisitor: TEquipmentVisitor);
begin
    inherited;
    //---
    AVisitor.VisitChassis(Self);
end;

function TChassis.Power(): Integer;
begin
    Result := 1;
end;

function TChassis.NetPrice(): Currency;
begin
    Result := 1;
end;

function TChassis.DiscountPrice(): Currency;
begin
    Result := 1;
end;

procedure TCabinet.Accept(AVisitor: TEquipmentVisitor);
begin
    inherited;
    //---
    AVisitor.VisitCabinet(Self);
end;

function TCabinet.Power(): Integer;
begin
    Result := 1;
end;

function TCabinet.NetPrice(): Currency;
begin
    Result := 1;
end;

function TCabinet.DiscountPrice(): Currency;
begin
    Result := 1;
end;

procedure TBus.Accept(AVisitor: TEquipmentVisitor);
begin
    inherited;
    //---
    AVisitor.VisitBus(Self);
end;

function TBus.Power(): Integer;
begin
    Result := 1;
end;

function TBus.NetPrice(): Currency;
begin
    Result := 1;
end;

function TBus.DiscountPrice(): Currency;
begin
    Result := 1;
end;

function TCard.Power(): Integer;
begin
    Result := 1;
end;

function TCard.NetPrice(): Currency;
begin
    Result := 1;
end;

function TCard.DiscountPrice(): Currency;
begin
    Result := 1;
end;

{ TEquipmentVisitor }

procedure TEquipmentVisitor.VisitBus(ABus: TBus);
begin

end;

procedure TEquipmentVisitor.VisitCabinet(ACabinet: TCabinet);
begin

end;

procedure TEquipmentVisitor.VisitCard(ACard: TCard);
begin

end;

procedure TEquipmentVisitor.VisitChassis(AChassis: TChassis);
begin

end;

procedure TEquipmentVisitor.VisitFloppyDisk(AFloppyDisk: TFloppyDisk);
begin

end;

procedure TCard.Accept(AVisitor: TEquipmentVisitor);
begin
    AVisitor.VisitCard(Self);
end;

function TPricingVisitor.GetTotalPrice: Currency;
begin
    Result := FTotal;
end;

{ TEquipmentVisitor }

procedure TPricingVisitor.VisitBus(ABus: TBus);
begin
    FTotal := FTotal + ABus.DiscountPrice;
end;

procedure TPricingVisitor.VisitCabinet(ACabinet: TCabinet);
begin
    FTotal := FTotal + ACabinet.DiscountPrice;
end;

procedure TPricingVisitor.VisitCard(ACard: TCard);
begin
    FTotal := FTotal + ACard.NetPrice;
end;

procedure TPricingVisitor.VisitChassis(AChassis: TChassis);
begin
    FTotal := FTotal + AChassis.DiscountPrice;
end;

procedure TPricingVisitor.VisitFloppyDisk(AFloppyDisk: TFloppyDisk);
begin
    FTotal := FTotal + AFloppyDisk.NetPrice;
end;

constructor TInventoryVisitor.Create;
begin
    FInventory := TInventory.Create;
end;

destructor TInventoryVisitor.Destroy;
begin
    FInventory.Free;
    //---
    inherited;
end;

function TInventoryVisitor.GetInventory: TInventory;
begin
    Result := FInventory;
end;

procedure TInventoryVisitor.VisitBus(ABus: TBus);
begin
    FInventory.Accumulate(ABus);
end;

procedure TInventoryVisitor.VisitCabinet(ACabinet: TCabinet);
begin
    FInventory.Accumulate(ACabinet);
end;

procedure TInventoryVisitor.VisitCard(ACard: TCard);
begin
    FInventory.Accumulate(ACard);
end;

procedure TInventoryVisitor.VisitChassis(AChassis: TChassis);
begin
    FInventory.Accumulate(AChassis);
end;

procedure TInventoryVisitor.VisitFloppyDisk(AFloppyDisk: TFloppyDisk);
begin
    FInventory.Accumulate(AFloppyDisk);
end;

procedure TInventory.Accumulate(e: TEquipment);
var
    ACount: Integer;
begin
    ACount := StrToIntDef(FList.Values[e.Name], 0);
    FList.Values[e.Name] := IntToStr(ACount + 1);
end;

constructor TInventory.Create;
begin
    FList := TStringList.Create;
end;

destructor TInventory.Destroy;
begin
    FList.Free;
    //---
    inherited;
end;

function TInventory.GetText: string;
begin
    Result := FList.Text;
end;

end.

unit uIterator;

interface

uses classes;

type
    {迭代器}
    TIterator = class
    public
        procedure First; virtual; abstract;
        procedure Next; virtual; abstract;
        function IsDone: Boolean; virtual; abstract;
        function CurrentItem(): TObject; virtual; abstract;
    end;
    TListIterator = class(TIterator)
    private
        FList: TList;
        FIndex: Integer;
    public
        constructor Create(const AList: TList);
        //---
        procedure First; override;
        procedure Next; override;
        function IsDone: Boolean; override;
        function CurrentItem(): TObject; override;
    end;

implementation

constructor TListIterator.Create(const AList: TList);
begin
    inherited Create;
    //---
    FList := AList;
    FIndex := 0;
end;

procedure TListIterator.First();
begin
    FIndex := 0;
end;

procedure TListIterator.Next();
begin
    FIndex := FIndex + 1;
end;

function TListIterator.IsDone: Boolean;
begin
    Result := FIndex >= FList.Count;
end;

function TListIterator.CurrentItem(): TObject;
begin
    Result := FList[FIndex];
end;

end.