《GOF设计模式》—工厂方法(Factory Method)—Delphi源码示例：平行的类层级架构

示例：平行的类层级架构

说明：

当一个类将它的一些职责委托给一个独立的类的时候，就产生了平行类层次。

实现：

对于可以被交互操纵的图形；它们可以用鼠标进行伸展、移动，或者旋转。实现这样一些交互并不总是那么容易，它通常需要存储和更新在给定时刻记录操纵状态的信息，这个状态仅仅在操纵时需要。因此它不需要被保存在图形对象中。此外，当用户操纵图形时，不同的图形有不同的行为。例如，将直线图形拉长可能会产生一个端点被移动的效果，而伸展正文图形则可能会改变行距。

有了这些限制，最好使用一个独立的“操作者对象（Manipulator）”与“图形对象（TFigure）”实现交互并保存所需要的任何与特定操纵相关的状态。不同的“图形”将使用不同的“Manipulator子类”来处理特定的交互。

得到的“Manipulator类层次”与“Figure类层次”是平行（至少部分平行），如下图所示。“Figure图形类”提供了一个“CreateManipulator工厂方法”，它使得客户可以创建一个与“Figure图形类”相对应的“Manipulator操作者类”。“Figure子类”重定义该方法以返回一个合适的“Manipulator子类实例”。

 

TFigure图形

TLineFigure直线图形

TTextFigure文本图形

TManipulator操作者

TLineManipulator直线操作者

TTextManipulator文本操作者

 

代码：

 

unit uFigure;

 

interface

 

uses

    Windows,Classes,Graphics;

 

type

    TManipulatorType = (mtNone,mtPoint1,mtPoint2);

 

    TPoints = array[1..2] of TPoint;

 

    TManipulator = class;

 

    {图形}

    TFigure = class

    private

        function GetHasFigure: boolean;

        function GetPoints(Index: integer): TPoint;

        procedure SetPoints(Index: integer; const Value: TPoint);

    protected

        FCanvas: TCanvas;

        FPoints: TPoints;

    public

        constructor Create;

        //---

        function CreateManipulator: TManipulator; virtual; abstract;

        procedure Clear; virtual; abstract;

        procedure Draw; virtual; abstract;

        //---

        property Canvas: TCanvas read FCanvas write FCanvas;

        property HasFigure: boolean read GetHasFigure;

        property Points[Index: integer]: TPoint read GetPoints write SetPoints;

    end;

    {直线图形}

    TLineFigure = class(TFigure)

    public

        function CreateManipulator: TManipulator; override;

        procedure Clear; override;

        procedure Draw; override;

    end;

    {文本图形}

    TTextFigure = class(TFigure)

    private

        FText: string;

        FTextWidth: integer;

    public

        constructor Create;

        //---

        function CreateManipulator: TManipulator; override;

        procedure Clear; override;

        procedure Draw; override;

    end;

 

    {操作者}

    TManipulator = class

    protected

        FFigure: TFigure;

        FManipulatorType: TManipulatorType;

        function PtInFigure(const p: TPoint): TManipulatorType;

    public

        constructor Create(AFigure: TFigure);

        //---

        procedure DownClick(X,Y: Integer); virtual;

        procedure Drag(X,Y: Integer); virtual; abstract;

        procedure UpClick(X,Y: Integer); virtual;

    end;

    {直线操作者}

    TLineManipulator = class(TManipulator)

    public

        procedure Drag(X,Y: Integer); override;

    end;

    {文本操作者}

    TTextManipulator = class(TManipulator)

    public

        procedure Drag(X,Y: Integer); override;

    end;

 

procedure ClearBackground(ACanvas: TCanvas);

 

implementation

 

procedure ClearBackground(ACanvas: TCanvas);

begin

    with ACanvas do

    begin

        with Brush do

        begin

            Color := clBlack;

            Style := bsSolid;

        end;

        FillRect(ClipRect);

    end;

end;

 

constructor TFigure.Create;

    //---

    procedure _InitPoints;

    var

        i: integer;

    begin

        for i := low(FPoints) to high(FPoints) do

        begin

            with FPoints[i] do

            begin

                X := 0;

                Y := 0;

            end;

        end;

    end;

begin

    inherited;

    //---

    FCanvas := nil;

    _InitPoints;

end;

 

function TFigure.GetHasFigure: boolean;

var

    i: integer;

begin

    Result := false;

    //---

    for i := low(FPoints) to high(FPoints) do

    begin

        with FPoints[i] do

            Result := Result or ((X <> 0) and (Y <> 0));

    end;

end;

 

function TFigure.GetPoints(Index: integer): TPoint;

begin

    Result := FPoints[Index];

end;

 

procedure TFigure.SetPoints(Index: integer; const Value: TPoint);

begin

    FPoints[Index] := Value;

end;

 

function TLineFigure.CreateManipulator: TManipulator;

begin

    Result := TLineManipulator.Create(self);

end;

 

procedure TLineFigure.Clear;

begin

    Draw;

end;

 

procedure TLineFigure.Draw;

begin

    with self.Canvas do

    begin

        with Pen do

        begin

            Color := clYellow;

            Style := psSolid;

            Width := 1;

            Mode := pmXor;

        end;

        //---

        with FPoints[1] do

            MoveTo(X,Y);

        with FPoints[2] do

            LineTo(X,Y);

    end;

