当前位置：文档库 › Delphi 中调用word

Delphi 中调用word

Delphi 中调用word
作为开发人员,对数据库保存为word文档，可能一时头疼，现在我将其封装为一个组件，可以在delphi中调用

{***************** WordObject ******************}

unit MyWord;

interface

uses
Windows, Classes, ActiveX, Wordxp;

type
_Alignment=(ALLeft,ALRight,ALCenter);
_Direction=(DrLeft,DrRight);
TWordEventSink = class(TInterfacedObject, IUnknown, IDispatch)

private
FOwner : TObject;
FAppDispatch: IDispatch;
FDocDispatch: IDispatch;
FAppDispIntfIID: TGUID;
FDocDispIntfIID: TGUID;
FAppConnection: Integer;
FDocConnection: Integer;
FOnQuit : TNotifyEvent;
FOnDocumentChange : TNotifyEvent;
FOnNewDocument : TNotifyEvent;
FOnOpenDocument : TNotifyEvent;
FOnCloseDocument : TNotifyEvent;
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(AnOwner: TObject; AnAppDispatch: IDispatch; const AnAppDispIntfIID, ADocDispIntfIID: TGUID);
destructor Destroy; override;
property OnQuit : TNotifyEvent read FOnQuit write FOnQuit;
property OnDocumentChange : TNotifyEvent read FOnDocumentChange write FOnDocumentChange;
property OnNewDocument : TNotifyEvent read FOnNewDocument write FOnNewDocument;
property OnOpenDocument : TNotifyEvent read FOnOpenDocument write FOnOpenDocument;
property OnCloseDocument : TNotifyEvent read FOnCloseDocument write FOnCloseDocument;
end;

TWordObject = class
private
UnAssigned:Variant;
FWordApp : _Application;
FEventSink : TWordEventSink;
function GetCaption : String;
procedure SetCaption(Value : String);
function GetVisible : Boolean;
procedure SetVisible(Value : Boolean);
function GetOnQuit : TNotifyEvent;
procedure SetOnQuit(Value : TNotifyEvent);
function GetOnDocumentChange : TNotifyEvent;
procedure SetOnDocumentChange(Value : TNotifyEvent);
function GetOnNewDocument: TNotifyEvent;
procedure SetOnNewDocument(Value : TNotifyEvent);
function GetOnOpenDocument: TNotifyEvent;
procedure SetOnOpenDocument(Value : TNotifyEvent);
function GetOnCloseDocument: TNotifyEvent;
procedure SetOnCloseDocument(Value : TNotifyEvent);
public
constructor Create;
destructor Destroy; override;
procedure NewDoc(Template : String);
p

rocedure CloseDoc;
procedure InsertText(Text : String);
Procedure TypeParagraph;
Procedure AddTable(Rows:Integer;Columns:Integer);
Procedure MoveRight(Count:Olevariant);
Procedure MoveLeft(Count:OleVariant);
Procedure SelectText(Count:OleVariant;Dir:_Direction);
Procedure SetAlign(AlignMode:_Alignment);
Procedure SetFont(FontName:String;Size:Integer);
procedure Print;
procedure SaveAs(Filename : String);
published
property Application : _Application read FWordApp;
property Caption : String read GetCaption write SetCaption;
property Visible : Boolean read GetVisible write SetVisible;
property OnQuit : TNotifyEvent read GetOnQuit write SetOnQuit;
property OnDocumentChange : TNotifyEvent read GetOnDocumentChange write SetOnDocumentChange;
property OnNewDocument : TNotifyEvent read GetOnNewDocument write SetOnNewDocument;
property OnOpenDocument : TNotifyEvent read GetOnOpenDocument write SetOnOpenDocument;
property OnCloseDocument : TNotifyEvent read GetOnCloseDocument write SetOnCloseDocument;
end;

implementation

uses
ComObj;

{ TWordEventSink implementation }

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

FOwner := AnOwner;
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
case DispID of
2 : if Assigned(FOnQuit) then
FOnQuit(FOwner);
3 : begin
if Assigned(FOnDocumentChange) then
FOnDocumentChange(FOwner);
// 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
FDocDispatch := _Application(FAppDispatch).ActiveDocument;
InterfaceConnect(FDocDispatch,FDocDispIntfIID,Self,FDocConnection);
except;
end;
end;
4 : if Assigned(FOnNewDocument) then
FOnNewDocument(FOwner);
5 : if Assigned(FOnOpenDocument) then
FOnOpenDocument(FOwner);
6 : if Assigned(FOnCloseDocument) then
FOnCloseDocument(FOwner);
end;

