ahword97.pas

一个好的word的控件

unit AHWord97;

interface
                              
{
   These objects are based on the TWordObject demo in the directory
   C:\Program Files\Borland\Delphi4\Demos\Activex\Oleauto\Word8

   This is the Delphi 4 version

	 Feel free to add to this unit. My only condition is that you e-mail me your additions
  and put in small comments indicating updates/changes (eg '<- added by JB 1/3/99')
  and large comments where things are not obvious.

	 You are free to use this unit in any program, even commercial (although I'd like to know
  about where it is being used). You are not allowed to sell this, or a variation on it, as
  that would be dishonest. If you give away your source code in a program and use this unit,
  please keep this header so bugs/bug-fixes come to me.

  Dr Allan Harkness
  e-mail [e-mail]
  Scotland

  History: see Word97 Hx.txt
  Version 1.7
}

uses
  {$IFDEF VER130} Word97, {$ELSE} Word_TLB, {$ENDIF}
  Windows, Classes, SysUtils, ActiveX, OleCtrls, Forms;


const
  wdTrue : Integer = -1;
  wdFalse : Integer = 0;

type
  TWordDoc = class;
  TWordApp = class;

  TWordDocEvent = procedure (WordApp: TWordApp; WordDoc : TWordDoc) of object;

  TWordEventSink = class(TInterfacedObject, IUnknown, IDispatch)
  private
    FWordApp : TWordApp;
    FAppDispatch: IDispatch;
    FDocDispatch: IDispatch;
    FAppDispIntfIID: TGUID;
    FDocDispIntfIID: TGUID;
    FAppConnection: Integer;
    FDocConnection: Integer;
  protected
    { IUnknown }
    function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    { IDispatch }
    function GetTypeInfoCount(out Count: Integer): HRESULT; stdcall;
    function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HRESULT; stdcall;
    function GetIDsOfNames(const IID: TGUID; Names: Pointer;
      NameCount, LocaleID: Integer; DispIDs: Pointer): HRESULT; stdcall;
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
      Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HRESULT; stdcall;
  public
    constructor Create(WordApp : TWordApp; AnAppDispatch: IDispatch; const AnAppDispIntfIID, ADocDispIntfIID: TGUID);
    destructor Destroy; override;
  end;

  TWordApp = class
  private
    FComApp : _Application;
    FComGlobal : _Global;
    FUsedExisting : Boolean;
    FEventSink : TWordEventSink;
    FOnQuit : TNotifyEvent;
    FOnChangeDocument : TWordDocEvent;
    FOnOpenDocument : TWordDocEvent;
    FOnPreCloseDocument : TNotifyEvent;
    FOnCloseDocument : TWordDocEvent;
    function GetCaption : String;
    procedure SetCaption(Value : String);
    function GetVisible : Boolean;
    procedure SetVisible(Value : Boolean);
    function GetScreenUpdating : Boolean;
    procedure SetScreenUpdating (Value : Boolean);
    function GetWindowState : TOleEnum;
    procedure SetWindowState (Value : TOleEnum);
    function GetDocument(Index : Integer) : TWordDoc;
    function GetNoOfDocuments : Integer;
    function GetOnQuit : TNotifyEvent;
    procedure SetOnQuit(Value : TNotifyEvent);
    function GetOnChangeDocument : TWordDocEvent;
    procedure SetOnChangeDocument(Value : TWordDocEvent);
    function GetOnOpenDocument: TWordDocEvent;
    procedure SetOnOpenDocument(Value : TWordDocEvent);
    function GetOnPreCloseDocument: TNotifyEvent;
    procedure SetOnPreCloseDocument(Value : TNotifyEvent);
    function GetOnCloseDocument: TWordDocEvent;
    procedure SetOnCloseDocument(Value : TWordDocEvent);
    procedure FreeDocumentsAndSink;
  protected
    FDocuments : TList;
    procedure RemoveDoc(Index : Integer);
    procedure QuitAppEvent;
    procedure PreCloseDocEvent;
    procedure SyncWithWord;
    procedure ChangeDocEvent;
  public
    constructor Create(UseExisting : Boolean = True; Sink : Boolean = True);
    constructor CreateFromOleObject(OleObject : OleVariant; Sink : Boolean = True);
    destructor Destroy; override;
    destructor CloseApp(oeSaveChanges: TOleEnum);

    function AddNewDoc(Template : String) : TWordDoc;
    function AddOpenDoc(DocName : String) : TWordDoc;
    function AddActiveDoc : TWordDoc;
    procedure CloseActiveDoc(oeSaveChanges: TOleEnum);
    procedure Move(oeUnit : TOleEnum = wdCharacter; Count : Integer = 1);
    procedure MoveEnd(oeUnit : TOleEnum = wdCharacter; Count : Integer = 1);
    procedure MoveStart(oeUnit : TOleEnum = wdCharacter; Count : Integer = 1);
    procedure MoveRight(oeUnit : TOleEnum = wdCharacter; Count : Integer = 1; Extend : TOleEnum = wdMove);
    procedure MoveLeft(oeUnit : TOleEnum = wdCharacter; Count : Integer = 1; Extend : TOleEnum = wdMove);
    procedure MoveUp(oeUnit : TOleEnum = wdLine; Count : Integer = 1; Extend : TOleEnum = wdMove);
    procedure MoveDown(oeUnit : TOleEnum = wdLine; Count : Integer = 1; Extend : TOleEnum = wdMove);
    procedure GotoBookmark(Bookmark : String);
    procedure GoTo_(oeWhat, oeWhich : TOleEnum; oeCount: Integer = 1; oeName: String = '');
    procedure GoToNext(oeWhat : TOleEnum);
    procedure GoToPrevious(oeWhat : TOleEnum);
    procedure UpdateActiveDocFields;
    Procedure RunMacro(MacroName : string);
    procedure ScreenRefresh;
    procedure Cut;
    procedure Copy;
    procedure Paste;
    procedure Activate;
    procedure InsertText(Text : String);
    procedure PrintActiveDoc;
    procedure SaveActiveDocAs(Filename : String);
    property Global : _Global read FComGlobal;
    property Application : _Application read FComApp;
    property UsedExisting : Boolean read FUsedExisting;
    property Caption : String read GetCaption write SetCaption;
    property Visible : Boolean read GetVisible write SetVisible;
    property ScreenUpdating : Boolean read GetScreenUpdating write SetScreenUpdating;
    property WindowState : TOleEnum read GetWindowState write SetWindowState;
    property Document [Index: Integer] : TWordDoc read GetDocument;
    property NoOfDocuments : Integer read GetNoOfDocuments;
    property OnQuit : TNotifyEvent read GetOnQuit write SetOnQuit;
    property OnChangeDocument : TWordDocEvent read GetOnChangeDocument write SetOnChangeDocument;
    property OnOpenDocument : TWordDocEvent read GetOnOpenDocument write SetOnOpenDocument;
    property OnPreCloseDocument : TNotifyEvent read GetOnPreCloseDocument write SetOnPreCloseDocument;
    property OnCloseDocument : TWordDocEvent read GetOnCloseDocument write SetOnCloseDocument;
  end;

  TWordRange = class;

  TWordDocMode = (wdmCreating, wdmExisting, wdmDestroying);

  TWordDoc = class
  private
    FComDoc : _Document;
    FWordApp : TWordApp;
    FFullname : String;
    FItemIndex : Integer;
    function GetActive : Boolean;
    procedure SetActive(Value : Boolean);
    function GetRange(Index : Integer) : TWordRange;
    function GetNoOfRanges : Integer;
    function GetNoOfBookMarks : Integer;
    function GetBookmarkByName (BookmarkName: String) : {$IFDEF VER130}Word97.Bookmark{$ELSE}Word_TLB.Bookmark{$ENDIF};
    function GetBookmarkByIndex(Index: Integer) : {$IFDEF VER130}Word97.Bookmark{$ELSE}Word_TLB.Bookmark{$ENDIF};
    procedure SetBuiltInProperty(Index : String; Const Value: Variant);
    function GetBuiltInProperty(Index : String) : Variant;
    procedure SetCustomProperty(Index : String; Const Value : Variant);
    function GetCustomProperty(Index : String) : Variant;
    procedure FreeRangesAndRemoveDoc;
    function GetAutoTextEntries : OleVariant;
  protected
    FMode : TWordDocMode;
    FRanges : TList;
    procedure RemoveRange(Index : Integer);
  public
    constructor CreateNewDoc(WordApp : TWordApp; Template : String);
    constructor CreateOpenDoc(WordApp : TWordApp; FileName : String);
    constructor CreateFromComDoc(WordApp : TWordApp; ComDoc : _Document);
    constructor CreateFromActiveDoc(WordApp : TWordApp);
    destructor Destroy; override;
    destructor CloseDoc(oeSaveChanges: TOleEnum);
    procedure Print;
    function AddRangeFromBookMark(BookmarkName : String) : TWordRange;
    function AddRangeFromSelection : TWordRange;
    function AddRangeFromDoc(iStart : Integer = 1; iEnd : Integer = 1) : TWordRange;
    function AddRangeFromRange(ComRange : Range) : TWordRange;
    function GoTo_(oeWhat, oeWhich : TOleEnum; oeCount: Integer = 1; oeName: String = '') : {$IFDEF VER130}Word97.Range{$ELSE}Word_TLB.Range{$ENDIF};
    function GoToNext(oeWhat : TOleEnum) : {$IFDEF VER130}Word97.Range{$ELSE}Word_TLB.Range{$ENDIF};
    function GoToPrevious(oeWhat : TOleEnum) : {$IFDEF VER130}Word97.Range{$ELSE}Word_TLB.Range{$ENDIF};
    function NoOfPages (IncludeFootnotesAndEndnotes : Boolean = False) : Integer;
    function NoOfWords (IncludeFootnotesAndEndnotes : Boolean = False) : Integer;
    procedure ReplaceBookmark (BookmarkName, ReplaceText : String; ReassignBookmark : Boolean = True);
    procedure DeleteRange(Index : Integer);
    function DocStillInWord : Boolean;
    procedure UpdateFields;
    procedure UpdateFullname;
    procedure SaveAs(Filename : String);
    property WordApp : TWordApp read FWordApp;
    property Document : _Document read FComDoc write FComDoc;
    property Fullname : String read FFullname;
    property Active : Boolean read GetActive write SetActive;
    property AutoTextEntries : OleVariant read GetAutoTextEntries;
    property Range [Index: Integer] : TWordRange read GetRange;
    property NoOfRanges : Integer read GetNoOfRanges;
    property BookmarkByIndex [Index: Integer] : Bookmark read GetBookmarkByIndex;
    property Bookmark [BookmarkName: String] : Bookmark read GetBookmarkByName;
    property NoOfBookmarks : Integer read GetNoOfBookmarks;
    property BuiltInProperty [Index : String] : Variant read GetBuiltInProperty write SetBuiltInProperty;
    property CustomProperty [Index : String] : Variant read GetCustomProperty write SetCustomProperty;
    property ItemIndex : Integer read FItemIndex;
    property Mode : TWordDocMode read FMode;
  end;

  TWordRange = class
  private
    FComRange : {$IFDEF VER130}Word97.Range{$ELSE}Word_TLB.Range{$ENDIF};
    FWordDoc : TWordDoc;
    FItemIndex : Integer;
    procedure SetStart(Value : Integer);
    function GetStart : Integer;
    procedure SetEnd(Value : Integer);
    function GetEnd : Integer;
    procedure SetText(Value : String);
    function GetText : String;
    procedure SetBold(Value : Boolean);
    function GetBold : Boolean;
    procedure SetItalic(Value : Boolean);
    function GetItalic : Boolean;
    procedure SetUnderline(Value : Boolean);
    function GetUnderline : Boolean;
    procedure SetCase(oeValue : TOleEnum);
    function GetCase :TOleEnum;
    procedure SetFont(fFont : _Font);
    function GetFont : _Font;
    procedure SetStyle(Style : String);
    function GetStyle : String;
  protected
  public
    constructor CreateFromBookMark(WordDoc : TWordDoc; BookmarkName : String);
    constructor CreateFromSelection(WordDoc : TWordDoc);
    constructor CreateFromDoc(WordDoc : TWordDoc; iStart : Integer = 1; iEnd : Integer = 1);
    constructor CreateFromRange(WordDoc : TWordDoc; ComRange : {$IFDEF VER130}Word97.Range{$ELSE}Word_TLB.Range{$ENDIF});
    destructor Destroy; override;
    procedure Collapse(oeDirection : TOleEnum = wdCollapseStart);
    function EndOf(oeUnit : TOleEnum = wdWord; oeExtend : TOleEnum = wdMove) : Integer;
    function Expand(oeUnit : TOleEnum = wdWord) : Integer;
    function GoTo_(oeWhat, oeWhich : TOleEnum; oeCount: Integer = 1; oeName: String = '') : {$IFDEF VER130}Word97.Range{$ELSE}Word_TLB.Range{$ENDIF};
    function GotoBookmark(BookmarkName : string) : {$IFDEF VER130}Word97.Range{$ELSE}Word_TLB.Range{$ENDIF};
    function GoToNext(oeWhat : TOleEnum) : {$IFDEF VER130}Word97.Range{$ELSE}Word_TLB.Range{$ENDIF};
    function GoToPrevious(oeWhat : TOleEnum) : {$IFDEF VER130}Word97.Range{$ELSE}Word_TLB.Range{$ENDIF};
    function NoOfWords : Integer;
    procedure InsertAfter(Text : String);
    procedure InsertAutoText;
    procedure InsertGivenAutoText (AutoText : String; UseRichText : Boolean = True);
    procedure InsertBefore(Text : String);
    procedure InsertBreak(oeType : TOleEnum = wdPageBreak);
    procedure InsertParagraph;
    procedure InsertParagraphAfter;
    procedure InsertParagraphBefore;
    procedure InsertSymbol(CharacterNumber: Integer; Font: String;
                            Unicode: Boolean = False; oeBias : TOleEnum = wdFontBiasDefault);
    function Move(oeUnit : TOleEnum = wdCharacter; oeCount : Integer = 1) : Integer;
    function MoveWhile(Cset : String; Count : Integer = wdForward) : Integer;
    function MoveUntil(Cset : String; Count : Integer = wdForward) : Integer;
    function MoveStart(oeUnit : TOleEnum = wdCharacter; oeCount : Integer = 1) : Integer;
    function MoveStartWhile(Cset : String; Count : Integer = wdForward) : Integer;
    function MoveStartUntil(Cset : String; Count : Integer = wdForward) : Integer;
    function MoveEnd(oeUnit : TOleEnum = wdCharacter; oeCount : Integer = 1) : Integer;
    function MoveEndUntil(Cset : String; Count : Integer = wdForward) : Integer;
    function MoveEndWhile(Cset : String; Count : Integer = wdForward) : Integer;
    function Next(oeUnit : TOleEnum = wdCharacter; oeCount : Integer = 1) : {$IFDEF VER130}Word97.Range{$ELSE}Word_TLB.Range{$ENDIF};
    function Previous(oeUnit : TOleEnum = wdCharacter; oeCount : Integer = 1) : {$IFDEF VER130}Word97.Range{$ELSE}Word_TLB.Range{$ENDIF};
    function GetNextRange(oeUnit : TOleEnum = wdCharacter; oeCount : Integer = 1) : {$IFDEF VER130}Word97.Range{$ELSE}Word_TLB.Range{$ENDIF};
    function GetPreviousRange(oeUnit : TOleEnum = wdCharacter; oeCount : Integer = 1) : {$IFDEF VER130}Word97.Range{$ELSE}Word_TLB.Range{$ENDIF};
    procedure SetRange(iStart, iEnd : Integer);
    function StartOf(oeUnit : TOleEnum = wdWord; oeExtend : TOleEnum = wdMove) : Integer;
    procedure CreateBookMark(BookmarkName : String);
    procedure Select;
    procedure Cut;
    procedure Copy;
    procedure Paste;

    property Range : {$IFDEF VER130}Word97.Range{$ELSE}Word_TLB.Range{$ENDIF} read FComRange write FComRange;
    property WordDoc : TWordDoc read FWordDoc;
    property Start : Integer read GetStart write SetStart;
    property End_ : Integer read GetEnd write SetEnd;
    property Text : String read GetText write SetText;
    property Bold : Boolean read GetBold write SetBold;
    property Italic : Boolean read GetItalic write SetItalic;
    property Underline : Boolean read GetUnderline write SetUnderline;
    property Case_ : TOleEnum read GetCase write SetCase;
    property Font : _Font read GetFont write SetFont;
    property Style : String read GetStyle write SetStyle;
    property ItemIndex : Integer read FItemIndex;
  end;

