resourceform.pas

學習資料網上下載

(*======================================================================*
 | ResourceForm                                                         |
 |                                                                      |
 | Contains TfmResource base class for all resource editor forms.       |
 |                                                                      |
 | 1.  Provides derived forms with 'ResourceDetails' property           |
 | 2.  Handles unlimited undo/redo functionallity                       |
 |                                                                      |
 | * Gold code.                                                         |
 |                                                                      |
 | Version  Date        By    Description                               |
 | -------  ----------  ----  ------------------------------------------|
 | 1.0      06/02/2001  CPWW  Original                                  |
 *======================================================================*)

unit ResourceForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ResourceObjectForm, unitResourceDetails;

type
  TImportExportType = (ixNone, ixFile, ixPicture);

//=======================================================================
// TfmResource class

  TfmResource = class(TfmResourceObject)
  private
    function GetResourceDetails: TResourceDetails;
    function GetCanRedo: boolean;
    function GetCanUndo: boolean;
    function GetRedoDescription: string;
    function GetUndoDescription: string;
  protected
    procedure SetObject(const Value: TObject); override;
    function GetImportExportType: TImportExportType; virtual;

    function GetCanCopy: Boolean; virtual;
    function GetCanCut: Boolean; virtual;
    function GetCanPaste: Boolean; virtual;
    function GetCanSelectAll : boolean; virtual;
    function GetCanDelete: Boolean; virtual;

  public
    procedure AddUndoEntry (const undoDetails : string);
    procedure Undo;
    procedure Redo;
    procedure Cut; virtual;
    procedure Copy; virtual;
    procedure Paste; virtual;
    procedure SelectAll; virtual;
    procedure EditDelete; virtual;

    property ResourceDetails : TResourceDetails read GetResourceDetails;

    property CanUndo : boolean read GetCanUndo;
    property CanRedo : boolean read GetCanRedo;
    property UndoDescription : string read GetUndoDescription;
    property RedoDescription : string read GetRedoDescription;
    property ImportExportType : TImportExportType read GetImportExportType;

    property CanCopy : Boolean read GetCanCopy;
    property CanCut : Boolean read GetCanCut;
    property CanPaste : Boolean read GetCanPaste;
    property CanSelectAll : Boolean read GetCanSelectAll;
    property CanDelete : Boolean read GetCanDelete;
  end;

var
  fmResource: TfmResource;

procedure ClearUndoDetails;

implementation

uses ConTnrs;

type
//=======================================================================
// TUndoEntry class

  TUndoEntry = class
    fDetails : string;
    fLanguage : Integer;
    fName : string;
    fData : TMemoryStream;

    constructor Create (const details : string; res : TResourceDetails);
    destructor Destroy; override;
  end;

//=======================================================================
// TUndoDetails class

  TUndoDetails = class
  private
    fUndoStack : TObjectStack;
    fRedoStack : TObjectStack;
    fResourceDetails : TResourceDetails;

    constructor Create (ResourceDetails : TResourceDetails);
    destructor Destroy; override;
    procedure AddUndoEntry (const details : string);
    procedure Undo;
    procedure Redo;
    procedure ClearRedoStack;
  end;


var
  gUndoDetails : TObjectList;

{$R *.DFM}

//=======================================================================
// Global methods

(*----------------------------------------------------------------------*
 | procedue ClearUndoDetails                                            |
 |                                                                      |
 | Clear all undo details.                                              |
 *----------------------------------------------------------------------*)
procedure ClearUndoDetails;
begin
  gUndoDetails.Clear;
end;

{ TfmResource }

//=======================================================================
// TfmResource methods

(*----------------------------------------------------------------------*
 | TfmResource.AddUndoEntry                                             |
 |                                                                      |
 *----------------------------------------------------------------------*)
procedure TfmResource.AddUndoEntry (const undoDetails: string);
var
  details : TUndoDetails;
begin
  if ResourceDetails.Tag = 0 then       // Any existing undo info?
  begin
                                         // No.  Create it
    details := TUndoDetails.Create (ResourceDetails);
    resourceDetails.Dirty := True;
    resourceDetails.Tag := Integer (details);
    gUndoDetails.Add (details)
  end
  else
    details := TUndoDetails (resourceDetails.Tag);

  details.ClearRedoStack;               // Clear the redo stack to prevent memory run-away

  details.AddUndoEntry (undoDetails);
end;

procedure TfmResource.Copy;
begin
// Stub
end;

procedure TfmResource.Cut;
begin
// Stub
end;

procedure TfmResource.EditDelete;
begin
// stub
end;

function TfmResource.GetCanCopy: Boolean;
begin
  Result := False
end;

function TfmResource.GetCanCut: Boolean;
begin
  Result := False
end;

function TfmResource.GetCanDelete: Boolean;
begin
  Result := False
end;

function TfmResource.GetCanPaste: Boolean;
begin
  Result := False
end;

(*----------------------------------------------------------------------*
 | TfmResource.GetCanRedo                                               |
 |                                                                      |
 | 'Get' handler for CanRedo property.  Returns true if the resource    |
 | details has items in it's redo list                                  |
 *----------------------------------------------------------------------*)
function TfmResource.GetCanRedo: boolean;
var
  details : TUndoDetails;
begin
  if ResourceDetails.Tag <> 0 then
  begin
    details := TUndoDetails (resourceDetails.Tag);
    result := details.fRedoStack.Count > 0
  end
  else
    result := False
end;

(*----------------------------------------------------------------------*
 | TfmResource.GetCanUndo                                               |
 |                                                                      |
 | 'Get' handler for CanUndo property.  Returns true if the resource    |
 | details has items in it's undo list                                  |
 *----------------------------------------------------------------------*)
function TfmResource.GetCanSelectAll: boolean;
begin
  Result := False
end;

function TfmResource.GetCanUndo: boolean;
var
  details : TUndoDetails;
begin
  if ResourceDetails.Tag <> 0 then
  begin
    details := TUndoDetails (resourceDetails.Tag);
    result := details.fUndoStack.Count > 0
  end
  else
    result := False
end;

(*----------------------------------------------------------------------*
 | TfmResource.GetImportExportType                                      |
 |                                                                      |
 | 'Get' handler for ExportType property.  Determine whether the        |
 | resource form can export it's contents                               |
 *----------------------------------------------------------------------*)
function TfmResource.GetImportExportType: TImportExportType;
begin
  Result := ixNone
end;

(*----------------------------------------------------------------------*
 | TfmResource.GetRedoDescription                                       |