flexhistory.int

FlexGraphics是一套创建矢量图形的VCL组件

/////////////////////////////////////////////////////////
//                                                     //
//    FlexGraphics library                             //
//    Copyright (c) 2002-2009, FlexGraphics software.  //
//                                                     //
//    History (undo/redo) base classes                 //
//                                                     //
/////////////////////////////////////////////////////////

unit FlexHistory;

{$I FlexDefs.inc}

interface

uses
  Classes;

const
  DefaultHistoryDepth = 100; // actions

type
  THistory = class;
  THistoryGroup = class;

  THistoryActionClass = class of THistoryAction;

  THistoryState = ( hsIdle, hsRecord, hsUndo, hsRedo );

  THistoryAction = class
  private
   FOwner: THistory;
   FParent: THistoryGroup;
   FCaption: string;
   FTag: integer;
  protected
   FState: THistoryState;
   FDestroyAfterEnd: boolean;
   procedure ChangeState(NewState: THistoryState); virtual;
   function  BeginState(NewState: THistoryState): boolean; virtual;
   function  EndState: boolean; virtual;
   class function DoIsRecordable(Source: TObject;
     Parent: THistoryGroup): boolean; virtual;
   function  DoIsSame(ActionClass: THistoryActionClass;
     Source: TObject): boolean; virtual;
   procedure DoActionCaption(Source: TObject; var ACaption: string); virtual;
   procedure DoBeginAction(Source: TObject); virtual;
   procedure DoEndAction; virtual;
   procedure DoRecordAction(Source: TObject); virtual; abstract;
   procedure DoUndo(Source: TObject); virtual; abstract;
   procedure DoRedo(Source: TObject); virtual; abstract;
  public
   constructor Create(AOwner: THistory; AParent: THistoryGroup); virtual;
   property  Owner: THistory read FOwner;
   property  Caption: string read FCaption write FCaption;
   property  State: THistoryState read FState;
   property  Parent: THistoryGroup read FParent;
   property  DestroyAfterEnd: boolean read FDestroyAfterEnd;
   property  Tag: integer read FTag write FTag;
  end;

  THistoryStreamAction = class(THistoryAction)
  protected
   FUndoStream: TStream;
   FRedoStream: TStream;
   function  ProcessSource(Stream: TStream; Source: TObject;
     DoLoad: boolean): boolean; virtual; abstract;
   procedure DoRecordAction(Source: TObject); override;
   procedure DoUndo(Source: TObject); override;
   procedure DoRedo(Source: TObject); override;
  public
   destructor Destroy; override;
   property  UndoStream: TStream read FUndoStream;
   property  RedoStream: TStream read FRedoStream;
  end;

  THistoryGroupClass = class of THistoryGroup;

  THistoryGroup = class(THistoryAction)
  private
   FActions: TList;
   FInProcessIndex: integer;
   FInProcessSource: TObject;
   function  GetAction(Index: integer): THistoryAction;
   function  GetActionCount: integer;
  protected
   FDestroyIfEmpty: boolean;
   procedure Clear;
   procedure DoEndAction; override;
   procedure DoUndo(Source: TObject); override;
   procedure DoRedo(Source: TObject); override;
   procedure DoRecordAction(Source: TObject); override;
   function  BeginAction(ActionClass: THistoryActionClass;
     const Source: TObject; ATag: integer = 0): THistoryAction;
   function  EndAction: boolean;
   function  EraseAction: boolean;
  public
   constructor Create(AOwner: THistory; AParent: THistoryGroup); override;
   destructor Destroy; override;
   property  ActionCount: integer read GetActionCount;
   property  Actions[Index: integer]: THistoryAction read GetAction; default;
   property  InProcessIndex: integer read FInProcessIndex;
   property  InProcessSource: TObject read FInProcessSource;
  end;

  THistoryGetActionSourceEvent = procedure(Sender: TObject;
    Action: THistoryAction; var Source: TObject;
    var Enabled: boolean) of object;

  THistorySetActionSourceEvent = procedure(Sender: TObject;
    Action: THistoryAction; const Source: TObject) of object;

  THistoryGetActionCaptionEvent = procedure(Sender: TObject;
    Action: THistoryAction; const Source: TObject;
    var Caption: string) of object;

  THistoryIsRecordableEvent = procedure(Sender: TObject;
    var ActionClass: THistoryActionClass; var Source: TObject;
    Parent: THistoryGroup; var IsRecordable: boolean) of object;

  THistoryIsSameEvent = procedure(Sender: TObject;
    ExistedAction: THistoryAction; NewActionClass: THistoryActionClass;
    const NewSource: TObject; var IsSame: boolean) of object;

  THistory = class
  private
   FOwner: TObject;
   FActive: boolean;
   FActions: TList;
   FActionIndex: integer;
   FDepth: integer;
   FOnChange: TNotifyEvent;
   FOnGetActionCaption: THistoryGetActionCaptionEvent;
   FOnGetActionSource: THistoryGetActionSourceEvent;
   FOnSetActionSource: THistorySetActionSourceEvent;
   FOnIsRecordable: THistoryIsRecordableEvent;
   FOnIsSame: THistoryIsSameEvent;
   function  GetInProcess: boolean;
   function  GetInProcessAction: THistoryAction;
   function  GetInProcessSource: TObject;
   function  GetIsRecordable: boolean;
   function  GetCaption(Index: integer): string;
   function  GetAction(Index: integer): THistoryAction;
   function  GetActionCount: integer;
   procedure SetDepth(const Value: integer);
   procedure SetActive(const Value: boolean);
  protected
   FGroup: THistoryGroup;
   FGroupLevel: integer;
   FDisableLevel: integer;
   FState: THistoryState;
   FInProcessSource: TObject;   
   procedure ChangeState(NewState: THistoryState); virtual;
   procedure DeleteActions(FromIndex: integer = 0; ToIndex: integer = -1);
   function  Scroll: integer;
   procedure DoChange; virtual;
   function  DoGetActionSource(Action: THistoryAction;
     var Enabled: boolean): TObject; virtual;
   procedure DoSetActionSource(Action: THistoryAction;
     const Source: TObject); virtual;
   function  DoGetActionCaption(Action: THistoryAction;
     const Source: TObject): string; virtual;
   function  DoIsRecordable(var ActionClass: THistoryActionClass;
     var Source: TObject; Parent: THistoryGroup): boolean; virtual;
   function  DoIsSame(ExistedAction: THistoryAction;
     NewActionClass: THistoryActionClass; NewSource: TObject): boolean; virtual;
  public
   constructor Create(AOwner: TObject);
   destructor Destroy; override;
   class procedure RegisterAction(Action: THistoryActionClass);
   procedure Clear;
   function  IndexOf(Action: THistoryAction): integer;
   function  BeginAction(ActionClass: THistoryActionClass;
     Source: TObject; ATag: integer = 0;
     DoRecord: boolean = true): THistoryAction;
   function  EndAction: boolean;
   function  CancelAction: boolean;
   function  RecordAction(ActionClass: THistoryActionClass;
     const Source: TObject; ATag: integer = 0): THistoryAction;
   function  EraseAction: boolean;
   function  OpenLastGroup: THistoryGroup;
   function  Undo: boolean; virtual;
   function  Redo: boolean; virtual;
   procedure DisableRecording; 
   function  EnableRecording: boolean;
   property  Active: boolean read FActive write SetActive default false;
   property  Owner: TObject read FOwner;
   property  State: THistoryState read FState;
   property  Depth: integer read FDepth write SetDepth
     default DefaultHistoryDepth;
   property  DisableLevel: integer read FDisableLevel;
   property  GroupLevel: integer read FGroupLevel;
   property  ActionCount: integer read GetActionCount;
   property  Actions[Index: integer]: THistoryAction read GetAction; default;
   property  ActionIndex: integer read FActionIndex;
   property  IsRecordable: boolean read GetIsRecordable;
   property  InProcess: boolean read GetInProcess;
   property  InProcessAction: THistoryAction read GetInProcessAction;
   property  InProcessSource: TObject read GetInProcessSource;
   property  Captions[Index: integer]: string read GetCaption;
   property  OnGetActionCaption: THistoryGetActionCaptionEvent
     read FOnGetActionCaption write FOnGetActionCaption;
   property  OnGetActionSource: THistoryGetActionSourceEvent
     read FOnGetActionSource write FOnGetActionSource;
   property  OnSetActionSource: THistorySetActionSourceEvent
     read FOnSetActionSource write FOnSetActionSource;
   property  OnIsRecordable: THistoryIsRecordableEvent read FOnIsRecordable
     write FOnIsRecordable;
   property  OnIsSame: THistoryIsSameEvent read FOnIsSame write FOnIsSame;
   property  OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

implementation