《GOF设计模式》—原型(Prototype)—Delphi源码示例：电路设计编辑器

示例：电路设计编辑器

实现：

电路设计编辑器是由子电路来构造电路的。为方便起见，这样的应用通常允许你实例化复杂的、用户定义的子电路结构，比方说，一次又一次的重复使用一个特定的子电路。

使用Prototype模式，我们仅需将这个子电路作为一个原型增加到可用的电路元素选择板中。只要组合电路对象将Clone实现为一个深拷贝，具有不同结构的电路就可以是原型了。

特点：

（1）、改变结构以指定新对象。

许多应用由部件和子部件来创建对象。

代码：

unit uCircuitryEditor;

 

interface

 

uses

    Windows,SysUtils,Classes,Graphics,Types,uMusicEditor;

 

type

    TEMouseState = (msMouseDown,msMouseMove,msMouseUp);

 

    {线路}

    TCircuitry = class

    private

        FCanvas: TCanvas;

        FPosition: TPoint;

    protected

        function GetName: string; virtual; abstract;

    public

        constructor Create(ACanvas: TCanvas);

        //---

        procedure Add(ACircuitry: TCircuitry); virtual;

        function Clone: TCircuitry; virtual; abstract;

        procedure Draw(const APosition: TPoint); virtual; abstract;

        function PtInCircuitry(const APosition: TPoint): boolean; virtual; abstract;

        //---

        property Name: string read GetName;

        property Position: TPoint read FPosition;

        property Canvas: TCanvas read FCanvas;

    end;

    TCircuitryA = class(TCircuitry)

    protected

        function GetName: string; override;

        function GetRect: TRect;

    public

        function Clone: TCircuitry; override;

        procedure Draw(const APosition: TPoint); override;

        function PtInCircuitry(const APosition: TPoint): boolean; override;

    end;

    TCircuitryB = class(TCircuitry)

    protected

        function GetName: string; override;

        function GetRect: TRect;

    public

        function Clone: TCircuitry; override;

        procedure Draw(const APosition: TPoint); override;

        function PtInCircuitry(const APosition: TPoint): boolean; override;

    end;

    TObjectList = class

    private

        FList: TList;

        procedure Clear;

        function GetCount: Integer;

    public

        constructor Create;

        destructor Destroy; override;

        //---

        property Count: Integer read GetCount;

    end;

    TCircuitryList = class(TObjectList)

    private

        function GetItems(Index: Integer): TCircuitry;

    public

        procedure Add(ACircuitry: TCircuitry);

        //---

        property Items[Index: Integer]: TCircuitry read GetItems; default;

    end;

    TCompositeCircuitry = class(TCircuitry)

    private

        FCircuitrys: TCircuitryList;

    protected

        function GetName: string; override;

    public

        constructor Create(ACanvas: TCanvas);

        destructor Destroy; override;

        //---

        procedure Add(ACircuitry: TCircuitry); override;

        function Clone: TCircuitry; override;

        procedure Draw(const APosition: TPoint); override;

        function PtInCircuitry(const APosition: TPoint): boolean; override;

    end;

 

    TCircuitryDrawing = class(TCircuitryList)

    end;

 

    TTool = class

    private

        FDrawing: TCircuitryDrawing;

    protected

        function GetName: string; virtual; abstract;

    public

        constructor Create(ADrawing: TCircuitryDrawing);

        //---

        procedure Manipulator(AMouseState: TEMouseState; const APosition: TPoint); virtual; abstract;

        //---

        property Name: string read GetName;

    end;

    TCircuitryTool = class(TTool)

    private

        FPrototype: TCircuitry;

    protected

        function GetName: string; override;

    public

        constructor Create(ADrawing: TCircuitryDrawing; APrototype: TCircuitry);

        destructor Destroy; override;

        //---

        procedure Manipulator(AMouseState: TEMouseState; const APosition: TPoint); override;

    end;

 

    TToolList = class;

 

    TCreateCircuitryTool = class(TTool)

    private

        FRect: TRect;

        FDrag: boolean;

        FPrototype: TCircuitry;

        FTools: TToolList;

    protected

        function GetName: string; override;

    public

        constructor Create(ATools: TToolList; ADrawing: TCircuitryDrawing; APrototype: TCircuitry);

        destructor Destroy; override;

        //---

        procedure Manipulator(AMouseState: TEMouseState; const APosition: TPoint); override;

    end;

 

    TToolList = class(TObjectList)

    private

        FOnChanged: TNotifyEvent;

        FSelectIndex: integer;

        function GetItems(Index: Integer): TTool;

        function GetSelection: TTool;

        procedure SetSelection(const Value: TTool);

    public

        procedure Add(ATool: TTool);

        //---

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

        property Selection: TTool read GetSelection write SetSelection;

        property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;

    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 TCircuitry.Create(ACanvas: TCanvas);