implementation

uses
  ComObj;

{ TWordEventSink implementation }

constructor TWordEventSink.Create(WordApp : TWordApp; AnAppDispatch: IDispatch; const AnAppDispIntfIID, ADocDispIntfIID: TGUID);
begin
  inherited Create;

  FWordApp := WordApp;
  FAppDispIntfIID := AnAppDispIntfIID;
  FDocDispIntfIID := ADocDispIntfIID;
  FAppDispatch := AnAppDispatch;

  // Hook the sink up to the automation server (Word97)
  InterfaceConnect(FAppDispatch,FAppDispIntfIID,Self,FAppConnection);
end;

destructor TWordEventSink.Destroy;
begin
  // Unhook the sink from the automation server (Word97)
  InterfaceDisconnect(FAppDispatch,FAppDispIntfIID,FAppConnection);

  inherited Destroy;
end;

function TWordEventSink.QueryInterface(const IID: TGUID; out Obj): HRESULT;
begin
  // We need to return the two event interfaces when they're asked for
  Result := E_NOINTERFACE;
  if GetInterface(IID,Obj) then
    Result := S_OK;
  if IsEqualGUID(IID,FAppDispIntfIID) and GetInterface(IDispatch,Obj) then
    Result := S_OK;
  if IsEqualGUID(IID,FDocDispIntfIID) and GetInterface(IDispatch,Obj) then
    Result := S_OK;