end;

 

constructor TTextFigure.Create;

begin

    inherited Create;

    //---

    FText := 'Text';

end;

 

function TTextFigure.CreateManipulator: TManipulator;

begin

    Result := TTextManipulator.Create(self);

end;

 

procedure TTextFigure.Clear;

begin

    with self.Canvas do

    begin

        with Brush do

        begin

            Color := clBlack;

            Style := bsSolid;

        end;

        //---

        FillRect(Rect(FPoints[1].X,FPoints[1].Y,FPoints[2].X + FTextWidth,FPoints[2].Y));

    end;

end;

 

procedure TTextFigure.Draw;

begin

    with self.Canvas do

    begin

        with Font do

        begin

            Style := [];

            Height := abs(FPoints[1].Y - FPoints[2].Y) - 1;

            Color := clYellow;

        end;

        //---

        if FPoints[1].Y < FPoints[2].Y then

            TextOut(FPoints[1].X + 1,FPoints[1].Y + 1,FText)

        else

            TextOut(FPoints[2].X + 1,FPoints[2].Y + 1,FText);

        //---

        with Pen do

        begin

            Color := clYellow;

            Style := psSolid;

            Width := 1;

            Mode := pmXor;

        end;

        //---

        FTextWidth := TextWidth(FText) + 2;

        Rectangle(FPoints[1].X,FPoints[1].Y,FPoints[2].X + FTextWidth,FPoints[2].Y);

    end;

end;

 

constructor TManipulator.Create(AFigure: TFigure);

begin

    FFigure := AFigure;

end;

 

procedure TManipulator.DownClick(X,Y: Integer);

var

    APoint: TPoint;

begin

    APoint := Point(X,Y);

    //---

    with FFigure do

    begin

        if not HasFigure then

        begin

            Points[1] := APoint;

            Points[2] := APoint;

            Draw;

        end;

    end;

    //---

    FManipulatorType := PtInFigure(APoint);

end;

 

function TManipulator.PtInFigure(const p: TPoint): TManipulatorType;

    //---

    function _PtInPoint(sp,dp: TPoint): Boolean;

    const

        PointSize = 6;

    var

        APointRect: TRect;

    begin

        with APointRect do

        begin

            Left := dp.x - PointSize;

            Right := dp.x + PointSize;

            Top := dp.y - PointSize;

            Bottom := dp.y + PointSize;

        end;

        //---

        result := PtInRect(APointRect,sp);

    end;

begin

    with FFigure do

    begin

        if _PtInPoint(p,Points[1]) then

            result := mtPoint1

        else if _PtInPoint(p,Points[2]) then

            Result := mtPoint2

        else

            result := mtNone;

    end;

end;

 

procedure TManipulator.UpClick(X,Y: Integer);

begin

    FManipulatorType := mtNone;

end;

 

procedure TLineManipulator.Drag(X,Y: Integer);

    //---

    procedure _DrawFigure(APointNo: integer; APoint: TPoint);

    begin

        with FFigure do

        begin

            Clear;

            //---

            Points[APointNo] := APoint;

            Draw;

        end;

    end;

begin

    case FManipulatorType of

        mtPoint1: _DrawFigure(1,Point(X,Y));

        mtPoint2: _DrawFigure(2,Point(X,Y));

    end;

end;

 

procedure TTextManipulator.Drag(X,Y: Integer);

    //---

    procedure _DrawFigure(APointNo: integer; APoint: TPoint);

    begin

        with FFigure do

        begin

            Clear;

            //---

            APoint.X := Points[APointNo].X;

            Points[APointNo] := APoint;

            Draw;

        end;

    end;

begin

    case FManipulatorType of

        mtPoint1: _DrawFigure(1,Point(X,Y));

        mtPoint2: _DrawFigure(2,Point(X,Y));

    end;

end;

 

end.

 

unit Unit1;

 

interface

 

uses

    Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,

    Dialogs,StdCtrls,ExtCtrls,uFigure;

 

type

    TForm1 = class(TForm)

        Image1: TImage;

        procedure FormDestroy(Sender: TObject);

        procedure FormCreate(Sender: TObject);

        procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift:

            TShiftState; X,Y: Integer);

        procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);

        procedure Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift:

            TShiftState; X,Y: Integer);

    private

        FFigure: TFigure;

        FManipulator: TManipulator;

    public

    { Public declarations }

    end;

 

var

    Form1: TForm1;

 

implementation

 

{$R *.dfm}

 

procedure TForm1.FormCreate(Sender: TObject);

begin

    FFigure := TLineFigure.Create;

    //FFigure := TTextFigure.Create;

    FFigure.Canvas := Image1.Canvas;

    //---

    FManipulator := FFigure.CreateManipulator;

    //---

    ClearBackground(Image1.Canvas);

end;

 

procedure TForm1.FormDestroy(Sender: TObject);

begin

    FManipulator.Free;

    FFigure.Free;

end;

 

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift:

    TShiftState; X,Y: Integer);

begin

    FManipulator.DownClick(X,Y);

end;

 

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,Y:

    Integer);

begin

    FManipulator.Drag(X,Y);

end;

 

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift:

    TShiftState; X,Y: Integer);

begin

    FManipulator.UpClick(X,Y);

end;

 

end.