begin

    FCanvas := ACanvas;

end;

 

procedure TCircuitry.Add(ACircuitry: TCircuitry);

begin

    raise Exception.Create('不支持该方法');

end;

 

function TCircuitryA.Clone: TCircuitry;

begin

    Result := TCircuitryA.Create(FCanvas);

    Result.FPosition := self.FPosition;

end;

 

function TCircuitryA.GetRect: TRect;

const

    CNT_Radius = 20;

begin

    with FPosition do

        Result := Classes.Rect(X - CNT_Radius,Y - CNT_Radius,X + CNT_Radius,Y + CNT_Radius);

end;

 

procedure TCircuitryA.Draw(const APosition: TPoint);

begin

    FPosition := APosition;

    //---

    with FCanvas do

    begin

        with Pen do

        begin

            Color := clRed;

            Style := psSolid;

            Width := 2;

            Mode := pmXor;

        end;

        Brush.Style := bsClear;

        //---

        with self.GetRect do

        begin

            MoveTo(Left,FPosition.Y);

            LineTo(Right,FPosition.Y);

        end;

    end;

end;

 

function TCircuitryA.GetName: string;

begin

    Result := '线路A';

end;

 

function TCircuitryA.PtInCircuitry(const APosition: TPoint): boolean;

begin

    Result := Windows.PtInRect(self.GetRect,APosition);

end;

 

function TCircuitryB.Clone: TCircuitry;

begin

    Result := TCircuitryB.Create(FCanvas);

    Result.FPosition := self.FPosition;

end;

 

function TCircuitryB.GetName: string;

begin

    Result := '线路B';

end;

procedure TCircuitryB.Draw(const APosition: TPoint);

begin

    FPosition := APosition;

    //---

    with FCanvas do

    begin

        with Pen do

        begin

            Color := clRed;

            Style := psSolid;

            Width := 2;

            Mode := pmXor;

        end;

        Brush.Style := bsClear;

        //---

        with self.GetRect do

        begin

            MoveTo(FPosition.X,Top);

            LineTo(FPosition.X,Bottom);

        end;

    end;

end;

 

function TCircuitryB.GetRect: TRect;

const

    CNT_Radius = 20;

begin

    with FPosition do

        Result := Classes.Rect(X - CNT_Radius,Y - CNT_Radius,X + CNT_Radius,Y + CNT_Radius);

end;

 

function TCircuitryB.PtInCircuitry(const APosition: TPoint): boolean;

begin

    Result := Windows.PtInRect(self.GetRect,APosition);

end;

 

constructor TCompositeCircuitry.Create(ACanvas: TCanvas);

begin

    inherited;

    //---

    FCircuitrys := TCircuitryList.Create;

end;

 

destructor TCompositeCircuitry.Destroy;

begin

    FCircuitrys.Free;

    //---

    inherited;

end;

 

procedure TCompositeCircuitry.Add(ACircuitry: TCircuitry);

begin

    FCircuitrys.Add(ACircuitry);

end;

 

function TCompositeCircuitry.Clone: TCircuitry;

var

    ACircuitry: TCompositeCircuitry;

    i: integer;

begin

    ACircuitry := TCompositeCircuitry.Create(FCanvas);

    //---

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

        ACircuitry.Add(FCircuitrys[i].Clone);

    //---

    Result := ACircuitry;

end;

 

procedure TCompositeCircuitry.Draw(const APosition: TPoint);

var

    i: integer;

    p: TPoint;

begin

    FPosition := APosition;

    //---

    if FCircuitrys.Count = 0 then

        exit;

    //---

    p := FCircuitrys[0].Position;

    FCircuitrys[0].Draw(APosition);

    //---

    for i := 1 to FCircuitrys.Count - 1 do

    begin

        with FCircuitrys[i] do

            Draw(Types.Point(APosition.X + (Position.X - p.X),APosition.Y + (Position.Y - p.Y)));

    end;

end;

 

function TCompositeCircuitry.GetName: string;

begin

    Result := '子线路';

end;

 

