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

示例：乐谱编辑器

实现：

你可以通过定制一个通用的图形编辑器框架和增加一些表示音符、休止符和五线谱的新对象来构造一个乐谱编辑器。这个编辑器框架可能有一个工具选择板用于将这些音乐对象加到乐谱中。这个选择板可能还包括选择、移动和其他操纵音乐对象的工具。用户可以点击四分音符工具并使用它将四分音符加到乐谱中。或者他们可以使用移动工具在五线谱上上下移动一个音符，从而改变它的音调。

我们假定该框架为音符和五线谱这样的图形构件提供了一个抽象的Graphics类。此外，为定义选择板中的那些工具，还提供一个抽象类Tool。该框架还为一些创建图形对象实例并将它们加入到文档中的工具预定义了一个GraphicTool子类。

但GraphicTool给框架设计者带来一个问题。音符和五线谱的类特定于我们的应用，而GraphicTool类却属于框架。GraphicTool不知道如何创建我们的音乐类的实例，并将它们添加到乐谱中。我们可以为每一种音乐对象创建一个GraphicTool的子类，但这样会产生大量的子类，这些子类仅仅在它们所初始化的音乐对象的类别上有所不同。我们知道对象复合是比创建子类更灵活的一种选择。问题是，该框架怎么样用它来参数化GraphicTool的实例，而这些实例是由Graphic类所支持创建的。

解决办法是让GraphicTool通过拷贝或者“克隆”一个Graphic子类的实例来创建新的Graphic，我们称这个实例为一个原型。GraphicTool将它应该克隆和添加到文档中的原型作为参数。如果所有Graphic子类都支持一个Clone操作，那么GraphicTool可以克隆所有种类的Graphic，如下图所示。

因此在我们的音乐编辑器中，用于创建个音乐对象的每一种工具都是一个用不同原型进行初始化的GraphicTool实例。通过克隆一个音乐对象的原型并将这个克隆添加到乐谱中，每个GraphicTool实例都会产生一个音乐对象。

我们甚至可以进一步使用Prototype模式来减少类的数目。我们使用不同的类来表示全音符和半音符，但可能不需要这么做。它们可以是使用不同位图和时延初始化的相同的类的实例。一个创建全音符的工具就是这样的GraphicTool，它的原型是一个被初始化成全音符的MusicalNote。这可以极大的减少系统中类的数目，同时也更易于在音乐编辑器中增加新的音符。

特点：

（1）、改变值以指定新对象

高度动态的系统允许你通过对象组合定义新的行为。例如，你可以通过实例化已有类并且将这些实例注册为客户对象的原型，就可以有效定义新类别的对象。客户可以将职责代理给原型，从而表现出新的行为。这种设计使得用户无需编程即可定义新“类”。Prototype模式可以极大的减少系统所需要的类的数目。

例如，在我们的音乐编辑器中，通过注册不同音乐对象原型，一个GraphicTool类可以创建无数种音乐对象。

代码：

 

unit uMusicEditor;

 

interface

 

uses

    Windows,Classes,Graphics,Types;

 