Result := S_OK;
end;

{ TWordObject implementation }

constructor TWordObject.Create;
begin
// Fire off Word97 and create the event sink
//FWordApp := CoWordApplication.Create;
CoInitialize(nil);
FWordApp := CoWordApplication.Create;
FEventSink := TWordEventSink.Create(Self,FWordApp,ApplicationEvents,DocumentEvents);
end;

destructor TWordObject.Destroy;
var
SaveChanges,
OriginalFormat,
RouteDocument : OleVariant;
begin
SaveChanges := WdDoNotSaveChanges;
OriginalFormat := UnAssigned;
RouteDocument := UnAssigned;
try
FWordApp.Quit(SaveChanges,OriginalFormat,RouteDocument);
except
end;
FEventSink := nil;
inherited Destroy;
end;

function TWordObject.GetVisible : Boolean;
begin
Result := FWordApp.Visible;
end;

procedure TWordObject.SetCaption(Value : String);
begin
FWordApp.Caption := Value;
end;

function TWordObject.GetCaption : String;
begin
Result := FWordApp.Caption;
end;

procedure TWordObject.SetVisible(Value : Boolean);
begin
FWordApp.Visible := Value;
end;

function TWordObject.GetOnQuit : TNotifyEvent;
begin
Result := FEventSink.OnQuit;
end;

procedure TWordObject.SetOnQuit(Value : TNotifyEvent);
begin
FEventSink.OnQuit := Value;
end;

function TWordObject.GetOnDocumentChange : TNotifyEvent;
begin
Result := FEventSink.OnDocumentChange;
end;

procedure TWordObject.SetOnDocumentChange(Value : TNotifyEvent);
begin
FEventSink.OnDocumentChange := Value;
end;

function TWordObject.GetOnNewDocument : TNotifyEvent;
begin
Result := FEventSink.OnNewDocument;
end;

procedure TWordObject.SetOnNewDocument(Value : TNotifyEvent);
begin
FEventSink.OnNewDocument := Value;
end;

function TWordObject.GetOnOpenDocument : TNotifyEvent;
begin
Result := FEventSink.OnOpenDocument;
end;

procedure TWordObject.SetOnOpenDocument(Value

: TNotifyEvent);
begin
FEventSink.OnOpenDocument := Value;
end;

function TWordObject.GetOnCloseDocument : TNotifyEvent;
begin
Result := FEventSink.OnCloseDocument;
end;

procedure TWordObject.SetOnCloseDocument(Value : TNotifyEvent);
begin
FEventSink.OnCloseDocument := Value;
end;

procedure TWordObject.InsertText(Text : String);
begin
FWordApp.Selection.TypeText(Text);
end;
Procedure TWordObject.TypeParagraph;
begin
FWordApp.Selection.TypeParagraph;
end;
Procedure TWordObject.AddTable(Rows:Integer;Columns:Integer);
var
DefaultTableBehavior,
AutoFitBehavior: OleVariant;
begin
DefaultTableBehavior := wdWord9TableBehavior;
AutoFitBehavior := wdAutoFitFixed;
FWordApp.ActiveDocument.Tables.Add(FWordApp.Selection.Range,Rows,Columns,DefaultTableBehavior,AutoFitBehavior);
end;
Procedure TWordObject.MoveRight(Count:OLeVariant);
var
Unit_,Extend_:OleVariant;
begin
Unit_ :=wdCharacter;
FWordApp.Selection.MoveRight(Unit_,Count,Extend_);
end;
Procedure TWordObject.MoveLeft(Count:OLeVariant);
var
Unit_,Extend_:OleVariant;
begin
Unit_ :=wdCharacter;
FWordApp.Selection.MoveLeft(Unit_,Count,Extend_);
end;
Procedure TWordObject.SelectText(Count:OleVariant;Dir:_Direction);
var
Unit_,Extend_:OleVariant;
begin
Unit_:=wdCharacter; Extend_:=wdExtend;
if Dir=DrLeft then
FWordApp.Selection.MoveLeft(Unit_,Count,Extend_);
if Dir=DrRight then
FWordApp.Selection.MoveRight(Unit_,Count,Extend_);
end;
Procedure TWordObject.SetAlign(AlignMode:_Alignment);
begin
if AlignMode=ALLeft then FWordApp.Selection.ParagraphFormat.Alignment := wdAlignParagraphLeft;
if AlignMode=ALRight then FWordApp.Selection.ParagraphFormat.Alignment := wdAlignParagraphRight;
if AlignMode=ALCenter then FWordApp.Selection.ParagraphFormat.Alignment := wdAlignParagraphCenter;
end;
Procedure TWordObject.SetFont(FontName:String;Size:Integer);
begin
https://www.wendangku.net/doc/5a14508029.html, := FontName;
FWordapp.Selection.Font.Size := Size;
end;
procedure TWordObject.NewDoc(Template : String);
var
DocTemplate,
NewTemplate,
DocumentType,
Visible: OleVariant;
begin
DocTemplate := Template;
NewTemplate := False;
DocumentType := wdNewBlankDocument;
Visible := True;
FWordApp.Documents.Add(DocTemplate,NewTemplate,DocumentType,Visible);
end;

