《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;