function TCompositeCircuitry.PtInCircuitry(const APosition: TPoint): boolean;

var

    i: integer;

begin

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

    begin

        if FCircuitrys[i].PtInCircuitry(APosition) then

        begin

            Result := true;

            exit;

        end;

    end;

    //---

    Result := false;

end;

 

procedure TCircuitryList.Add(ACircuitry: TCircuitry);

begin

    FList.Add(ACircuitry);

end;

 

function TCircuitryList.GetItems(Index: Integer): TCircuitry;

begin

    Result := FList[Index];

end;

 

constructor TTool.Create(ADrawing: TCircuitryDrawing);

begin

    FDrawing := ADrawing;

end;

 

constructor TCircuitryTool.Create(ADrawing: TCircuitryDrawing; APrototype:

    TCircuitry);

begin

    inherited Create(ADrawing);

    //---

    FPrototype := APrototype;

end;

 

destructor TCircuitryTool.Destroy;

begin

    FPrototype.Free;

    //---

    inherited;

end;

 

function TCircuitryTool.GetName: string;

begin

    Result := FPrototype.Name;

end;

 

procedure TCircuitryTool.Manipulator(AMouseState: TEMouseState; const APosition: TPoint);

var

    ACircuitry: TCircuitry;

begin

    if AMouseState = msMouseUp then

    begin

        ACircuitry := FPrototype.Clone;

        ACircuitry.Draw(APosition);

        //---

        FDrawing.Add(ACircuitry);

    end;

end;

 

constructor TCreateCircuitryTool.Create(ATools: TToolList; ADrawing: TCircuitryDrawing; APrototype: TCircuitry);

begin

    inherited Create(ADrawing);

    //---

    FTools := ATools;

    FPrototype := APrototype;

    FRect := Classes.Rect(0,0,0,0);

end;

 

destructor TCreateCircuitryTool.Destroy;

begin

    FPrototype.Free;

    //---

    inherited;

end;

 

function TCreateCircuitryTool.GetName: string;

begin

    Result := '创建子线路';

end;

 

procedure TCreateCircuitryTool.Manipulator(AMouseState: TEMouseState; const APosition: TPoint);

    //---

    procedure _DrawRect;

    begin

        with FDrawing.Items[0] do

        begin

            with Canvas do

            begin

                Brush.Color := clWhite;

                DrawFocusRect(FRect);

            end;

        end;

    end;

    //---

    procedure _ClearRect;

    begin

        _DrawRect;

    end;

    //---

    procedure _GetSelectCircuitry;

    var

        i: integer;

        ACircuitry: TCircuitry;

    begin

        ACircuitry := nil;

        //---

        with FDrawing do

        begin

            for i := 0 to Count - 1 do

            begin

                if Windows.PtInRect(FRect,Items[i].Position) then

                begin

                    if ACircuitry = nil then

                        ACircuitry := FPrototype.Clone;

                    //---

                    ACircuitry.Add(Items[i].Clone);

                end;

            end;

        end;

        //---

        if ACircuitry <> nil then

            FTools.Add(TCircuitryTool.Create(FDrawing,ACircuitry));

    end;

begin

    if FDrawing.Count = 0 then

        exit;

    //---

    case AMouseState of

        msMouseDown:

            begin

                FDrag := true;

                FRect.TopLeft := APosition;

            end;

        msMouseMove:

            begin

                if FDrag then

                begin

                    with FRect do

                    begin

                        if (Left <> Right) or (Top <> Bottom) then

                            _ClearRect;

                    end;

                    //---

                    FRect.BottomRight := APosition;

                    _DrawRect;

                end;

            end;

        msMouseUp:

            begin

                if FDrag then

                begin

                    FDrag := false;

                    //---

                    _GetSelectCircuitry;

                    //---

                    _ClearRect;

                    FRect := Classes.Rect(0,0,0,0);

                end;

            end;

    end;

end;

 

function TToolList.GetItems(Index: Integer): TTool;

begin

    Result := FList[Index];

end;

 

procedure TToolList.Add(ATool: TTool);

begin

    FList.Add(ATool);

    //---

    if assigned(FOnChanged) then

        FOnChanged(self);

end;

 

function TToolList.GetSelection: TTool;

begin

    if FSelectIndex >= 0 then

        Result := FList[FSelectIndex]

    else

        Result := nil;

end;

 

procedure TToolList.SetSelection(const Value: TTool);

begin

    FSelectIndex := FList.IndexOf(Value);