end;

function TWordEventSink._AddRef: Integer;
begin
// Skeleton implementation
  Result := 2;
end;

function TWordEventSink._Release: Integer;
begin
// Skeleton implementation
  Result := 1;
end;

function TWordEventSink.GetTypeInfoCount(out Count: Integer): HRESULT;
begin
// Skeleton implementation
  Count  := 0;
  Result := S_OK;
end;

function TWordEventSink.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HRESULT;
begin
// Skeleton implementation
  Result := E_NOTIMPL;
end;

function TWordEventSink.GetIDsOfNames(const IID: TGUID; Names: Pointer;
  NameCount, LocaleID: Integer; DispIDs: Pointer): HRESULT;
begin
// Skeleton implementation
  Result := E_NOTIMPL;
end;

function TWordEventSink.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
  Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HRESULT;
begin
  // Fire the different event handlers when the different event methods are invoked
  // Only do this if FDocuments has not been destroyed.
  // Usually the "closing events" occur before FreeDocumentsAndSink when TWordApp is
  // destroyed. This results in a clean clear-up. However occasionally the "closing events"
  // occurs after FreeDocumentsAndSink where any reference to FDocuments will cause an
  // exception. I cannot seem to predict/prevent this and may be due to message queues.
  // Therefor in this situation, the event sink will not fire closing/quiting events.
  if FWordApp.FDocuments <> nil then
    case DispID of
      2 : FWordApp.QuitAppEvent;
      3 : begin
            FWordApp.ChangeDocEvent;
            // When we see a document change, we also need to disconnect the
            // sink from the old document, and hook it up to the new document
            InterfaceDisconnect(FDocDispatch,FDocDispIntfIID,FDocConnection);
            try
              // Added check for *any* document before trying to connect to it
              // Otherwise closing the last document causes an exception here
              // Note Word events are unreliable - in my demo:-
              // Closing a document -> DispID 6 and then 3 !!!
              // Opening a document -> DispID 3 but not 5 !!!
              if _Application(FAppDispatch).Documents.Count > 0 then
              begin
                FDocDispatch := _Application(FAppDispatch).ActiveDocument;
                InterfaceConnect(FDocDispatch,FDocDispIntfIID,Self,FDocConnection);
              end;
            except;
            end;
          end;
      {4 : if Assigned(FWordApp.OnNewDocument) then  // never seems to be called
            FWordApp.OnNewDocument(FWordApp, nil);}
      {5 : if Assigned(FWordApp.OnOpenDocument) then // never seems to be called
            FWordApp.OnOpenDocument(FWordApp, nil);}
      6 : FWordApp.PreCloseDocEvent;
    end;
  Result := S_OK;
