《GOF设计模式》—备忘录（MEMENTO）—Delphi源码示例：图形编辑器

示例：图形编辑器
说明：
考虑一个图形编辑器，它支持图形对象间的连线。用户可用一条直线连接两个矩形,而当用户移动任意一个矩形时,这两个矩形仍能保持连接。在移动过程中，编辑器自动伸展这条直线以保持该连接。
我们可用备忘录(Memento)模式实现移动操作取消。

界面：
 
object Form1: TForm1
  Left = 192
  Top = 113
  Width = 400
  Height = 270
  Caption = 'Form1'
  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
  OnMouseDown = FormMouseDown
  OnMouseUp = FormMouseUp
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 40
    Top = 184
    Width = 75
    Height = 25
    Caption = '创建图形'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 144
    Top = 184
    Width = 75
    Height = 25
    Caption = '取消移动'
    TabOrder = 1
    OnClick = Button2Click
  end
end


代码：
 
unit uGraphic;

interface

uses
    Windows,SysUtils,Classes,Graphics,Contnrs;

type
    TGraphic = class;

    {约束信息}
    TConstraintInfo = record
        StartConnection,EndConnection: TGraphic;
        StartPosition,EndPosition: TPoint;
    end;
    PConstraintInfo = ^TConstraintInfo;

    TConstraints = class(TList)
    private
        function GetItems(Index: integer): PConstraintInfo;
    protected
        procedure Notify(Ptr: Pointer; Action: TListNotification); override;
    public
        procedure Add(const AStartConnection,AEndConnection: TGraphic); overload;
        function IndexOf(const AStartConnection,AEndConnection: TGraphic): Integer; overload;
        procedure Assign(const AConstraints: TConstraints);
        //---
        property Items[Index: integer]: PConstraintInfo read GetItems;
    end;

    TGraphic = class
    private
        FCanvas: TCanvas;
        FPosition: TPoint;
        procedure Clear;
    public
        constructor Create(ACanvas: TCanvas; APosition: TPoint);
        //---
        function GetRect: TRect;
        procedure Draw;
        procedure Move(p: TPoint);
        //---
        property Position: TPoint read FPosition;
    end;
    TGraphics = class(TObjectList)
    private
        function GetItems(Index: Integer): TGraphic;
    public
        function GetGraphic(const APosition: TPoint): TGraphic;
        //---
        property Items[Index: Integer]: TGraphic read GetItems;
    end;

    TMemento = class
    end;
    TConstraintSolverMemento = class(TMemento)
    private
        FConstraints: TConstraints;
    public
        constructor Create(AConstraints: TConstraints);
        destructor Destroy; override;
    end;

    {约束解释器，采用单件模式}
    TConstraintSolver = class
    private
        FCanvas: TCanvas;
        FConstraints: TConstraints;
        FIsDraw: boolean;
        procedure DrawLine(pInfo: PConstraintInfo);
        procedure ClearLines;
    public
        constructor Create;
        destructor Destroy; override;
        //---
        class function Instance: TConstraintSolver;
        //---
        procedure Solve();
        //---
        procedure AddConstraint(const AStartConnection,AEndConnection: TGraphic);
        procedure RemoveConctraint(const AStartConnection,AEndConnection: TGraphic);
        //---
        function CreateMemento(): TMemento;
        procedure SetMemento(m: TMemento);
        //---
        property Canvas: TCanvas write FCanvas;
    end;

    {命令，采用命令模式}
    TCommand = class
    public
        procedure Execute(); virtual; abstract;
        procedure Unexecute(); virtual; abstract;
    end;
    TMoveCommand = class(TCommand)
    private
        FTarget: TGraphic;
        FDelta: TPoint;
        FState: TMemento;
    public
        constructor Create(ATarget: TGraphic; ADelta: TPoint);
        destructor Destroy; override;
        //---
        procedure Execute(); override;
        procedure Unexecute(); override;
    end;
    TSelectCommand = class(TCommand)
    private
        FGraphics: TGraphics;
        FCurGraphic: TGraphic;
        FPosition: TPoint;
    public
        constructor Create(AGraphics: TGraphics);
        //---
        procedure Execute; override;
        procedure Unexecute; override;
        //---
        property Position: TPoint write FPosition;
        property CurGraphic: TGraphic read FCurGraphic write FCurGraphic;
    end;

    TGraphicManipulator = class
    private
        FSelectCommand: TSelectCommand;
        FMoveCommand: TMoveCommand;
        procedure ClearMoveCommand;
    public
        constructor Create(AGraphics: TGraphics);
        destructor Destroy; override;
        //---
        procedure MouseDown(X,Y: Integer);
        procedure MouseMove(X,Y: Integer);
        procedure MouseUp(X,Y: Integer);
        //---
        property MoveCommand: TMoveCommand read FMoveCommand;
    end;

