Tecistel/Tecsitel_FactuGES2
0
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
6f41f4ecfb
Tecsitel_FactuGES2/Source/Servidor/Utiles/AHWord97.pas

2218 lines
70 KiB
ObjectPascal
Raw Blame History

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.
Reference in New Issue View Git Blame Copy Permalink