type

    TGraphic = class

    private

        FCanvas: TCanvas;

        FPosition: TPoint;

    protected

        function GetName: string; virtual; abstract;

        function GetRect: TRect; virtual; abstract;

    public

        constructor Create(ACanvas: TCanvas);

        //---

        function Clone: TGraphic; virtual; abstract;

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

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

        //---

        property Canvas: TCanvas read FCanvas;

        property Name: string read GetName;

        property Position: TPoint read FPosition;

        property Rect: TRect read GetRect;

    end;

    {五线谱}

    TStaff = class(TGraphic)

    protected

        function GetName: string; override;

        function GetRect: TRect; override;

    public

        function Clone: TGraphic; override;

        procedure Draw(const APosition: TPoint); override;

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

    end;

    {音符}

    TMusicalNote = class(TGraphic)

    end;

    {全音符}

    TWholeNote = class(TMusicalNote)

    protected

        function GetName: string; override;

        function GetRect: TRect; override;

    public

        function Clone: TGraphic; override;

        procedure Draw(const APosition: TPoint); override;

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

    end;

    {半音符}

    THalfNote = class(TMusicalNote)

    protected

        function GetName: string; override;

        function GetRect: TRect; override;

    public

        function Clone: TGraphic; override;

        procedure Draw(const APosition: TPoint); override;

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

    end;

 

    TDrawing = class

    private

        FGraphics: TList;

        FPosition: TPoint;

        FSelectIndex: Integer;

        procedure Clear;

        function GetCount: Integer;

        function GetItems(Index: Integer): TGraphic;

        function GetSelection: TGraphic;

    public

        constructor Create;

        destructor Destroy; override;

        //---

        procedure Insert(AGraphic: TGraphic);

        property Count: Integer read GetCount;

        //---

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

        property SelectIndex: Integer read FSelectIndex write FSelectIndex;

        property Selection: TGraphic read GetSelection;

        property Position: TPoint read FPosition write FPosition;

    end;

 

    {工具}

    TTool = class

    private

        FDrawing: TDrawing;

    protected

        function GetName: string; virtual; abstract;

    public

        constructor Create(ADrawing: TDrawing);

        //---

        procedure Manipulator; virtual; abstract;

        //---

        property Name: string read GetName;

    end;

    {选择工具}

    TSelectTool = class(TTool)

    protected

        function GetName: string; override;

    public

        procedure Manipulator; override;

    end;

    {旋转工具}

    TRotateTool = class(TTool)

    protected

        function GetName: string; override;

    public

        procedure Manipulator; override;

    end;

    {图形工具}

    TGraphicTool = class(TTool)

    private

        FPrototype: TGraphic;

    protected

        function GetName: string; override;

    public

        constructor Create(ADrawing: TDrawing; APrototype: TGraphic);

        destructor Destroy; override;

        //---

        procedure Manipulator; override;

    end;

 

    TTools = class

    private

        FSelectIndex: Integer;

        FTools: TList;

        procedure Clear;

        function GetCount: Integer;

        function GetItems(Index: Integer): TTool;

        function GetSelection: TTool;

    public

        constructor Create;

        destructor Destroy; override;

        //---

        procedure Add(ATool: TTool);

        //---

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

        property Count: Integer read GetCount;

        property SelectIndex: Integer read FSelectIndex write FSelectIndex;

        property Selection: TTool read GetSelection;

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

begin

    FCanvas := ACanvas;

end;

 

function TStaff.Clone: TGraphic;

begin

    Result := TStaff.Create(FCanvas);

end;

 

procedure TStaff.Draw(const APosition: TPoint);

var

    i,Y,ARowHeight: integer;

    ARect: TRect;

begin

    FPosition := APosition;

    //---

    with FCanvas do

    begin

        with Pen do

        begin

            Color := clYellow;

            Style := psSolid;

            Width := 1;

            Mode := pmXor;

        end;

        //---

        ARect := self.Rect;

        ARowHeight := (ARect.Bottom - ARect.Top) div 4;

        //---

        Y := ARect.Top;

        //---

        MoveTo(ARect.Left,Y);

        LineTo(ARect.Right,Y);

        //---

        for i := 1 to 4 do

        begin

            Y := Y + ARowHeight;

            //---

            MoveTo(ARect.Left,Y);

            LineTo(ARect.Right,Y);

        end;

    end;

end;

 

function TStaff.GetName: string;

begin

    Result := '五线谱';

end;

 

function TStaff.GetRect: TRect;

const

    CNT_Width = 120;

    CNT_Height = 15;

begin

    Result.Left := FPosition.X - CNT_Width;

    Result.Right := FPosition.X + CNT_Width;

    Result.Top := FPosition.Y - CNT_Height * 2;

    Result.Bottom := FPosition.Y + CNT_Height * 2;

end;

 

function TStaff.PtInGraphic(const APosition: TPoint): boolean;

var

    ALineRect: TRect;

begin

    ALineRect := self.Rect;

    ALineRect.Top := FPosition.Y - 5;

    ALineRect.Bottom := FPosition.Y + 5;

    //---

    Result := Windows.PtInRect(ALineRect,APosition);

end;

 

function TWholeNote.Clone: TGraphic;

begin

    Result := TWholeNote.Create(FCanvas);

end;

 

function TWholeNote.GetRect: TRect;