implementation

var
    FConstraintSolver: TConstraintSolver;

procedure TGraphic.Draw;
begin
    with FCanvas do
    begin
        with Pen do
        begin
            Color := clYellow;
            Style := psSolid;
            Width := 1;
            Mode := pmXor;
        end;
        //---
        Rectangle(self.GetRect);
    end;
end;

procedure TGraphic.Clear;
begin
    Draw;
end;

constructor TGraphic.Create(ACanvas: TCanvas; APosition: TPoint);
begin
    FCanvas := ACanvas;
    FPosition := APosition;
end;

procedure TGraphic.Move(p: TPoint);
begin
    if (FPosition.X <> 0) or (FPosition.Y <> 0) then
        Clear;
    //---
    with FPosition do
    begin
        X := X + p.X;
        Y := Y + p.Y;
    end;
    //---
    Draw;
end;

constructor TMoveCommand.Create(ATarget: TGraphic; ADelta: TPoint);
begin
    inherited Create;
    //---
    FTarget := ATarget;
    FDelta := ADelta;
    FState := nil;
end;

destructor TMoveCommand.Destroy;
begin
    if FState <> nil then
        FState.Free;
    //---
    inherited;
end;

procedure TMoveCommand.Execute();
var
    ASolver: TConstraintSolver;
begin
    ASolver := TConstraintSolver.Instance;
    //---
    if FState <> nil then
        FState.Free;
    FState := ASolver.CreateMemento();
    //---
    FTarget.Move(FDelta);
    //---
    ASolver.Solve;
end;

procedure TMoveCommand.Unexecute();
var
    ASolver: TConstraintSolver;
begin
    ASolver := TConstraintSolver.Instance;
    //---
    FDelta.x := -FDelta.x;
    FDelta.y := -FDelta.y;
    FTarget.Move(FDelta);
    //---
    ASolver.SetMemento(FState);
    ASolver.Solve;
end;

constructor TConstraintSolverMemento.Create(AConstraints: TConstraints);
begin
    inherited Create;
    //---
    FConstraints := TConstraints.Create;
    FConstraints.Assign(AConstraints);
end;

destructor TConstraintSolverMemento.Destroy;
begin
    FConstraints.Free;
    //---
    inherited;
end;

constructor TConstraintSolver.Create;
begin
    if FConstraintSolver = nil then
    begin
        FConstraintSolver := Self;
        FConstraints := TConstraints.Create;
    end
    else
        abort;
end;

destructor TConstraintSolver.Destroy;
begin
    FConstraintSolver := nil;
    FConstraints.Free;
    //---
    inherited;
end;

procedure TConstraintSolver.Solve();
    //---
    procedure _RefreshPositions;
    var
        i: Integer;
    begin
        with FConstraints do
        begin
            for i := 0 to Count - 1 do
            begin
                with Items[i]^ do
                begin
                    StartPosition := StartConnection.Position;
                    EndPosition := EndConnection.Position;
                end;
            end;
        end;
    end;
    //---
    procedure _DrawLines;
    var
        i: Integer;
    begin
        with FConstraints do
        begin
            for i := 0 to Count - 1 do
                DrawLine(Items[i]);
        end;
        //---
        FIsDraw := True;
    end;