procedure TWordObject.CloseDoc;
var
SaveChanges,
OriginalFormat,
RouteDocument : OleVariant;
begin
SaveChanges := WdDoNotSaveChanges;
OriginalFormat := UnAssigned;
RouteDocument := UnAssigned;
FWordApp.ActiveDocument.Close(SaveChanges,OriginalFormat,RouteDocument);
end;

procedure TWordObject.Print;
begin
OleVariant(FWordApp).PrintOut;
end;

procedure TWordObject.SaveAs(Filename : String);
begin
OleVariant(FWordApp).ActiveDocument.SaveAs(FileName);
end;

end.

以下是一个应用的例子

var
WordObj : TWordObject;
I : integer;
begin
//将查询结

果保存到word文档

FrmHint:=TFrmHint.Create(Application);
FrmHint.lblHint.Caption:='正在导入WORD,请稍候...';
FrmHint.Color:=$00DFFDFA;
FrmHint.Show;
FrmHint.Update;

//启动 Word
try
WordObj := TWordObject.Create;
WordObj.Caption := '关键词信息查询结果';
WordObj.Visible := False;
except
MessageBox('启动WORD出错！',mtError,btOK);
Exit;
end;

//新建文档
try
WordObj.NewDoc('');
except
MessageBox('创建文档出错！',mtError,btOK);
Exit;
end;
WordObj.InsertText('关键词查询结果'); //向文档中发送文本
WordObj.SelectText(7,DrLeft); //选中文本
WordObj.SetAlign(ALCenter); //把选中的文本居中
WordObj.SetFont('宋体',15); //设定字体

WordObj.MoveRight(1); //向右移动一格，目的是为了取消选中状态
WordObj.SetFont('宋体',10); //设定字体
WordObj.TypeParagraph; //回车换行

WordObj.AddTable(FrmKeyWordMsgQry.grdKeywordMsg.DataSource.DataSet.RecordCount+1,FrmKeyWordMsgQry.grdKeywordMsg.Columns.Count); // 画表

//写表头
for I:=0 to FrmKeyWordMsgQry.grdKeywordMsg.Columns.Count-1 do
begin
WordObj.InsertText(FrmKeyWordMsgQry.grdKeywordMsg.Columns[I].Title.Caption); //向文档中发送文本
WordObj.MoveRight(1); //向右移动一格
end;

//写数据
FrmKeyWordMsgQry.grdKeywordMsg.DataSource.DataSet.First;
while not FrmKeyWordMsgQry.grdKeywordMsg.DataSource.DataSet.Eof do
begin
for I:=0 to FrmKeyWordMsgQry.grdKeywordMsg.Columns.Count-1 do
begin
WordObj.InsertText(FrmKeyWordMsgQry.grdKeywordMsg.Columns[I].Field.Text);
WordObj.MoveRight(1);
end;
FrmKeyWordMsgQry.grdKeywordMsg.DataSource.DataSet.Next;
end;

WordObj.Visible := True;
FrmHint.Hide;
FrmHint.Free;
end;