const

    CNT_Radius = 10;

begin

    with FPosition do

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

end;

 

procedure TWholeNote.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;

        //---

        Ellipse(self.Rect);

    end;

end;

 

function TWholeNote.GetName: string;

begin

    Result := '全音符';

end;

 

function TWholeNote.PtInGraphic(const APosition: TPoint): boolean;

var

    Rgn: HRGN;

begin

    Rgn := CreateEllipticRgnIndirect(self.Rect);

    try

        Result := Windows.PtInRegion(Rgn,APosition.X,APosition.Y);

    finally

        DeleteObject(Rgn);

    end;

end;

 

function THalfNote.Clone: TGraphic;

begin

    Result := THalfNote.Create(FCanvas);

end;

 

function THalfNote.GetRect: TRect;

const

    CNT_Radius = 10;

begin

    with FPosition do

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

end;

 

procedure THalfNote.Draw(const APosition: TPoint);

var

    pts: array[0..2] of 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.Rect do

        begin

            pts[0].X := Left;

            pts[0].Y := Bottom;

            pts[1].X := Right;

            pts[1].Y := Bottom;

            pts[2].X := (Left + Right) div 2;

            pts[2].Y := Top;

        end;

        //---

        Polygon(pts);

    end;

end;

 

function THalfNote.GetName: string;

begin

    Result := '半音符';

end;

 

function THalfNote.PtInGraphic(const APosition: TPoint): boolean;

var

    Rgn: HRGN;

    pts: array[0..2] of TPoint;

begin

    with self.Rect do

    begin

        pts[0].X := Left;

        pts[0].Y := Bottom;

        pts[1].X := Right;

        pts[1].Y := Bottom;

        pts[2].X := (Left + Right) div 2;

        pts[2].Y := Top;

    end;

    //---

    Rgn := CreatePolygonRgn(pts,Length(pts),WINDING);

    try

        Result := Windows.PtInRegion(Rgn,APosition.X,APosition.Y);

    finally

        DeleteObject(Rgn);

    end;

end;

 

constructor TTool.Create(ADrawing: TDrawing);

begin

    FDrawing := ADrawing;

end;

 

constructor TGraphicTool.Create(ADrawing: TDrawing; APrototype: TGraphic);

begin

    inherited Create(ADrawing);

    //---

    FPrototype := APrototype;

end;

 

destructor TGraphicTool.Destroy;

begin

    FPrototype.Free;

    //---

    inherited;

end;

 

function TGraphicTool.GetName: string;

begin

    Result := FPrototype.Name;

end;

 

procedure TGraphicTool.Manipulator;

var

    p: TGraphic;

begin

    p := FPrototype.Clone;

    //---

    p.Draw(FDrawing.Position);

    //---

    FDrawing.Insert(p);

end;

 

procedure TDrawing.Clear;

var

    i: Integer;

begin

    with FGraphics do

    begin

        for i := 0 to Count - 1 do

            TObject(Items[i]).Free;

        //---

        Clear;

    end;

end;

 

constructor TDrawing.Create;

begin

    FGraphics := TList.Create;

    FSelectIndex := -1;

end;

 

destructor TDrawing.Destroy;

begin

    self.Clear;

    FGraphics.Free;

    //---

    inherited;

end;

 

function TDrawing.GetCount: Integer;

begin

    Result := FGraphics.Count;

end;

 

function TDrawing.GetItems(Index: Integer): TGraphic;

begin

    Result := FGraphics[Index];

end;

 

function TDrawing.GetSelection: TGraphic;

begin

    if FSelectIndex >= 0 then

        Result := FGraphics[FSelectIndex]

    else

        Result := nil;

end;

 

procedure TDrawing.Insert(AGraphic: TGraphic);

begin

    FGraphics.Add(AGraphic);

end;

 

constructor TTools.Create;

begin

    FTools := TList.Create;

end;

 

destructor TTools.Destroy;

begin

    self.Clear;

    FTools.Free;

    //---

    inherited;

end;

 

procedure TTools.Clear;

var

    i: Integer;

begin

    with FTools do

    begin

        for i := 0 to Count - 1 do

            TObject(Items[i]).Free;

        //---

        Clear;

    end;