begin
    ClearLines;
    _RefreshPositions;
    _DrawLines;
end;

procedure TConstraintSolver.AddConstraint(const AStartConnection,
    AEndConnection: TGraphic);
begin
    FConstraints.Add(AStartConnection,AEndConnection);
end;

procedure TConstraintSolver.ClearLines;
    //---
    procedure _ClearLine(pInfo: PConstraintInfo);
    begin
        DrawLine(pInfo);
    end;
var
    i: Integer;
begin
    if FIsDraw then
    begin
        with FConstraints do
        begin
            for i := 0 to Count - 1 do
                _ClearLine(Items[i]);
        end;
        //---
        FIsDraw := false;
    end;
end;

procedure TConstraintSolver.RemoveConctraint(const AStartConnection,
    AEndConnection: TGraphic);
var
    AIndex: Integer;
begin
    AIndex := FConstraints.IndexOf(AStartConnection,AEndConnection);
    if AIndex >= 0 then
        FConstraints.Delete(AIndex);
end;

function TConstraintSolver.CreateMemento(): TMemento;
begin
    Result := TConstraintSolverMemento.Create(FConstraints);
end;

procedure TConstraintSolver.DrawLine(pInfo: PConstraintInfo);
begin
    with FCanvas do
    begin
        with Pen do
        begin
            Color := clYellow;
            Style := psSolid;
            Width := 1;
            Mode := pmXor;
        end;
        //---
        with pInfo^ do
        begin
            MoveTo(StartPosition.X,StartPosition.Y);
            LineTo(EndPosition.X,EndPosition.Y);
        end;
    end;
end;

procedure TConstraintSolver.SetMemento(m: TMemento);
begin
    if m is TConstraintSolverMemento then
    begin
        ClearLines;
        self.FConstraints.Assign(TConstraintSolverMemento(m).FConstraints);
    end;
end;

class function TConstraintSolver.Instance: TConstraintSolver;
begin
    if FConstraintSolver = nil then
        FConstraintSolver := TConstraintSolver.Create;
    //---
    Result := FConstraintSolver;
end;

function TConstraints.GetItems(Index: integer): PConstraintInfo;
begin
    Result := Get(Index);
end;

function TConstraints.IndexOf(const AStartConnection,AEndConnection: TGraphic):
    Integer;
var
    i: Integer;
begin
    for i := 0 to Count - 1 do
    begin
        with Items[i]^ do
        begin
            if (StartConnection = AStartConnection) and (EndConnection = AEndConnection) then
            begin
                Result := i;
                Exit;
            end;
        end;
    end;
    //---
    Result := -1;
end;

procedure TConstraints.Assign(const AConstraints: TConstraints);
var
    i: Integer;
    pInfo: PConstraintInfo;
begin
    Self.Clear;
    //---
    with AConstraints do
    begin
        for i := 0 to Count - 1 do
        begin
            New(pInfo);
            pInfo^ := Items[i]^;
            self.Add(pInfo);
        end;
    end;
end;

procedure TConstraints.Notify(Ptr: Pointer; Action: TListNotification);
begin
    if Action = lnDeleted then
        Dispose(Ptr);
end;

function TGraphic.GetRect: TRect;
begin
    with FPosition do
        Result := Rect(X - 10,Y - 10,X + 10,Y + 10);
end;

function TGraphics.GetGraphic(const APosition: TPoint): TGraphic;
var
    i: integer;
begin
    for i := 0 to self.Count - 1 do
    begin
        if PtInRect(self.Items[i].GetRect,APosition) then
        begin
            Result := self.Items[i];
            Exit;
        end;
    end;
    //---
    Result := nil;
end;

function TGraphics.GetItems(Index: Integer): TGraphic;
begin
    Result := TGraphic(inherited Items[Index]);
end;

procedure TConstraints.Add(const AStartConnection,
    AEndConnection: TGraphic);
var
    pInfo: PConstraintInfo;
