《GOF设计模式》—装饰（DECORATOR）—Delphi源码示例：图形用户界面组件

示例：图形用户界面组件

说明：

有时我们希望给某个对象而不是整个类添加一些功能。例如，一个图形用户界面工具箱允许你对任意一个用户界面组件添加一些特性，例如边框，或是一些行为，例如窗口滚动。

代码：

unit uView;

 

interface

 

uses

    Classes,Graphics,Controls,Forms,StdCtrls;

 

type

    TVisualComponent = class

    protected

        function GetCanvas: TCanvas; virtual; abstract;

    public

        procedure Draw(); virtual; abstract;

        //---

        property Canvas: TCanvas read GetCanvas;

    end;

    TDecorator = class(TVisualComponent)

    private

        FComponent: TVisualComponent;

    protected

        function GetCanvas: TCanvas; override;

    public

        constructor Create(AComponent: TVisualComponent);

        destructor Destroy; override;

        //---

        procedure Draw(); override;

    end;

 

    TBorderDecortor = class(TDecorator)

    private

        FBorderWidth: Integer;

        procedure DrawBorder;

    public

        constructor Create(AComponent: TVisualComponent; const ABorderWidth: Integer =

            1);

        //---

        procedure Draw(); override;

    end;

 

    TScrollDecortor = class(TDecorator)

    private

        FScrollBar: TScrollBar;

        FScrollPosition: integer;

        FOnScroll: TNotifyEvent;

        procedure DoScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos:

            Integer);

        function GetScrollMax: Integer;

        function GetScrollMin: Integer;

        procedure SetScrollMax(const Value: Integer);

        procedure SetScrollMin(const Value: Integer);

    public

        constructor Create(AComponent: TVisualComponent; AParent: TWinControl);

        destructor Destroy; override;

        //---

        procedure Draw(); override;

        //---

        property OnScroll: TNotifyEvent read FOnScroll write FOnScroll;

        property ScrollPosition: integer read FScrollPosition;

        property ScrollMax: Integer read GetScrollMax write SetScrollMax;

        property ScrollMin: Integer read GetScrollMin write SetScrollMin;

    end;

 

    TTextView = class(TVisualComponent)

    private

        FCanvas: TCanvas;

        FLines: TStrings;

        FStartRow: integer;

    protected

        function GetCanvas: TCanvas; override;

    public

        constructor Create(ACanvas: TCanvas);

        destructor Destroy; override;

        //---

        procedure Draw; override;

        //---

        property Lines: TStrings read FLines;

        property StartRow: integer read FStartRow write FStartRow;

    end;

 

implementation

 

constructor TDecorator.Create(aComponent: TVisualComponent);

begin

    inherited Create;

    //---

    FComponent := AComponent;

end;

 

destructor TDecorator.Destroy;

begin

    if Assigned(FComponent) then

        FComponent.Free;

    //---

    inherited;

end;

 

procedure TDecorator.Draw();

begin

    if Assigned(FComponent) then

        FComponent.Draw;

end;

 

function TDecorator.GetCanvas: TCanvas;

begin

    Result := FComponent.Canvas;

end;

 

procedure TBorderDecortor.DrawBorder;

begin

    with Canvas do

    begin

        with Pen do

        begin

            Width := FBorderWidth;

            Color := clRed;

        end;

        Brush.Style := bsClear;

        //---

        Rectangle(ClipRect);

    end;

end;

 

constructor TBorderDecortor.Create(AComponent: TVisualComponent; const

    ABorderWidth: Integer = 1);

begin

    inherited Create(AComponent);

    //---

    FBorderWidth := ABorderWidth;

end;

 

procedure TBorderDecortor.Draw();

begin

    inherited;

    //---

    DrawBorder;

end;

 

constructor TScrollDecortor.Create(AComponent: TVisualComponent;

    AParent: TWinControl);

begin

    inherited Create(AComponent);

    //--

    FScrollBar := TScrollBar.Create(nil);

    with FScrollBar do

    begin

        Parent := AParent;

        Kind := sbVertical;

        OnScroll := self.DoScroll;

    end;

end;

 

destructor TScrollDecortor.Destroy;

begin

    FScrollBar.Free;

    //---

    inherited;

end;

 

procedure TScrollDecortor.Draw();

begin

    with self.Canvas.ClipRect do

    begin

        FScrollBar.Top := Top;

        FScrollBar.Left := Right - FScrollBar.Width;

        FScrollBar.Height := Bottom - Top;

    end;

    //---

    inherited;

end;

 

constructor TTextView.Create(ACanvas: TCanvas);

begin

    inherited Create;

    //---

    FCanvas := ACanvas;

    FLines := TStringList.Create;

end;

 

destructor TTextView.Destroy;

begin

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

    const

        CNT_PageRowCount = 3;

    var

        x,y: Integer;

        ARow,AEndRow: integer;

    begin

        AEndRow := FStartRow + CNT_PageRowCount;

        if AEndRow >= FLines.Count then

        begin

            AEndRow := FLines.Count - 1;

            //---

            FStartRow := AEndRow - CNT_PageRowCount;

            if FStartRow < 0 then

                FStartRow := 0;

        end;

        //---

        with FCanvas do

        begin

            Font.Color := clRed;

            //---

            x := 2;

            y := 2;

            //---

            for ARow := FStartRow to AEndRow do

            begin

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

                //---

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

            end;

        end;

    end;

begin

    _ClearBack;

    _DrawText;

end;

 

function TTextView.GetCanvas: TCanvas;

begin

    Result := FCanvas;

end;

 

procedure TScrollDecortor.DoScroll(Sender: TObject; ScrollCode: TScrollCode;

    var ScrollPos: Integer);

begin

    FScrollPosition := ScrollPos;

    if Assigned(FOnScroll) then

        FOnScroll(self);

end;

 

function TScrollDecortor.GetScrollMax: Integer;

begin

    Result := FScrollBar.Max;

end;

 

function TScrollDecortor.GetScrollMin: Integer;

begin

    Result := FScrollBar.Min;

end;

 

procedure TScrollDecortor.SetScrollMax(const Value: Integer);

begin

    FScrollBar.Max := Value;

end;

 

procedure TScrollDecortor.SetScrollMin(const Value: Integer);

begin

    FScrollBar.Min := Value;

end;

 

end.

 

unit uForm1;

 

interface

 

uses

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

    ExtCtrls,uView;

 

type

    TForm1 = class(TForm)

        Image1: TImage;

        procedure FormCreate(Sender: TObject);

    private

        FView: TTextView;

        FScroll: TScrollDecortor;

        FBorder: TBorderDecortor;

        procedure DoScroll(Sender: TObject);

    public

    end;

 

var

    Form1: TForm1;

 

implementation

 

{$R *.DFM}

 

procedure TForm1.FormCreate(Sender: TObject);

var

    i,j: integer;

    AText: string;

begin

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

    for i := 1 to 9 do

    begin

        AText := '';

        for j := 1 to 20 do

            AText := AText + IntToStr(i);

        FView.Lines.Add(AText);

    end;

    //---

    FScroll := TScrollDecortor.Create(FView,self);

    with FScroll do

    begin

        ScrollMin := 0;

        ScrollMax := FView.Lines.Count - 1;

        OnScroll := self.DoScroll;

    end;

    //---

    FBorder := TBorderDecortor.Create(FScroll,2);

    FBorder.Draw;

end;

 

procedure TForm1.DoScroll(Sender: TObject);

begin

    FView.StartRow := FScroll.ScrollPosition;

    FBorder.Draw;

end;

 

end.