end;

 

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

begin

    Result := FTools[Index];

end;

 

procedure TTools.Add(ATool: TTool);

begin

    FTools.Add(ATool);

end;

 

function TTools.GetCount: Integer;

begin

    Result := FTools.Count;

end;

 

function TTools.GetSelection: TTool;

begin

    if FSelectIndex >= 0 then

        Result := FTools[FSelectIndex]

    else

        Result := nil;

end;

 

function TRotateTool.GetName: string;

begin

    Result := '旋转';

end;

 

procedure TRotateTool.Manipulator;

begin

 

end;

 

function TSelectTool.GetName: string;

begin

    Result := '选择';

end;

 

procedure TSelectTool.Manipulator;

    //---

    procedure _SelectGraphic;

    begin

        with FDrawing.Selection do

        begin

            with Canvas do

            begin

                Brush.Color := clWhite;

                DrawFocusRect(Rect);

            end;

        end;

    end;

    //---

    procedure _NoSelectGraphic;

    begin

        _SelectGraphic;

    end;

var

    i: integer;

begin

    with FDrawing do

    begin

        if SelectIndex >= 0 then

        begin

            _NoSelectGraphic;

            SelectIndex := -1;

        end;

        //---

        for i := 0 to Count - 1 do

        begin

            if Items[i].PtInGraphic(Position) then

            begin

                SelectIndex := i;

                _SelectGraphic;

                //---

                break;

            end;

        end;

    end;

end;

 

end.

 

unit Unit1;

 

interface

 

uses

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

    StdCtrls,ExtCtrls,uMusicEditor, ToolWin, ComCtrls;

 

type

    TForm1 = class(TForm)

        ToolBar1: TToolBar;

        Image1: TImage;

        procedure FormDestroy(Sender: TObject);

        procedure FormCreate(Sender: TObject);

        procedure FormResize(Sender: TObject);

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

            TShiftState; X, Y: Integer);

        procedure ToolButton1Click(Sender: TObject);

    private

        FTools: TTools;

        FDrawing: TDrawing;

    public

    { Public declarations }

    end;

 

var

    Form1: TForm1;

 

implementation

 

{$R *.DFM}

 

procedure TForm1.FormCreate(Sender: TObject);

    //---

    procedure _InitTools;

    begin

        FTools := TTools.Create;

        with FTools do

        begin

            Add(TSelectTool.Create(FDrawing));

            Add(TRotateTool.Create(FDrawing));

            Add(TGraphicTool.Create(FDrawing,TStaff.Create(Image1.Canvas)));

            Add(TGraphicTool.Create(FDrawing,THalfNote.Create(Image1.Canvas)));

            Add(TGraphicTool.Create(FDrawing,TWholeNote.Create(Image1.Canvas)));

        end;

    end;

    //---

    procedure _ShowTools;

    var

        i: integer;

        AButton: TToolButton;

    begin

        with FTools do

        begin

            for i := 0 to Count - 1 do

            begin

                AButton := TToolButton.Create(ToolBar1);

                with AButton do

                begin

                    Caption := Items[i].Name;

                    Tag := i;

                    Style := tbsCheck;

                    Grouped := true;

                    OnClick := self.ToolButton1Click;

                    Parent := ToolBar1;

                end;

            end;

        end;

    end;

begin

    ToolBar1.Align := alLeft;

    with ToolBar1 do

    begin

        ShowCaptions := true;

        AutoSize := true;

    end;

    //---

    FDrawing := TDrawing.Create;

    //---

    _InitTools;

    _ShowTools;

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.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift:

    TShiftState; X, Y: Integer);

begin

    FDrawing.Position := Point(X, Y);

    FTools.Selection.Manipulator;

end;

 

procedure TForm1.ToolButton1Click(Sender: TObject);

begin

    FTools.SelectIndex := (Sender as TToolButton).Tag;

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

    OnMouseUp = Image1MouseUp

  end

  object ToolBar1: TToolBar

    Left = 0

    Top = 0

    Width = 121

    Height = 262

    Align = alLeft

    ButtonHeight = 7

    ButtonWidth = 8

    Caption = 'ToolBar1'

    ShowCaptions = True

    TabOrder = 0

  end

end