begin
    New(pInfo);
    with pInfo^ do
    begin
        StartConnection := AStartConnection;
        EndConnection := AEndConnection;
        StartPosition := Point(0,0);
        EndPosition := Point(0,0);
    end;
    //---
    self.Add(pInfo);
end;

constructor TSelectCommand.Create(AGraphics: TGraphics);
begin
    inherited Create;
    //---
    FGraphics := AGraphics;
end;

procedure TSelectCommand.Execute;
begin
    FCurGraphic := FGraphics.GetGraphic(FPosition)
end;

procedure TSelectCommand.Unexecute;
begin
end;

{ TGraphicManipulator }

procedure TGraphicManipulator.ClearMoveCommand;
begin
    if FMoveCommand <> nil then
        FMoveCommand.Free;
    FMoveCommand := nil;
end;

constructor TGraphicManipulator.Create(AGraphics: TGraphics);
begin
    FSelectCommand := TSelectCommand.Create(AGraphics);
    FMoveCommand := nil;
end;

destructor TGraphicManipulator.Destroy;
begin
    FSelectCommand.Free;
    ClearMoveCommand;
    //---
    inherited;
end;

procedure TGraphicManipulator.MouseDown(X,Y: Integer);
begin
    with FSelectCommand do
    begin
        Position := Point(X,Y);
        Execute;
    end;
end;

procedure TGraphicManipulator.MouseMove(X,Y: Integer);
begin

end;

procedure TGraphicManipulator.MouseUp(X,Y: Integer);
    //---
    procedure _HandleMoveCommand(ATarget: TGraphic);
    begin
        ClearMoveCommand;
        //---
        FMoveCommand := TMoveCommand.Create(ATarget,Point(X - ATarget.Position.X,Y - ATarget.Position.Y));
        FMoveCommand.Execute;
    end;
begin
    with FSelectCommand do
    begin
        if CurGraphic <> nil then
        begin
            with CurGraphic do
            begin
                if (Position.X <> X) or (Position.Y <> Y) then
                    _HandleMoveCommand(CurGraphic);
            end;
            //---
            CurGraphic := nil;
        end;
    end;
end;

initialization
    FConstraintSolver := nil;

finalization
    if FConstraintSolver <> nil then
        FConstraintSolver.Free;

end.

unit Unit1;

interface

uses
    Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,
    Dialogs,uGraphic,StdCtrls;

type
    TForm1 = class(TForm)
        Button1: TButton;
        Button2: TButton;
        procedure Button1Click(Sender: TObject);
        procedure Button2Click(Sender: TObject);
        procedure FormDestroy(Sender: TObject);
        procedure FormCreate(Sender: TObject);
        procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift:
            TShiftState; X,Y: Integer);
        procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift:
            TShiftState; X,Y: Integer);
    private
        FGraphics: TGraphics;
        FGraphicManipulator: TGraphicManipulator;
    public
    { Public declarations }
    end;

var
    Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
    FGraphics := TGraphics.Create;
    FGraphicManipulator := TGraphicManipulator.Create(FGraphics);
    TConstraintSolver.Instance.Canvas := self.Canvas;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
    FGraphics.Free;
    FGraphicManipulator.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
    //---
    function _CreateGraphic(APosition: TPoint): TGraphic;
    begin
        Result := TGraphic.Create(self.Canvas,APosition);
        Result.Draw;
        FGraphics.Add(Result);
    end;
var
    AStartConnection,AEndConnection: TGraphic;
begin
    AStartConnection := _CreateGraphic(point(20,20));
    AEndConnection := _CreateGraphic(point(20,100));
    with TConstraintSolver.Instance do
    begin
        AddConstraint(AStartConnection,AEndConnection);
        Solve;
    end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
    with FGraphicManipulator do
    begin
        if MoveCommand <> nil then
            MoveCommand.Unexecute;
    end;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift:
    TShiftState; X,Y: Integer);
begin
    FGraphicManipulator.MouseDown(X,Y);
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift:
    TShiftState; X,Y: Integer);
begin
    FGraphicManipulator.MouseUp(X,Y);
end;

end.