示例：图形编辑器 说明： 考虑一个图形编辑器，它支持图形对象间的连线。用户可用一条直线连接两个矩形,而当用户移动任意一个矩形时,这两个矩形仍能保持连接。在移动过程中，编辑器自动伸展这条直线以保持该连接。 我们可用备忘录(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.