end;

 

constructor TObjectList.Create;

begin

    FList := TList.Create;

end;

 

destructor TObjectList.Destroy;

begin

    self.Clear;

    FList.Free;

    //---

    inherited;

end;

 

procedure TObjectList.Clear;

var

    i: Integer;

begin

    with FList do

    begin

        for i := 0 to Count - 1 do

            TObject(Items[i]).Free;

        //---

        Clear;

    end;

end;

 

function TObjectList.GetCount: Integer;

begin

    Result := FList.Count;

end;

 

end.

 

unit Unit1;

 

interface

 

uses

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

    StdCtrls,ExtCtrls,ToolWin,ComCtrls,uCircuitryEditor;

 

type

    TForm1 = class(TForm)

        Image1: TImage;

        ListBox1: TListBox;

        procedure FormDestroy(Sender: TObject);

        procedure FormCreate(Sender: TObject);

        procedure FormResize(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);

        procedure ListBox1Click(Sender: TObject);

    private

        FTools: TToolList;

        FDrawing: TCircuitryDrawing;

        procedure ToolsChanged(Sender: TObject);

    public

    { Public declarations }

    end;

 

var

    Form1: TForm1;

 

implementation

 

{$R *.DFM}

 

procedure TForm1.FormCreate(Sender: TObject);

    //---

    procedure _InitTools;

    begin

        FTools := TToolList.Create;

        FTools.OnChanged := self.ToolsChanged;

        //---

        with FTools do

        begin

            Add(TCreateCircuitryTool.Create(FTools,FDrawing,TCompositeCircuitry.Create(Image1.Canvas)));

            Add(TCircuitryTool.Create(FDrawing,TCircuitryA.Create(Image1.Canvas)));

            Add(TCircuitryTool.Create(FDrawing,TCircuitryB.Create(Image1.Canvas)));

        end;

    end;

begin

    FDrawing := TCircuitryDrawing.Create;

    //---

    _InitTools;

end;

 

procedure TForm1.FormDestroy(Sender: TObject);

begin

    FTools.Free;

    FDrawing.Free;

end;

 

procedure TForm1.FormResize(Sender: TObject);

begin

    with Image1.Picture.Graphic do

    begin

        Height := Image1.Height;

        Width := Image1.Width;

    end;

    ClearBackground(Image1.Canvas);

end;

 

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

    TShiftState; X,Y: Integer);

begin

    with FTools do

    begin

        if Selection <> nil then

            Selection.Manipulator(msMouseDown,Point(X,Y));

    end;

end;

 

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

    Integer);

begin

    with FTools do

    begin

        if Selection <> nil then

            Selection.Manipulator(msMouseMove,Point(X,Y));

    end;

end;

 

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

    TShiftState; X,Y: Integer);

begin

    with FTools do

    begin

        if Selection <> nil then

            Selection.Manipulator(msMouseUp,Point(X,Y));

    end;

end;

 

procedure TForm1.ListBox1Click(Sender: TObject);

begin

    with ListBox1 do

    begin

        if ItemIndex >= 0 then

            FTools.Selection := Items.Objects[ItemIndex] as TTool

        else

            FTools.Selection := nil;

    end;

end;

 

procedure TForm1.ToolsChanged(Sender: TObject);

var

    AIndex: integer;

begin

    if FTools.Count > ListBox1.Count then

    begin

        with FTools do

        begin

            AIndex := Count - 1;

            ListBox1.Items.AddObject(Items[AIndex].Name,Items[AIndex]);

        end;

    end;

end;

 

end.

窗体文件：

object Form1: TForm1

  Left = 294

  Top = 230

  Width = 442

  Height = 296

  Caption = 'Prototype'

  Color = clBtnFace

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'MS Sans Serif'

  Font.Style = []

  OldCreateOrder = False

  OnCreate = FormCreate

  OnDestroy = FormDestroy

  OnResize = FormResize

  PixelsPerInch = 96

  TextHeight = 13

  object Image1: TImage

    Left = 121

    Top = 0

    Width = 313

    Height = 262

    Align = alClient

    AutoSize = True

    OnMouseDown = Image1MouseDown

    OnMouseMove = Image1MouseMove

    OnMouseUp = Image1MouseUp

  end

  object ListBox1: TListBox

    Left = 0

    Top = 0

    Width = 121

    Height = 262

    Align = alLeft

    ItemHeight = 13

    TabOrder = 0

    OnClick = ListBox1Click

  end

end