end;

{ TWordApp implementation }

constructor TWordApp.Create(UseExisting : Boolean = True; Sink : Boolean = True);
var
  TempIUnknown : IUnknown;
  Result: HResult;
begin
  inherited Create;
  FUsedExisting := False;
  if UseExisting then
  begin
    {$IFDEF VER130}
    Result := GetActiveObject(CLASS_WordApplication, nil, TempIUnknown);
    {$ELSE}
    Result := GetActiveObject(CLASS_Application_, nil, TempIUnknown);
    {$ENDIF}
    if Result = MK_E_UNAVAILABLE then // Word application does not exist
      {$IFDEF VER130}
        FComApp := CoWordApplication.Create
      {$ELSE}
        FComApp := CoApplication_.Create
      {$ENDIF}
    else
    begin                             // Word application exists
      // make sure no other error occured while trying to get global class
      OleCheck(Result);
      // convert late bound IUnknown to early bound _Global
      OleCheck(TempIUnknown.QueryInterface(_Application, FComApp));
      FUsedExisting := True; // actually got an existing instance
    end;
  end
  else
    {$IFDEF VER130}
      FComApp := CoWordApplication.Create;
    {$ELSE}
      FComApp := CoApplication_.Create;
    {$ENDIF}
  FComGlobal := CoGlobal.Create;

  if Sink then // Create the event sink if required
    FEventSink := TWordEventSink.Create(Self,FComApp,ApplicationEvents,DocumentEvents)
  else
    FEventSink := nil;
  FDocuments := TList.Create;
  if FUsedExisting then SyncWithWord;
end;

constructor TWordApp.CreateFromOleObject(OleObject : OleVariant; Sink : Boolean = True);
begin
  inherited Create;
  FUsedExisting := False;
  try
    {$IFDEF VER130}
      FComApp := IDISPATCH (OleObject.Application) as WordApplication;
    {$ELSE}
      FComApp := IDISPATCH (OleObject.Application) as _Application;
    {$ENDIF}
    FComGlobal := CoGlobal.Create;
    FUsedExisting := True; // actually got an existing instance