《GOF设计模式》—装饰（DECORATOR）—Delphi源码示例：改变对象内核

示例：视图组件

说明：

我们可以将Decorator看作一个对象的外壳，它可以改变这个对象的行为。另外一种方法是改变对象的内核，策略模式(Strategy)就是一个用于改变内核的很好的模式。

例如，我们可以将组件绘制边界的功能延迟到一个独立的Border对象中，这样就可以支持不同的边界风格。这个Border对象是一个Strategy对象，它封装了边界绘制策略。我们可以将策略的数目从一个扩充为任意多个，这样产生的效果与对装饰进行递归嵌套是一样的。

一个绘制边框的策略仅需要定义生成边框的接口（DrawBorder,GetWidth等），这意味着即使Component类很庞大时，策略也可以很小。

代码：

 

unit uView1;

 

interface

 

uses

    Classes,Graphics;

 

type

    TBorder = class

    protected

        function GetWidth: integer; virtual;

        procedure SetWidth(const Value: integer); virtual;

    public

        procedure DrawBorder(const ACanvas: TCanvas); virtual; abstract;

        //---

        property Width: integer read GetWidth write SetWidth;

    end;

    TBorderA = class(TBorder)

    public

        procedure DrawBorder(const ACanvas: TCanvas); override;

    end;

    TBorderB = class(TBorder)

    public

        procedure DrawBorder(const ACanvas: TCanvas); override;

    end;

 

    TVisualComponent = class

    protected

        function GetCanvas: TCanvas; virtual; abstract;

    public

        procedure Draw(); virtual; abstract;

        //---

        property Canvas: TCanvas read GetCanvas;

    end;

 

    TTextView = class(TVisualComponent)

    private

        FBorder: TBorder;

        FCanvas: TCanvas;

        FLines: TStrings;

        function GetBorderWidth: integer;

        procedure SetBorder(const Value: TBorder);

        procedure SetBorderWidth(const Value: integer);

    protected

        function GetCanvas: TCanvas; override;

    public

        constructor Create(ACanvas: TCanvas);

        destructor Destroy; override;

        //---

        procedure Draw; override;

        //---

        property Lines: TStrings read FLines;

        property Border: TBorder write SetBorder;

        property BorderWidth: integer read GetBorderWidth write SetBorderWidth;

    end;

 

implementation

 

procedure TBorderA.DrawBorder(const ACanvas: TCanvas);

    //---

    procedure _DrawBorder;

    begin

        with ACanvas do

        begin

            with Pen do

            begin

                Style := psSolid;

                Width := self.Width;

                Color := clRed;

            end;

            Brush.Style := bsClear;

            //---

            Rectangle(ClipRect);

        end;

    end;

begin

    _DrawBorder;

    //---

    inherited;

end;

 

constructor TTextView.Create(ACanvas: TCanvas);

begin

    inherited Create;

    //---

    FCanvas := ACanvas;

    FLines := TStringList.Create;

end;

 

destructor TTextView.Destroy;

begin

    if assigned(FBorder) then

        FBorder.Free;

    FLines.Free;

    //---

    inherited;

end;

 

procedure TTextView.Draw;

    //---

    procedure _ClearBack;

    begin

        with FCanvas do

        begin

            with Brush do

            begin

                Color := clBlack;

                Style := bsSolid;

            end;

            FillRect(ClipRect);

        end;

    end;

    //---

    procedure _DrawBorder;

    begin

        if assigned(FBorder) then

            FBorder.DrawBorder(FCanvas);

    end;

    //---

    procedure _DrawText;

    var

        ARow,x,y: Integer;

    begin

        with FCanvas do

        begin

            Font.Color := clRed;

            //---

            x := 2;

            y := 2;

            //---

            for ARow := 0 to FLines.Count - 1 do

            begin

                TextOut(x,y,FLines[ARow]);

                //---

                y := y + TextHeight(FLines[ARow]) + 20;

            end;

        end;

    end;

begin

    _ClearBack;

    _DrawBorder;

    _DrawText;

end;

 

function TTextView.GetBorderWidth: integer;

begin

    if assigned(FBorder) then

        Result := FBorder.Width

    else

        Result := 0

end;

 

function TTextView.GetCanvas: TCanvas;

begin

    Result := FCanvas;

end;

 

procedure TTextView.SetBorder(const Value: TBorder);

begin

    if assigned(FBorder) then

        FBorder.Free;

    FBorder := Value;

end;

 

procedure TTextView.SetBorderWidth(const Value: integer);

begin

    if assigned(FBorder) then

        FBorder.Width := Value;

end;

 

procedure TBorderB.DrawBorder(const ACanvas: TCanvas);

    //---

    procedure _DrawBorder;

    begin

        with ACanvas do

        begin

            with Pen do

            begin

                Style := psDot;

                Width := self.Width;

                Color := clRed;

            end;

            Brush.Style := bsClear;

            //---

            Rectangle(ClipRect);

        end;

    end;

begin

    _DrawBorder;

    //---

    inherited;

end;

 

function TBorder.GetWidth: integer;

begin

    Result := 1;

end;

 

procedure TBorder.SetWidth(const Value: integer);

begin

  // TODO -cMM: TBorder.SetWidth default body inserted

end;

 

end.

 

procedure TForm1.FormCreate(Sender: TObject);

var

    i,j: integer;

    AText: string;

    AView: TTextView;

    FScroll: TScrollDecortor;

    FBorder: TBorderDecortor;

begin

    AView := TTextView.Create(self.Image1.Canvas);

    try

        AView.Border := TBorderB.Create;

        //---

        for i := 1 to 3 do

            AView.Lines.Add('aaaaaaaaa');

        //---

        AView.Draw;

    finally

        AView.Free;

    end;

end;