unit AHWord97; interface (* These objects are based on the TWordObject demo in the directory C:\Program Files\Borland\DelphiX\Demos\Activex\Oleauto\Word8 This is the Delphi 4/5 version (separate version for Delphi 3) 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 Scotland e-mail Allan@capturebeat.com Latest version available from www.capturebeat.com History: see Word97 Hx.txt Version 2.2 NB Event sinking will not work "as advertised" in Word 2000. I think this is because MS have finally implemented Word application events properly and my code goes out of its way to get round the bugs in version 97. If someone want to test the Word 2000 events (eg using the Delphi components) and tell me exactly what causes them to fire, I may be able to change the event code to work in Word 2000. I don't have Word 2000 so it's rather hard to test... NB If you wish to use Word 2000, make a compiler define for USE_WORD2K Either put the following in the interface of appropriate units or better still, use Project.Options.Conditional Defines to set this compiler define globally {$DEFINE USE_WORD2K} NB As far as I am aware, a program compiled "use"ing any of the type libraries should be able to talk to Word 97 and Word 2000. This is because Word 2000 continues to support the Word 97 interfaces. However, I would suggest you compile your program with the new Word2000.pas provided in the Delphi 5 update. If you define USE_WORD2K then my code will call the old version of some of the Word methods (eg AddOld rather than Add). This compiler directive simply tells my code which type library you are using - it will not use any new features found in Word 2000. If you wish to use the new features in Word 2000 (eg macro parameters), you can do so and cover yourself with an $IFDEF to make sure your code works for Word 97 users too (if you need to). If you make references to the following type libraries in other units, copy the series of $IFDEF's *) {$DEFINE USE_WORD2K} uses {$IFDEF USE_WORD2K} Word2000, {$ELSE} Word97, {$ENDIF} {$IFDEF USE_WORD2K} Office2000, {$ELSE} Office97, {$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 GetZoomPerCent : Integer; procedure SetZoomPerCent (Value : Integer); 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); procedure DisableSystemCloseBox; function AddNewDoc(Template : String) : TWordDoc; function AddOpenDoc(DocName : String) : TWordDoc; function AddActiveDoc : TWordDoc; procedure CloseActiveDoc(oeSaveChanges: TOleEnum); procedure InsertFile(FileName : string); overload; procedure InsertFile(FileName, Bookmark : string); overload; 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); procedure ZoomFullPage; procedure ZoomFullWidth; 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 ZoomPerCent : Integer read GetZoomPerCent write SetZoomPerCent; 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 USE_WORD2K} Word2000.Bookmark {$ELSE} Word97.Bookmark {$ENDIF}; function GetBookmarkByIndex(Index: Integer) : {$IFDEF USE_WORD2K} Word2000.Bookmark {$ELSE} Word97.Bookmark {$ENDIF}; procedure SetBuiltInProperty(Index : TOleEnum; Const Value: Variant); function GetBuiltInProperty(Index : TOleEnum) : Variant; procedure SetCustomProperty(Index : String; Const Value : Variant); function GetCustomProperty(Index : String) : Variant; function GetRTF : String; procedure SetRTF (sRTF : String); 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; procedure PrintPreview; 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 USE_WORD2K} Word2000.Range {$ELSE} Word97.Range {$ENDIF}; function GoToNext(oeWhat : TOleEnum) : {$IFDEF USE_WORD2K} Word2000.Range {$ELSE} Word97.Range {$ENDIF}; function GoToPrevious(oeWhat : TOleEnum) : {$IFDEF USE_WORD2K} Word2000.Range {$ELSE} Word97.Range {$ENDIF}; function GoToSection(NumSec: Integer = 1) : {$IFDEF USE_WORD2K} Word2000.Range {$ELSE} Word97.Range {$ENDIF}; function NoOfPages (IncludeFootnotesAndEndnotes : Boolean = False) : Integer; function NoOfWords (IncludeFootnotesAndEndnotes : Boolean = False) : Integer; procedure ReplaceBookmark (BookmarkName, ReplaceText : String; ReassignBookmark : Boolean = True); function BookmarkExists(BookmarkName : String): Boolean; procedure AddCustomProperty(Index: String; Value : Variant; oePropertyType : TOleEnum); overload; procedure AddCustomProperty(Index: String; Value : String); overload; procedure AddCustomProperty(Index: String; Value : Integer); overload; procedure AddCustomProperty(Index: String; Value : Double); overload; procedure AddCustomProperty(Index: String; Value : TDateTime); overload; procedure AddCustomProperty(Index: String; Value : Boolean); overload; procedure DeleteCustomProperty(Index: String); 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 : TOleEnum] : Variant read GetBuiltInProperty write SetBuiltInProperty; property CustomProperty [Index : String] : Variant read GetCustomProperty write SetCustomProperty; property ItemIndex : Integer read FItemIndex; property Mode : TWordDocMode read FMode; property RTF : String read GetRTF write SetRTF; end; TWordRange = class private FComRange : {$IFDEF USE_WORD2K} Word2000.Range {$ELSE} Word97.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 : Variant); function GetStyle : Variant; 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 USE_WORD2K} Word2000.Range {$ELSE} Word97.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 USE_WORD2K} Word2000.Range {$ELSE} Word97.Range {$ENDIF}; function GotoBookmark(BookmarkName : string) : {$IFDEF USE_WORD2K} Word2000.Range {$ELSE} Word97.Range {$ENDIF}; function GoToNext(oeWhat : TOleEnum) : {$IFDEF USE_WORD2K} Word2000.Range {$ELSE} Word97.Range {$ENDIF}; function GoToPrevious(oeWhat : TOleEnum) : {$IFDEF USE_WORD2K} Word2000.Range {$ELSE} Word97.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 USE_WORD2K} Word2000.Range {$ELSE} Word97.Range {$ENDIF}; function Previous(oeUnit : TOleEnum = wdCharacter; oeCount : Integer = 1) : {$IFDEF USE_WORD2K} Word2000.Range {$ELSE} Word97.Range {$ENDIF}; function GetNextRange(oeUnit : TOleEnum = wdCharacter; oeCount : Integer = 1) : {$IFDEF USE_WORD2K} Word2000.Range {$ELSE} Word97.Range {$ENDIF}; function GetPreviousRange(oeUnit : TOleEnum = wdCharacter; oeCount : Integer = 1) : {$IFDEF USE_WORD2K} Word2000.Range {$ELSE} Word97.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 USE_WORD2K} Word2000.Range {$ELSE} Word97.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 : Variant read GetStyle write SetStyle; property ItemIndex : Integer read FItemIndex; end; function ImprimirDoc(Fichero : String) : Boolean; implementation uses Variants, ComObj; { General purpose routines } function GetRTFFormat(DataObject: IDataObject; var RTFFormat: TFormatEtc): Boolean; var Formats: IEnumFORMATETC; TempFormat: TFormatEtc; cfRTF: LongWord; Found: Boolean; begin try OleCheck(DataObject.EnumFormatEtc(DATADIR_GET, Formats)); cfRTF := RegisterClipboardFormat('Rich Text Format'); Found := False; while (not Found) and (Formats.Next(1, TempFormat, nil) = S_OK) do if (TempFormat.cfFormat = cfRTF) then begin RTFFormat := TempFormat; Found := True; end; Result := Found; except Result := False; end; end; { 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 Result := GetActiveObject(CLASS_WordApplication, nil, TempIUnknown); if Result = MK_E_UNAVAILABLE then // Word application does not exist FComApp := CoWordApplication.Create else begin // Word application exists // make sure no other error occured while trying to get Application class OleCheck(Result); // get _Application interface from TempIUnknown OleCheck(TempIUnknown.QueryInterface(_Application, FComApp)); FUsedExisting := True; // actually got an existing instance end; end else FComApp := CoWordApplication.Create; //Now get global object {$IFDEF USE_WORD2K} FComGlobal := CoWordGlobal.Create; {$ELSE} FComGlobal := CoGlobal.Create; {$ENDIF} 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 FComApp := IDISPATCH (OleObject.Application) as WordApplication; {$IFDEF USE_WORD2K} FComGlobal := CoWordGlobal.Create; {$ELSE} FComGlobal := CoGlobal.Create; {$ENDIF} FUsedExisting := True; // actually got an existing instance except raise Exception.Create ('Word not active in OLE container'); end; if Sink then FEventSink := TWordEventSink.Create(Self,FComApp,ApplicationEvents,DocumentEvents) else FEventSink := nil; FDocuments := TList.Create; if FUsedExisting then SyncWithWord; end; procedure TWordApp.FreeDocumentsAndSink; var i : Integer; begin // faster to free if we go backward // also when a document is destroyed it removes itself from this list if FDocuments.Count > 0 then for i := FDocuments.Count - 1 downto 0 do if Assigned (FDocuments [i]) then TWordDoc (FDocuments [i]).Free; FEventSink := nil; FDocuments.Free; FDocuments := nil; end; destructor TWordApp.Destroy; begin FreeDocumentsAndSink; inherited Destroy; end; destructor TWordApp.CloseApp(oeSaveChanges: TOleEnum); var ovSaveChanges, OriginalFormat, RouteDocument : OleVariant; begin ovSaveChanges := oeSaveChanges; //wdDoNotSaveChanges OriginalFormat := EmptyParam; RouteDocument := EmptyParam; FComApp.Quit (ovSaveChanges, OriginalFormat, RouteDocument); FreeDocumentsAndSink; inherited Destroy; end; procedure TWordApp.DisableSystemCloseBox; var hWordWIndow : HWND; hSysMenu : HMENU; begin // Find the Word 97 handle hWordWindow := FindWindow ('OpusApp', nil); if hWordWindow <> 0 then begin hSysMenu := GetSystemMenu (hWordWindow, false); EnableMenuItem (hSysMenu, SC_CLOSE, MF_BYCOMMAND or MF_GRAYED) end; end; procedure TWordApp.SetCaption(Value : String); begin FComApp.Caption := Value; end; function TWordApp.GetCaption : String; begin Result := FComApp.Caption; end; procedure TWordApp.ZoomFullPage; begin FComApp.ActiveWindow.View.Zoom.PageFit := wdPageFitFullPage; end; procedure TWordApp.ZoomFullWidth; begin FComApp.ActiveWindow.View.Zoom.PageFit := wdPageFitBestFit; end; procedure TWordApp.SetZoomPerCent (Value : Integer); begin FComApp.ActiveWindow.View.Zoom.Percentage := Value; end; function TWordApp.GetZoomPerCent : Integer; begin Result := FComApp.ActiveWindow.View.Zoom.Percentage; end; procedure TWordApp.SetVisible(Value : Boolean); begin FComApp.Visible := Value; end; function TWordApp.GetVisible : Boolean; begin Result := FComApp.Visible; end; function TWordApp.GetDocument(Index : Integer) : TWordDoc; begin Assert ((Index >= 0) and (Index < FDocuments.Count), 'Index out of range for GetDocument (' + IntToStr (Index) + ')'); GetDocument := TWordDoc (FDocuments [Index]); end; function TWordApp.GetNoOfDocuments : Integer; begin GetNoOfDocuments := FDocuments.Count; end; procedure TWordApp.RemoveDoc(Index : Integer); // remove Document object from list (but do not free it) // should rarely be used as onus then on developer to free this Document object var i : Integer; wd : TWordDoc; begin Assert ((Index >= 0) and (Index < FDocuments.Count), 'Index out of range for RemoveDocument (' + IntToStr (Index) + ')'); FDocuments.Delete (Index); i := Index; while i < FDocuments.Count do begin wd := TWordDoc (FDocuments [i]); if Assigned (wd) then wd.FItemIndex := i; inc (i); end; end; function TWordApp.GetOnQuit : TNotifyEvent; begin Result := FOnQuit; end; procedure TWordApp.SetOnQuit(Value : TNotifyEvent); begin FOnQuit := Value; end; function TWordApp.GetOnChangeDocument : TWordDocEvent; begin Result := FOnChangeDocument; end; procedure TWordApp.SetOnChangeDocument(Value : TWordDocEvent); begin FOnChangeDocument := Value; end; function TWordApp.GetOnOpenDocument : TWordDocEvent; begin Result := FOnOpenDocument; end; procedure TWordApp.SetOnOpenDocument(Value : TWordDocEvent); begin FOnOpenDocument := Value; end; function TWordApp.GetOnPreCloseDocument : TNotifyEvent; begin Result := FOnPreCloseDocument; end; procedure TWordApp.SetOnPreCloseDocument(Value : TNotifyEvent); begin FOnPreCloseDocument := Value; end; function TWordApp.GetOnCloseDocument : TWordDocEvent; begin Result := FOnCloseDocument; end; procedure TWordApp.SetOnCloseDocument(Value : TWordDocEvent); begin FOnCloseDocument := Value; end; procedure TWordApp.InsertText(Text : String); begin FComApp.Selection.TypeText(Text); end; function TWordApp.AddNewDoc(Template : String) : TWordDoc; var wd : TWordDoc; begin wd := TWordDoc.CreateNewDoc (Self, Template); AddNewDoc := wd; end; function TWordApp.AddOpenDoc (DocName : String) : TWordDoc; var wd : TWordDoc; begin wd := TWordDoc.CreateOpenDoc (Self, DocName); AddOpenDoc := wd; end; function TWordApp.AddActiveDoc : TWordDoc; // tries to see if active doc in list & just return it // else try to get active doc from Word // if no active doc then return nil and leave list alone var wd : TWordDoc; i : Integer; begin wd := nil; i := 0; while (i < FDocuments.Count) and (wd = nil) do begin wd := TWordDoc (FDocuments [i]); if not wd.Active then wd := nil; inc (i) end; if wd = nil then begin wd := TWordDoc.CreateFromActiveDoc (Self); if wd.FComDoc = nil then begin wd.Destroy; wd := nil end end; AddActiveDoc := wd; end; procedure TWordApp.CloseActiveDoc(oeSaveChanges: TOleEnum); var wd : TWordDoc; begin wd := AddActiveDoc; if wd <> nil then wd.CloseDoc (oeSaveChanges); end; procedure TWordApp.PrintActiveDoc; begin {$IFDEF USE_WORD2K} FComApp.PrintOutOld (EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam) {$ELSE} FComApp.PrintOut (EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam) {$ENDIF} end; procedure TWordApp.SaveActiveDocAs(Filename : String); var wd : TWordDoc; begin wd := AddActiveDoc; if wd <> nil then wd.SaveAs (Filename); end; procedure TWordApp.QuitAppEvent; var MyDoc : TWordDoc; iMyDocs : Integer; begin iMyDocs := FDocuments.Count; while iMyDocs > 0 do begin MyDoc := TWordDoc (FDocuments [iMyDocs - 1]); if Assigned (FOnCloseDocument) then FOnCloseDocument (Self, MyDoc); if MyDoc.Mode <> wdmDestroying then MyDoc.Free; // will remove document too Dec (iMyDocs); end; if Assigned (FOnQuit) then FOnQuit (Self); end; procedure TWordApp.PreCloseDocEvent; var wd : TWordDoc; begin // The pre-close event is really what Word sends as a close event // However, it occurs before the document closes. The document is still // accessible using COM. If there a changes, Word may display the // "Do you want Save ..." dialog // If the user cancels, the document won't actually close // There is no way to know which document is about to close but usually // it is the active document (but not necessarily) // If the user tries to quits Word and there are documents present, // you will get just one pre-close event and no way to know that actually the // whole shebang is about to disappear. Don't you just love Word? // This is why no document is passes in this event // (Note I update the active document's name here in case this is useful // in the OnClose event, when you can no longer use COM) // After such a pre-close event you will get a quit event, however, if // there are no documents present when the user quits, you get no events! wd := AddActiveDoc; if wd <> nil then wd.UpdateFullname; if Assigned (FOnPreCloseDocument) then FOnPreCloseDocument (Self); end; procedure TWordApp.SyncWithWord; var MyDoc : TWordDoc; WdDoc : _Document; iWrdDocs, iMyDocs : OleVariant; begin // The change event occurs when many events occur. By looking to see what // has actually changed, I can fire off sensible events. // First lets see if there are any missing documents // If there are, generate a close event for the document and free it // NB the COM document is NOT accessible in the close event as Word has // already destroyed it by now. To catch a closing document where you can // still get at the COM document, see the pre-close event - but NB it is // not reliably called by Word iMyDocs := 0; while iMyDocs < FDocuments.Count do begin MyDoc := TWordDoc (FDocuments [iMyDocs]); iWrdDocs := 1; WdDoc := nil; while (iWrdDocs <= FComApp.Documents.Count) and (WdDoc = nil) do begin WdDoc := FComApp.Documents.Item (iWrdDocs); if MyDoc.Document <> WdDoc then WdDoc := nil; iWrdDocs := iWrdDocs + 1; end; if WdDoc = nil then begin if Assigned (FOnCloseDocument) then FOnCloseDocument (Self, MyDoc); if MyDoc.Mode <> wdmDestroying then MyDoc.Free; end; iMyDocs := iMyDocs + 1; end; // Now lets see if there are any new documents // If there are, add them to my list and generate an open doc event iWrdDocs := 1; while iWrdDocs <= FComApp.Documents.Count do begin WdDoc := FComApp.Documents.Item (iWrdDocs); iMyDocs := 0; MyDoc := nil; while (iMyDocs < FDocuments.Count) and (MyDoc = nil) do begin MyDoc := TWordDoc (FDocuments [iMyDocs]); if MyDoc.Document <> WdDoc then MyDoc := nil; iMyDocs := iMyDocs + 1; end; if MyDoc = nil then TWordDoc.CreateFromComDoc (Self, WdDoc); iWrdDocs := iWrdDocs + 1; end; end; procedure TWordApp.ChangeDocEvent; begin SyncWithWord; if (FComApp.Documents.Count > 0) and (Assigned (FOnChangeDocument)) then FOnChangeDocument (Self, AddActiveDoc); end; procedure TWordApp.Move(oeUnit : TOleEnum = wdCharacter; Count : Integer = 1); var ovUnit : OleVariant; ovCount : OleVariant; begin ovUnit := oeUnit; ovCount := Count; FComApp.selection.Move(ovUnit, ovCount); end; procedure TWordApp.MoveEnd(oeUnit : TOleEnum = wdCharacter; Count : Integer = 1); var ovUnit : OleVariant; ovCount : OleVariant; begin ovUnit := oeUnit; ovCount := Count; FComApp.selection.MoveEnd(ovUnit, ovCount); end; procedure TWordApp.MoveStart(oeUnit : TOleEnum = wdCharacter; Count : Integer = 1); var ovUnit : OleVariant; ovCount : OleVariant; begin ovUnit := oeUnit; ovCount := Count; FComApp.selection.MoveStart(ovUnit, ovCount); end; procedure TWordApp.MoveLeft(oeUnit : TOleEnum = wdCharacter; Count : Integer = 1; Extend : TOleEnum = wdMove); var ovUnit : OleVariant; ovCount : OleVariant; ovExtend : OleVariant; begin ovUnit := oeUnit; ovCount := Count; ovExtend := Extend; FComApp.selection.MoveLeft(ovUnit, ovCount, ovExtend); end; procedure TWordApp.MoveRight(oeUnit : TOleEnum = wdCharacter; Count : Integer = 1; Extend : TOleEnum = wdMove); var ovUnit : OleVariant; ovCount : OleVariant; ovExtend : OleVariant; begin ovUnit := oeUnit; ovCount := Count; ovExtend := Extend; FComApp.selection.MoveRight(ovUnit, ovCount, ovExtend); end; procedure TWordApp.MoveUp(oeUnit : TOleEnum = wdLine; Count : Integer = 1; Extend : TOleEnum = wdMove); var ovUnit : OleVariant; ovCount : OleVariant; ovExtend : OleVariant; begin ovUnit := oeUnit; ovCount := Count; ovExtend := Extend; FComApp.selection.MoveUp(ovUnit, ovCount, ovExtend); end; procedure TWordApp.MoveDown(oeUnit : TOleEnum = wdLine; Count : Integer = 1; Extend : TOleEnum = wdMove); var ovUnit : OleVariant; ovCount : OleVariant; ovExtend : OleVariant; begin ovUnit := oeUnit; ovCount := Count; ovExtend := Extend; FComApp.selection.MoveDown(ovUnit, ovCount, ovExtend); end; procedure TWordApp.GoTo_(oeWhat, oeWhich: TOleEnum; oeCount: Integer = 1; oeName: String = ''); var ovWhat, ovWhich, ovCount, ovName : OleVariant; begin ovWhat := oeWhat; ovWhich := oeWhich; ovCount := oeCount; if oeName = '' then ovName := EmptyParam else ovName := oeName; FComApp.Selection.GoTo_ (ovWhat, ovWhich, ovCount, ovName); end; procedure TWordApp.GoToNext(oeWhat: TOleEnum); var ovWhat : OleVariant; begin ovWhat := oeWhat; FComApp.Selection.GoToNext (ovWhat); end; procedure TWordApp.GoToPrevious(oeWhat: TOleEnum); var ovWhat : OleVariant; begin ovWhat := oeWhat; FComApp.Selection.GoToPrevious (ovWhat); end; procedure TWordApp.GotoBookmark(Bookmark : string); var What : OLEVariant; Which : OLEVariant; Count : OLEVariant; Name : OLEVariant; begin What := wdGoToBookmark; Which := EmptyParam; Count := EmptyParam; Name := Bookmark; FComApp.Selection.GoTo_(What, Which, Count, Name); end; procedure TWordApp.Cut; begin FComApp.Selection.Cut; end; procedure TWordApp.Copy; begin FComApp.Selection.Copy; end; procedure TWordApp.Paste; begin FComApp.Selection.Paste; end; procedure TWordApp.Activate; begin FComApp.Activate; end; procedure TWordApp.UpdateActiveDocFields; begin FComApp.ActiveDocument.Fields.Update; end; procedure TWordApp.RunMacro(MacroName : string); begin {$IFDEF USE_WORD2K} FComApp.RunOld(MacroName); {$ELSE} FComApp.Run(MacroName); {$ENDIF} // NB in Word 2000, to run a macro with parameters use late binding, ie // OleVariant(WordApp.Application).Run (MacroName, varg1, varg2..varg30) // Where WordApp is the name of your TWordApp variable // It is not worth using an early bound method call here because of all the // optional parameters end; procedure TWordApp.ScreenRefresh; begin FComApp.ScreenRefresh; end; function TWordApp.GetScreenUpdating : Boolean; begin GetScreenUpdating := FComApp.ScreenUpdating; end; procedure TWordApp.SetScreenUpdating (Value : Boolean); begin FComApp.ScreenUpdating := Value; end; function TWordApp.GetWindowState : TOleEnum; begin GetWindowState := FComApp.WindowState; end; procedure TWordApp.SetWindowState (Value : TOleEnum); begin FComApp.WindowState := Value; end; procedure TWordApp.InsertFile(FileName : string); var oAttachment : OleVariant; begin oAttachment := False; Application.Selection.InsertFile(FileName,EmptyParam, EmptyParam, EmptyParam, oAttachment); end; procedure TWordApp.InsertFile(FileName, Bookmark : string); begin GotoBookmark(Bookmark); InsertFile(FileName); end; { TWordDoc } constructor TWordDoc.CreateNewDoc(WordApp : TWordApp; Template: String); var DocTemplate, NewTemplate, ovDocumentType, ovVisible : OleVariant; begin Create; FMode := wdmCreating; FItemIndex := -1; FRanges := TList.Create; DocTemplate := Template; NewTemplate := False; FWordApp := WordApp; ovDocumentType := 0; ovVisible := True; FComDoc := FWordApp.FComApp.Documents.Add (DocTemplate, NewTemplate, ovDocumentType, ovVisible); FItemIndex := FWordApp.NoOfDocuments; FWordApp.FDocuments.Add (self); // The following gives Word the opportunity to send events (eg open/change doc) // since it requests the document's Fullname. // It is important that the document has been added to the WordApp list so that // the event handler sees the document and doesn't try to create it again UpdateFullname; if Assigned (WordApp.OnOpenDocument) then WordApp.OnOpenDocument (WordApp, Self); FMode := wdmExisting; end; constructor TWordDoc.CreateOpenDoc(WordApp : TWordApp; FileName: String); var ovFileName : OleVariant; begin Create; FMode := wdmCreating; FItemIndex := -1; FRanges := TList.Create; ovFileName := FileName; FWordApp := WordApp; {$IFDEF USE_WORD2K} FComDoc := FWordApp.FComApp.Documents.OpenOld (ovFileName, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam); {$ELSE} FComDoc := FWordApp.FComApp.Documents.Open (ovFileName, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam); {$ENDIF} FItemIndex := FWordApp.NoOfDocuments; FWordApp.FDocuments.Add (self); // The following gives Word the opportunity to send events (eg open/change doc) // since it requests the document's Fullname. // It is important that the document has been added to the WordApp list so that // the event handler sees the document and doesn't try to create it again UpdateFullname; if Assigned (WordApp.OnOpenDocument) then WordApp.OnOpenDocument (WordApp, Self); FMode := wdmExisting; end; constructor TWordDoc.CreateFromComDoc(WordApp : TWordApp; ComDoc : _Document); begin Create; FMode := wdmCreating; FItemIndex := -1; FWordApp := WordApp; FComDoc := ComDoc; FItemIndex := FWordApp.NoOfDocuments; FRanges := TList.Create; FWordApp.FDocuments.Add (self); // The following gives Word the opportunity to send events (eg open/change doc) // since it requests the document's Fullname. // It is important that the document has been added to the WordApp list so that // the event handler sees the document and doesn't try to create it again UpdateFullname; if Assigned (WordApp.OnOpenDocument) then WordApp.OnOpenDocument (WordApp, Self); FMode := wdmExisting; end; constructor TWordDoc.CreateFromActiveDoc(WordApp : TWordApp); begin Create; FMode := wdmCreating; FItemIndex := -1; FWordApp := WordApp; FRanges := TList.Create; if WordApp.FComApp.Documents.Count = 0 then FComDoc := nil // indicates that no valid document else begin FComDoc := FWordApp.FComApp.ActiveDocument; FItemIndex := FWordApp.NoOfDocuments; FWordApp.FDocuments.Add (self); // The following gives Word the opportunity to send events (eg open/change doc) // since it requests the document's Fullname. // It is important that the document has been added to the WordApp list so that // the event handler sees the document and doesn't try to create it again UpdateFullname; if Assigned (WordApp.OnOpenDocument) then WordApp.OnOpenDocument (WordApp, Self); end; FMode := wdmExisting; end; function TWordDoc.DocStillInWord : Boolean; // New function to check if document is still loaded in Word // If user were to close document himself, further calls to FComDoc would // generate an error. Therefor, you should check for the presence of the // document before using the object, if user intervention could have occurred // since the document was first created. This is most likely to be useful if // you have a button on your program that closes Word or the document. // NB if the user closes the document while your code is actively filling in // the document, exceptions will still occur. Unless you check the document before // every use of TWordDoc, you cannot get round this - you should warn users to leave // well alone while your program does its magic. var i : OleVariant; bPresent : boolean; docs : Documents; begin bPresent := False; i := 1; docs := FWordApp.FComApp.Documents; while (not bPresent) and (i <= docs.Count) do begin if docs.Item (i) = FComDoc then bPresent := True; inc (i); end; Result := bPresent; end; procedure TWordDoc.FreeRangesAndRemoveDoc; var i : Integer; begin if Assigned (FRanges) and (FRanges.Count > 0) then for i := FRanges.Count - 1 downto 0 do // faster to free if we go backward if Assigned (FRanges [i]) then TWordRange (FRanges [i]).Free; FRanges.Free; if FItemIndex <> -1 then FWordApp.RemoveDoc (FItemIndex); end; destructor TWordDoc.Destroy; begin FMode := wdmDestroying; FreeRangesAndRemoveDoc; inherited; end; destructor TWordDoc.CloseDoc(oeSaveChanges: TOleEnum); var ovSaveChanges, OriginalFormat, RouteDocument : OleVariant; begin FMode := wdmDestroying; ovSaveChanges := oeSaveChanges; OriginalFormat := EmptyParam; RouteDocument := EmptyParam; FComDoc.Close (ovSaveChanges, OriginalFormat, RouteDocument); Application.ProcessMessages; FreeRangesAndRemoveDoc; inherited Destroy; end; function TWordDoc.GetActive : Boolean; begin if FWordApp.FComApp.ActiveDocument = nil then GetActive := False else GetActive := (FWordApp.FComApp.ActiveDocument = FComDoc); end; procedure TWordDoc.SetActive(Value: Boolean); begin FComDoc.Activate; end; procedure TWordDoc.Print; begin {$IFDEF USE_WORD2K} FComDoc.PrintOutOld (EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam) {$ELSE} FComDoc.PrintOut (EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam) {$ENDIF} end; procedure TWordDoc.PrintPreview; begin FComDoc.PrintPreview end; procedure TWordDoc.SaveAs(Filename: String); var DocName : OleVariant; begin DocName := FileName; FComDoc.SaveAs (DocName, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam); UpdateFullname; end; function TWordDoc.GetRTF : String; var DataObject: IDataObject; RTFFormat: TFormatEtc; ReturnData: TStgMedium; iLen : Integer; Buffer: PChar; sRTF : String; begin FComDoc.QueryInterface(IDataObject, DataObject); if GetRTFFormat(DataObject, RTFFormat) then begin OleCheck(DataObject.GetData(RTFFormat, ReturnData)); try //RTF is passed through global memory Buffer := GlobalLock(ReturnData.hglobal); //Buffer is a pointer to the RTF text iLen := StrLen (Buffer); SetLength (sRTF, iLen); StrLCopy(PChar(sRTF), Buffer, iLen); GetRTF := sRTF; OleCheck (DataObject.SetData (RTFFormat, ReturnData, True)); finally GlobalUnlock(ReturnData.hglobal); end; end; end; procedure TWordDoc.SetRTF (sRTF : String); var DataObject: IDataObject; RTFFormat: TFormatEtc; Medium: TStgMedium; iLen : Integer; Release : BOOL; begin //get the data object OleCheck(FComDoc.QueryInterface(IDataObject, DataObject)); //get the RTF & MetaFile format if GetRTFFormat(DataObject, RTFFormat) then begin Assert(RTFFormat.cfFormat <> 0); //set the data in the Word document (RTF) iLen := Length(sRTF) + 1; ZeroMemory(@Medium, sizeof(TStgMedium)); Medium.tymed := RTFFormat.tymed; Medium.unkForRelease := nil; Medium.hGlobal := GlobalAlloc(GPTR or GMEM_SHARE, iLen); CopyMemory(Pointer(Medium.hGlobal), pchar(sRTF), iLen); Release := False; DataObject.SetData(RTFFormat, Medium, Release); GlobalFree(Medium.hGlobal); end; end; procedure TWordDoc.UpdateFields; begin FComDoc.Fields.Update; end; procedure TWordDoc.UpdateFullname; begin FFullname := FComDoc.FullName; end; function TWordDoc.AddRangeFromBookMark(BookmarkName : String) : TWordRange; var wr : TWordRange; begin wr := TWordRange.CreateFromBookMark (Self, BookMarkName); AddRangeFromBookMark := wr; end; function TWordDoc.AddRangeFromSelection : TWordRange; var wr : TWordRange; begin wr := TWordRange.CreateFromSelection (Self); AddRangeFromSelection := wr; end; function TWordDoc.AddRangeFromDoc(iStart : Integer = 1; iEnd : Integer = 1) : TWordRange; var wr : TWordRange; begin wr := TWordRange.CreateFromDoc (Self, iStart, iEnd); AddRangeFromDoc := wr; end; function TWordDoc.AddRangeFromRange(ComRange : Range) : TWordRange; var wr : TWordRange; begin wr := TWordRange.CreateFromRange (Self, ComRange); AddRangeFromRange := wr; end; function TWordDoc.GetRange(Index : Integer) : TWordRange; begin Assert ((Index >= 0) and (Index < FRanges.Count), 'Index out of range for GetRange (' + IntToStr (Index) + ')'); GetRange := TWordRange (FRanges [Index]); end; function TWordDoc.GetNoOfRanges : Integer; begin GetNoOfRanges := FRanges.Count; end; procedure TWordDoc.DeleteRange(Index : Integer); // remove and free range object begin Assert ((Index >= 0) and (Index < FRanges.Count), 'Index out of range for DeleteRange (' + IntToStr (Index) + ')'); TWordRange (FRanges [Index]).Free; end; procedure TWordDoc.RemoveRange(Index : Integer); // remove range object from list (but do not free it) // should rarely be used as onus then on developer to free this range object var i : Integer; wr : TWordRange; begin Assert ((Index >= 0) and (Index < FRanges.Count), 'Index out of range for RemoveRange (' + IntToStr (Index) + ')'); FRanges.Delete (Index); i := Index; while i < FRanges.Count do begin wr := TWordRange (FRanges [i]); if Assigned (wr) then wr.FItemIndex := wr.FItemIndex - 1; inc (i); end; end; function TWordDoc.GoTo_(oeWhat, oeWhich: TOleEnum; oeCount: Integer = 1; oeName: String = '') : range; var ovWhat, ovWhich, ovCount, ovName : OleVariant; begin ovWhat := oeWhat; ovWhich := oeWhich; ovCount := oeCount; if oeName = '' then ovName := EmptyParam else ovName := oeName; GoTo_ := FComDoc.Range (EmptyParam, EmptyParam).GoTo_ (ovWhat, ovWhich, ovCount, ovName); end; function TWordDoc.GoToNext(oeWhat: TOleEnum) : {$IFDEF USE_WORD2K} Word2000.Range {$ELSE} Word97.Range {$ENDIF}; var ovWhat : OleVariant; begin ovWhat := oeWhat; GotoNext := FComDoc.Range (EmptyParam, EmptyParam).GoToNext (ovWhat); end; function TWordDoc.GoToPrevious(oeWhat: TOleEnum) : {$IFDEF USE_WORD2K} Word2000.Range {$ELSE} Word97.Range {$ENDIF}; var ovWhat : OleVariant; begin ovWhat := oeWhat; GotoPrevious := FComDoc.Range (EmptyParam, EmptyParam).GoToPrevious (ovWhat); end; function TWordDoc.GoToSection(NumSec: Integer = 1) : {$IFDEF USE_WORD2K} Word2000.Range {$ELSE} Word97.Range {$ENDIF}; var ovWhat : OleVariant; ovWhich : OleVariant; ovCount : OleVariant; begin ovWhat := wdGoToSection; ovWhich := wdGoToFirst; ovCount := NumSec; GoToSection := FComDoc.Range(EmptyParam, EmptyParam).GoTo_(ovWhat, ovWhich, ovCount, EmptyParam); end; function TWordDoc.NoOfPages (IncludeFootnotesAndEndnotes : Boolean = False) : Integer; var ovIncudeHF : OleVariant; begin ovIncudeHF := IncludeFootnotesAndEndnotes; NoOfPages := FComDoc.ComputeStatistics (wdStatisticPages, ovIncudeHF) end; function TWordDoc.NoOfWords (IncludeFootnotesAndEndnotes : Boolean = False) : Integer; var ovIncudeHF : OleVariant; begin ovIncudeHF := IncludeFootnotesAndEndnotes; NoOfWords := FComDoc.ComputeStatistics (wdStatisticWords, ovIncudeHF) end; function TWordDoc.GetNoOfBookMarks : Integer; begin GetNoOfBookMarks := FComDoc.Bookmarks.Count; end; function TWordDoc.GetBookmarkByIndex (Index: Integer) : {$IFDEF USE_WORD2K} Word2000.Bookmark {$ELSE} Word97.Bookmark {$ENDIF}; var ovBookMarkName : OleVariant; begin Result := nil; try ovBookMarkName := Index; Result := FComDoc.Bookmarks.Item(ovBookMarkName); except raise Exception.CreateFmt ('Bookmark No %d not found in document "%s"', [Index, FComDoc.Name]); end; end; function TWordDoc.GetBookmarkByName (BookmarkName: String) : {$IFDEF USE_WORD2K} Word2000.Bookmark {$ELSE} Word97.Bookmark {$ENDIF}; var ovBookMarkName : OleVariant; begin Result := nil; try ovBookMarkName := BookmarkName; Result := FComDoc.Bookmarks.Item(ovBookMarkName); except raise Exception.CreateFmt ('Bookmark "%s" not found in document "%s"', [BookmarkName, FComDoc.Name]); end; end; procedure TWordDoc.ReplaceBookmark (BookmarkName, ReplaceText : String; ReassignBookmark : Boolean = True); var ovBookMarkName : OleVariant; TempRange : {$IFDEF USE_WORD2K} Word2000.Range {$ELSE} Word97.Range {$ENDIF}; ovRange : OleVariant; begin ovBookMarkName := BookMarkName; try TempRange := FComDoc.Bookmarks.Item (ovBookMarkName).Range; TempRange.Text := ReplaceText; ovRange := TempRange; if ReassignBookMark then FComDoc.Bookmarks.Add (BookmarkName, ovRange); except raise Exception.CreateFmt ('Bookmark "%s" not found in document "%s"', [BookMarkName, FComDoc.Name]); end; end; //added by BDP 07/22/1999 function TWordDoc.BookmarkExists(BookmarkName : String): Boolean; begin if FComDoc.Bookmarks.Exists(BookmarkName) then Result := True else Result := False; end; function TWordDoc.GetAutoTextEntries : OleVariant; begin GetAutoTextEntries := FComDoc.Get_AttachedTemplate.AutoTextEntries; end; procedure TWordDoc.SetBuiltInProperty(Index : TOleEnum; Const Value: Variant); //added by BDP 05/08/1999 amended by AH 26/11/99 var DocumentProperties : OLEVariant; DocumentProperty : OLEVariant; ovValue : OLEVariant; begin try ovValue := Value; DocumentProperties := FComDoc.BuiltInDocumentProperties; DocumentProperty := DocumentProperties.Item [Index]; DocumentProperty.Value := ovValue; except raise Exception.CreateFmt ('Error setting document property: "%d"', [Index]); end; end; function TWordDoc.GetBuiltInProperty(Index : TOleEnum) : Variant; //added by BDP 05/08/1999 amended by AH 26/11/99 var DocumentProperties : OLEVariant; DocumentProperty : OLEVariant; begin try DocumentProperties := FComDoc.BuiltInDocumentProperties; DocumentProperty := DocumentProperties.Item [Index]; Result := DocumentProperty.Value; except raise Exception.CreateFmt ('Error getting document property: "%d"', [Index]); end; end; procedure TWordDoc.SetCustomProperty(Index : String; Const Value : Variant); //added by BDP 05/08/1999 amended by AH, bug fix 7/2/00 var CustomProperties : OLEVariant; CustomProperty : OLEVariant; ovValue : OLEVariant; begin try CustomProperties := FComDoc.CustomDocumentProperties; CustomProperty := CustomProperties.Item [Index]; ovValue := Value; CustomProperty.Value := ovValue; except raise Exception.CreateFmt ('Error setting custom property: "%s"', [Index]); end; end; function TWordDoc.GetCustomProperty(Index : String) : Variant; //added by BDP 05/08/1999 var CustomProperties : OLEVariant; CustomProperty : OLEVariant; begin try CustomProperties := FComDoc.CustomDocumentProperties; CustomProperty := CustomProperties.Item [Index]; Result := CustomProperty.Value; except raise Exception.CreateFmt ('Error getting custom property: "%s"', [Index]); end; end; procedure TWordDoc.AddCustomProperty(Index: String; Value : Variant; oePropertyType : TOleEnum); var CustomProperties : OLEVariant; ovValue : OLEVariant; begin try CustomProperties := FComDoc.CustomDocumentProperties; ovValue := Value; CustomProperties.Add(Index, wdFalse, oePropertyType, ovValue); except raise Exception.CreateFmt ('Error creating custom property: "%s"', [Index]); end; end; procedure TWordDoc.AddCustomProperty(Index: String; Value : String); begin AddCustomProperty (Index, Value, msoPropertyTypeString); end; procedure TWordDoc.AddCustomProperty(Index: String; Value : Integer); begin AddCustomProperty (Index, Value, msoPropertyTypeNumber); end; procedure TWordDoc.AddCustomProperty(Index: String; Value : Double); begin AddCustomProperty (Index, Value, msoPropertyTypeFloat); end; procedure TWordDoc.AddCustomProperty(Index: String; Value : TDateTime); begin AddCustomProperty (Index, Value, msoPropertyTypeDate); end; procedure TWordDoc.AddCustomProperty(Index: String; Value : Boolean); begin AddCustomProperty (Index, Value, msoPropertyTypeBoolean); end; procedure TWordDoc.DeleteCustomProperty(Index: String); var CustomProperties : OLEVariant; CustomProperty : OLEVariant; begin try CustomProperties := FComDoc.CustomDocumentProperties; CustomProperty := CustomProperties.Item [Index]; if not VarIsNull (CustomProperty) then CustomProperty.Delete; except raise Exception.CreateFmt ('Error deleting custom property: "%s"', [Index]); end; end; { TWordRange } procedure TWordRange.Collapse(oeDirection: TOleEnum = wdCollapseStart); var ovDirection : OleVariant; begin ovDirection := oeDirection; FComRange.Collapse (ovDirection); end; constructor TWordRange.CreateFromBookMark(WordDoc: TWordDoc; BookmarkName: String); var ovBookMarkName : OleVariant; begin Create; FItemIndex := -1; ovBookMarkName := BookMarkName; FWordDoc := WordDoc; try FComRange := FWordDoc.FComDoc.Bookmarks.Item (ovBookMarkName).Range; FItemIndex := FWordDoc.NoOfRanges; FWordDoc.FRanges.Add (self); except FComRange := nil; raise Exception.CreateFmt ('Bookmark "%s" not found in document "%s"', [BookMarkName, FWordDoc.FComDoc.Name]); // NB raising an exception here will cause TWordRange.Destroy to be called // The exception will be from trying to get an invalid bookmark // ie before ItemIndex is given a valid number, hence preset to -1 // TWordRange.Destroy will only try to remove the range from the TWordDoc list // if ItemIndex <> -1 end end; constructor TWordRange.CreateFromSelection(WordDoc : TWordDoc); begin Create; FItemIndex := -1; FWordDoc := WordDoc; FComRange := FWordDoc.WordApp.Application.Selection.Range; FItemIndex := FWordDoc.NoOfRanges; FWordDoc.FRanges.Add (self); end; constructor TWordRange.CreateFromDoc(WordDoc : TWordDoc; iStart : Integer = 1; iEnd : Integer = 1); var ovStart, ovEnd : OleVariant; begin Create; FItemIndex := -1; ovStart := iStart; ovEnd := iEnd; FWordDoc := WordDoc; FComRange := FWordDoc.FComDoc.Range (ovStart, ovEnd); FItemIndex := FWordDoc.NoOfRanges; FWordDoc.FRanges.Add (self); end; constructor TWordRange.CreateFromRange(WordDoc : TWordDoc; ComRange : {$IFDEF USE_WORD2K} Word2000.Range {$ELSE} Word97.Range {$ENDIF}); begin Create; FItemIndex := -1; FWordDoc := WordDoc; FComRange := ComRange; FItemIndex := FWordDoc.NoOfRanges; FWordDoc.FRanges.Add (self); end; destructor TWordRange.Destroy; begin if FItemIndex <> -1 then FWordDoc.RemoveRange (FItemIndex); inherited; end; function TWordRange.EndOf(oeUnit : TOleEnum = wdWord; oeExtend : TOleEnum = wdMove) : Integer; var ovUnit, ovExtend : OleVariant; begin ovUnit := oeUnit; ovExtend := oeExtend; EndOf := FComRange.EndOf (ovUnit, ovExtend); end; function TWordRange.Expand(oeUnit: TOleEnum = wdWord) : Integer; var ovUnit : OleVariant; begin ovUnit := oeUnit; Expand := FComRange.Expand (ovUnit); end; function TWordRange.GetBold: Boolean; begin GetBold := FComRange.Bold = wdTrue; end; function TWordRange.GetCase: TOleEnum; begin GetCase := FComRange.Case_ end; function TWordRange.GetEnd: Integer; begin GetEnd := FComRange.End_; end; function TWordRange.GetFont: _Font; begin GetFont := FComRange.Font; end; function TWordRange.GetItalic: Boolean; begin GetItalic := FComRange.Italic = wdTrue end; function TWordRange.GetStart: Integer; begin GetStart := FComRange.Start; end; function TWordRange.GetStyle: Variant; begin GetStyle := FComRange.Get_Style; end; function TWordRange.GetText: String; begin GetText := FComRange.Text; end; function TWordRange.GetUnderline: Boolean; begin GetUnderline := FComRange.Underline = wdTrue end; function TWordRange.GoTo_(oeWhat, oeWhich: TOleEnum; oeCount: Integer = 1; oeName: String = '') : {$IFDEF USE_WORD2K} Word2000.Range {$ELSE} Word97.Range {$ENDIF}; var ovWhat, ovWhich, ovCount, ovName : OleVariant; begin ovWhat := oeWhat; ovWhich := oeWhich; ovCount := oeCount; if oeName = '' then ovName := EmptyParam else ovName := oeName; FComRange := FComRange.GoTo_ (ovWhat, ovWhich, ovCount, ovName); Goto_ := FComRange; end; function TWordRange.GotoBookmark(BookmarkName : string) : {$IFDEF USE_WORD2K} Word2000.Range {$ELSE} Word97.Range {$ENDIF}; var What : OLEVariant; Which : OLEVariant; Count : OLEVariant; Name : OLEVariant; begin What := wdGoToBookmark; Which := EmptyParam; Count := EmptyParam; Name := BookmarkName; try FComRange := FComRange.GoTo_(What, Which, Count, Name); except FComRange := nil; raise Exception.CreateFmt ('Bookmark "%s" not found in document "%s"', [BookMarkName, FWordDoc.FComDoc.Name]); end; GotoBookmark := FComRange; end; function TWordRange.GoToNext(oeWhat: TOleEnum) : {$IFDEF USE_WORD2K} Word2000.Range {$ELSE} Word97.Range {$ENDIF}; // moves range to next var ovWhat : OleVariant; begin ovWhat := oeWhat; FComRange := FComRange.GoToNext (ovWhat); GotoNext := FComRange; end; function TWordRange.GoToPrevious(oeWhat: TOleEnum) : {$IFDEF USE_WORD2K} Word2000.Range {$ELSE} Word97.Range {$ENDIF}; // moves range to previous var ovWhat : OleVariant; begin ovWhat := oeWhat; FComRange := FComRange.GoToPrevious (ovWhat); GotoPrevious := FComRange; end; function TWordRange.NoOfWords : Integer; begin NoOfWords := FComRange.ComputeStatistics (wdStatisticWords) end; procedure TWordRange.InsertAfter(Text: String); begin FComRange.InsertAfter (Text); end; procedure TWordRange.InsertAutoText; begin FComRange.InsertAutoText end; procedure TWordRange.InsertGivenAutoText (AutoText : String; UseRichText : Boolean = True); var ATemplate : OleVariant; AnAutoText : OleVariant; begin // NB Word_TLB import seems to fail with Get_AttachedTemplate and returns an OleVariant // rather than a Template type. Therefor this bit of code is late bound and may not work in // other languages - sorry try ATemplate := FWordDoc.FComDoc.Get_AttachedTemplate; AnAutoText := ATemplate.AutoTextEntries.Item (AutoText); AnAutoText.Insert (FComRange, UseRichText); except on E : EOleSysError do if E.ErrorCode = 5941 then raise Exception.CreateFmt ('Error Autotext "%s" not found in template "%s"', [AutoText, ATemplate.Name]) else raise Exception.CreateFmt ('Error inserting Autotext "%s" from template "%s"', [AutoText, ATemplate.Name]) end; end; procedure TWordRange.InsertBefore(Text: String); begin FComRange.InsertBefore (Text); end; procedure TWordRange.InsertBreak(oeType: TOleEnum = wdPageBreak); var ovType : OleVariant; begin ovType := oeType; FComRange.InsertBreak (ovType); end; procedure TWordRange.InsertParagraph; begin FComRange.InsertParagraph end; procedure TWordRange.InsertParagraphAfter; begin FComRange.InsertParagraphAfter end; procedure TWordRange.InsertParagraphBefore; begin FComRange.InsertParagraphBefore end; procedure TWordRange.InsertSymbol(CharacterNumber: Integer; Font: String; Unicode: Boolean = False; oeBias : TOleEnum = wdFontBiasDefault); var ovFont, ovUnicode, ovBias : OleVariant; begin ovFont := Font; ovUnicode := UniCode; ovBias := oeBias; FComRange.InsertSymbol (CharacterNumber, ovFont, ovUnicode, ovBias); end; function TWordRange.Move(oeUnit: TOleEnum = wdCharacter; oeCount: Integer = 1) : Integer; var ovUnit, ovCount : OleVariant; begin ovUnit := oeUnit; ovCount := oeCount; Move := FComRange.Move (ovUnit, ovCount); end; function TWordRange.MoveEnd(oeUnit: TOleEnum = wdCharacter; oeCount: Integer = 1) : Integer; var ovUnit, ovCount : OleVariant; begin ovUnit := oeUnit; ovCount := oeCount; MoveEnd := FComRange.MoveEnd (ovUnit, ovCount); end; function TWordRange.MoveEndUntil(Cset: String; Count: Integer = wdForward) : Integer; var ovCset, ovCount : OleVariant; begin ovCset := Cset; ovCount := Count; MoveEndUntil := FComRange.MoveEndUntil (ovCset, ovCount); end; function TWordRange.MoveEndWhile(Cset: String; Count: Integer = wdForward) : Integer; var ovCset, ovCount : OleVariant; begin ovCset := Cset; ovCount := Count; MoveEndWhile := FComRange.MoveEndWhile (ovCset, ovCount); end; function TWordRange.MoveStart(oeUnit: TOleEnum = wdCharacter; oeCount: Integer = 1) : Integer; var ovUnit, ovCount : OleVariant; begin ovUnit := oeUnit; ovCount := oeCount; MoveStart := FComRange.MoveStart (ovUnit, ovCount); end; function TWordRange.MoveStartUntil(Cset: String; Count: Integer = wdForward) : Integer; var ovCset, ovCount : OleVariant; begin ovCset := Cset; ovCount := Count; MoveStartUntil := FComRange.MoveStartUntil (ovCset, ovCount); end; function TWordRange.MoveStartWhile(Cset: String; Count: Integer = wdForward) : Integer; var ovCset, ovCount : OleVariant; begin ovCset := Cset; ovCount := Count; MoveStartWhile := FComRange.MoveStartWhile (ovCset, ovCount); end; function TWordRange.MoveUntil(Cset: String; Count: Integer = wdForward) : Integer; var ovCset, ovCount : OleVariant; begin ovCset := Cset; ovCount := Count; MoveUntil := FComRange.MoveUntil (ovCset, ovCount); end; function TWordRange.MoveWhile(Cset: String; Count: Integer = wdForward) : Integer; var ovCset, ovCount : OleVariant; begin ovCset := Cset; ovCount := Count; MoveWhile := FComRange.MoveWhile (ovCset, ovCount); end; function TWordRange.Next(oeUnit: TOleEnum = wdCharacter; oeCount: Integer = 1) : {$IFDEF USE_WORD2K} Word2000.Range {$ELSE} Word97.Range {$ENDIF}; // moves range to next var ovUnit, ovCount : OleVariant; begin ovUnit := oeUnit; ovCount := oeCount; FComRange := FComRange.Next (ovUnit, ovCount); Next := FComRange; end; function TWordRange.Previous(oeUnit: TOleEnum = wdCharacter; oeCount: Integer = 1) : {$IFDEF USE_WORD2K} Word2000.Range {$ELSE} Word97.Range {$ENDIF}; // moves range to previous var ovUnit, ovCount : OleVariant; begin ovUnit := oeUnit; ovCount := oeCount; FComRange := FComRange.Previous (ovUnit, ovCount); Previous := FComRange; end; function TWordRange.GetNextRange(oeUnit: TOleEnum = wdCharacter; oeCount: Integer = 1) : {$IFDEF USE_WORD2K} Word2000.Range {$ELSE} Word97.Range {$ENDIF}; // returns a range next to this one (does not alter this range) var ovUnit, ovCount : OleVariant; begin ovUnit := oeUnit; ovCount := oeCount; GetNextRange := FComRange.Next (ovUnit, ovCount); end; function TWordRange.GetPreviousRange(oeUnit: TOleEnum = wdCharacter; oeCount: Integer = 1) : {$IFDEF USE_WORD2K} Word2000.Range {$ELSE} Word97.Range {$ENDIF}; // returns a range prior to this one (does not alter this range) var ovUnit, ovCount : OleVariant; begin ovUnit := oeUnit; ovCount := oeCount; GetPreviousRange := FComRange.Previous (ovUnit, ovCount); end; procedure TWordRange.SetBold(Value: Boolean); begin if Value then FComRange.Bold := wdTrue else FComRange.Bold := wdFalse; end; procedure TWordRange.SetCase(oeValue: TOleEnum); begin FComRange.Case_ := oeValue; end; procedure TWordRange.SetEnd(Value: Integer); begin FComRange.End_ := Value; end; procedure TWordRange.SetFont(fFont: _Font); begin FComRange.Font := fFont; end; procedure TWordRange.SetItalic(Value: Boolean); begin if Value then FComRange.Italic := wdTrue else FComRange.Italic := wdFalse; end; procedure TWordRange.SetRange(iStart, iEnd: Integer); begin FComRange.SetRange (iStart, iEnd); end; procedure TWordRange.SetStart(Value: Integer); begin FComRange.Start := Value; end; procedure TWordRange.SetStyle(Style: Variant); var ovStyle : OleVariant; begin ovStyle := Style; FComRange.Set_Style (ovStyle); end; procedure TWordRange.SetText(Value: String); begin FComRange.Text := Value; end; procedure TWordRange.SetUnderline(Value: Boolean); begin if Value then FComRange.Underline := wdTrue else FComRange.Underline := wdFalse; end; function TWordRange.StartOf(oeUnit : TOleEnum = wdWord; oeExtend : TOleEnum = wdMove): Integer; var ovUnit, ovExtend : OleVariant; begin ovUnit := oeUnit; ovExtend := oeExtend; StartOf := FComRange.StartOf (ovUnit, ovExtend); end; procedure TWordRange.CreateBookMark(BookmarkName : String); var ovRange : OleVariant; begin ovRange := FComRange; FWordDoc.FComDoc.Bookmarks.Add (BookmarkName, ovRange); end; procedure TWordRange.Select; begin FComRange.Select; end; procedure TWordRange.Cut; begin FComRange.Cut; end; procedure TWordRange.Copy; begin FComRange.Copy; end; procedure TWordRange.Paste; begin FComRange.Paste; end; function ImprimirDoc(Fichero : String) : Boolean; var FWordApp : TWordApp; FWordDoc : TWordDoc; Dialogo : Dialog; begin Result := False; FWordApp := TWordApp.Create(False, True); try FWordDoc := TWordDoc.CreateOpenDoc(FWordApp, Fichero); FWordApp.Visible := True; FWordDoc.Active := True; FWordApp.Application.Options.PrintBackground := False; Dialogo := FWordApp.Application.Dialogs.Item(wdDialogFilePrint); Dialogo.Show(EmptyParam); // Esperamos a que Word termine de imprimir antes de cerrarlo. while FWordApp.Application.BackgroundPrintingStatus = 1 do; FWordDoc.CloseDoc(wdDoNotSaveChanges); FWordDoc := NIL; finally FWordApp.CloseApp (wdDoNotSaveChanges); FWordApp := NIL; end; Result := True; end; end.