Delphi＋Word解决方案参考 (转)

Delphi＋Word解决方案参考 (转)[@more@] 

Delphi＋word解决方案参考XML:namespace prefix = o ns = "urn:schemas-microsoft-com:Office:office" />

这是我做项目过程中自己做的几个函数，见到大家都在问Word的问题。现在拿出来和大家共享。（希望有朋友可以进一步添加新的功能，或者做成包或者lib等，更方便大家使用。我自己是没有时间啦，呵呵）

使用前，先根据需要建立一个空的WORD文件作为模板，在模板文件中设置好各种格式和文本。另外，其中的PrnWordTable的参数是TdbGrideh类型的控件，取自Ehlib2.6

其中用到的shFileCopy函数（用于复制文件）和guiInfo函数（用于显示消息框）也是自己编写的，代码也附后。

 

示范代码如下：

 

代码完成的功能：

1.  替换打印模板中的“#TITLE#”文本为“示范代码1”

2.  并且将DBGridEh1控件当前显示的内容插入到文档的末尾

3.  在文档末尾插入一个空行

4.  在文档末尾插入新的一行文本

5.  将文档中的空行去掉

 

  if PrnWordBegin('C:打印模板.DOC','C:目标文件1.DOC') then

  begin

  PrnWordReplace('#TITLE#','示范代码1');

  PrnWordTable(DBGridEh1);

  PrnWordInsert('');

  PrnWordInsert('这是新的一行文本');

  PrnWordReplace('^p^p','^p',true);

  PrnWordSave;

  end;

 

源代码如下：

 

//Word打印（声明部分）

 

  wDoc,wapp:Variant;

  function PrnWordBegin(tempDoc,docName:String):boolean;

  function PrnWordReplace(docText,newText:String;bSimpleReplace:boolean=false):boolean;

  function PrnWordInsert(l.NEText:String;bNewLine:boolean=true):boolean;overload;

  function PrnWordInsert(var imgInsert:TImage;sBookMark:String=''):boolean;overload;

  function PrnWordInsert(var chartInsert:TChart;sBookMark:String=''):boolean;overload;

  function PrnWordTable(var dbG:TDBGridEh;sBookMark:String=''):boolean;

  procedure PrnWordSave;

  procedure PrnWordEnd;

 

//Word打印（实现部分）

 

{

功能：基于模板文件tempDoc新建目标文件docName并打开文件

}

function PrnWordBegin(tempDoc,docName:String):boolean;

begin

  result:=false;

  //复制模版

  if tempDoc<>'' then

  if not shFileCopy(tempDoc,docName) then exit;

  //连接Word

  try

  wApp:=CreateOleobject('Word.Application');

  except

  guiInfo('请先安装 Microsoft Word 。');

  exit;

  end;

  try

  //打开

  if tempDoc='' then

  begin

  //创建新文档

  wDoc:=wApp.Document.Add;

  wDoc.SaveAs(docName);

  end else begin

  //打开模版

  wDoc:=wApp.Documents.Open(docName);

  end;

  except

  guiInfo('打开模版失败，请检查模版是否正确。');

  wApp.Quit;

  exit;

  end;

  wApp.Visible:=true;

  result:=true;

end;

 

{

功能：使用newText替换docText内容

bSimpleReplace：true时仅做简单的替换，false时对新文本进行换行处理

}

function PrnWordReplace(docText,newText:String;bSimpleReplace:boolean=false):boolean;

var i:Integer;

begin

  if bSimpleReplace then

  begin

  //简单处理，直接执行替换操作

  try

  wApp.selection.Find.ClearFormatting;

  wApp.Selection.Find.Replacement.ClearFormatting;

  wApp.Selection.Find.Text := docText;

  wApp.Selection.Find.Replacement.Text :=newText;

  wApp.Selection.Find.Forward := True;

  wApp.Selection.Find.Wrap := wdFindContinue;

  wApp.Selection.Find.Format := False;

  wApp.Selection.Find.MatchCase := False;

  wApp.Selection.Find.MatchWholeWord := true;

  wApp.Selection.Find.MatchByte := True;

  wApp.Selection.Find.MatchWildcards := False;

  wApp.Selection.Find.MatchSoundsLike := False;

  wApp.Selection.Find.MatchAllWordForms := False;

  wApp.Selection.Find.Execute(Replace:=wdReplaceAll);

  result:=true;

  except

  result:=false;

  end;

  exit;

  end;

  //自动分行

  reWord.Lines.Clear;

  reWord.Lines.Add(newText);

  try

  //定位到要替换的位置的后面

  wApp.Selection.Find.ClearFormatting;

  wApp.Selection.Find.Text := docText;

  wApp.Selection.Find.Replacement.Text := '';

  wApp.Selection.Find.Forward := True;

  wApp.Selection.Find.Wrap := wdFindContinue;

  wApp.Selection.Find.Format := False;

  wApp.Selection.Find.MatchCase := False;

  wApp.Selection.Find.MatchWholeWord := False;

  wApp.Selection.Find.MatchByte := True;

  wApp.Selection.Find.MatchWildcards := False;

  wApp.Selection.Find.MatchSoundsLike := False;

  wApp.Selection.Find.MatchAllWordForms := False;

  wApp.Selection.Find.Execute;

  wApp.Selection.MoveRight(wdCharacter,1);

  //开始逐行插入

  for i:=0 to reWord.Lines.Count-1 Do

  begin

  //插入当前行

  wApp.Selection.InsertAfter(reWord.Lines[i]);

  //除最后一行外，自动加入新行

  if i

  wApp.Selection.InsertAfter(#13);

  end;

  //删除替换位标

  wApp.Selection.Find.ClearFormatting;

  wApp.Selection.Find.Replacement.ClearFormatting;

  wApp.Selection.Find.Text := docText;

  wApp.Selection.Find.Replacement.Text := '';

  wApp.Selection.Find.Forward := True;

  wApp.Selection.Find.Wrap := wdFindContinue;

  wApp.Selection.Find.Format := False;

  wApp.Selection.Find.MatchCase := False;

  wApp.Selection.Find.MatchWholeWord := true;

  wApp.Selection.Find.MatchByte := True;

  wApp.Selection.Find.MatchWildcards := False;

  wApp.Selection.Find.MatchSoundsLike := False;

  wApp.Selection.Find.MatchAllWordForms := False;

  wApp.Selection.Find.Execute(Replace:=wdReplaceAll);

  result:=true;

  except

  result:=false;

  end;

end;

 

{

功能：打印TDBGridEh当前显示的内容

基于TDBGridEh控件的格式和内容，自动在文档中的sBookMark书签处生成Word表格

目前能够支持单元格对齐、多行标题（两行）、底部合计等特性

sBookMark：Word中要插入表格的书签名称

}

function PrnWordTable(var dbG:TDBGridEh;sBookMark:String=''):boolean;

var iCol,iLine,i,j,k:Integer;

  wTable,wRange:Variant;

   iRangeEnd:longint;

  iGridLine,iTitleLine:Integer;

  getTextText:String;getTextDisplay:boolean;

  titleList:TStringList;titleSplit,titleCol:Integer;lastTitleSplit,SubTitle:Integer;lastTitle:String;

begin

  result:=false;

  try

  //计算表格的列数（不包括隐藏的列）

  iTitleLine:=1;  //始终默认为1

  iCol:=0;

  for i:=0 to dbG.Columns.Count-1 Do

  begin

  if dbG.Columns[i].Visible then

  begin

  iCol:=iCol+1;

  end;

  end;

  //计算表格的行数（不包括隐藏的列）

  if dbG.Datasource.DataSet.Active then

  iLine:=dbG.DataSource.DataSet.RecordCount

  else

  iLine:=0;

  iGridLine:=iLine+iTitleLine+dbG.FooterRowCount;

  //定位插入点

  if sBookMark='' then

  begin

  //在文档末尾

  iRangeEnd:=wDoc.Range.End-1;

  if iRangeEnd<0 then iRangeEnd:=0;

   wRange:=wDoc.Range(iRangeEnd,iRangeEnd);

  end else begin

  //在书签处

  wRange:=wDoc.Range.Goto(wdGoToBookmark,,,sBookMark);

  end;

  wTable:=wDoc.Tables.Add(wRange,iGridLine,iCol);

  wTable.Columns.AutoFit;

  //标题行

  k:=1;

  for j:=1 to dbG.Columns.Count Do

  begin

  if dbG.Columns[j-1].Visible then

  begin

  if dbG.UseMultiTitle then

  begin

  titleList:=strSplit(dbG.Columns[j-1].Title.Caption,'|');

  wTable.Cell(1,k).Range.InsertAfter(titleList.Strings[0]);

  end else

  wTable.Cell(1,k).Range.InsertAfter(dbG.Columns[j-1].Title.Caption);

  //设置单元格对齐方式

  if dbG.Columns[j-1].Title.Alignment=taCenter then

  wTable.Cell(1,k).Range.ParagraphFormat.Alignment:=wdAlignParagraphCenter

  else if dbG.Columns[j-1].Title.Alignment=taRightJustify then

  wTable.Cell(1,k).Range.ParagraphFormat.Alignment:=wdAlignParagraphRight

  else if dbG.Columns[j-1].Title.Alignment=taLeftJustify then

  wTable.Cell(1,k).Range.ParagraphFormat.Alignment:=wdAlignParagraphJustify;

  k:=k+1;

  end;

  end;

  //填写每一行

  if iLine>0 then

  begin

  dbG.DataSource.dataset.DisableControls;

  dbG.DataSource.DataSet.First;

  for i:=1 to iLine Do

  begin

  k:=1;

  for j:=1 to dbG.Columns.Count Do

  begin

  if dbG.Columns[j-1].Visible then

   begin

  if dbG.Columns[j-1].FieldName<>'' then //避免由于空列而出错

  begin

  //如果该列有自己的格式化显示函数，则调用显示函数获取显示串

  getTextText:='';

  if Assigned(dbG.DataSource.DataSet.FieldByName(dbG.Columns[j-1].FieldName).OnGetText) then

  begin

  dbG.DataSource.DataSet.FieldByName(dbG.Columns[j-1].FieldName).OnGetText(dbG.DataSource.DataSet.FieldByName(dbG.Columns[j-1].FieldName),getTextText,getTextDisplay);

  wTable.Cell(i+iTitleLine,k).Range.InsertAfter(getTextText);

  end else begin

  //使用数据库内容显示

  wTable.Cell(i+iTitleLine,k).Range.InsertAfter(dbG.DataSource.DataSet.FieldByName(dbG.Columns[j-1].FieldName).AsString);

  end;

  end;

  //设置单元格对齐方式

  if dbG.Columns[j-1].Alignment=taCenter then

  wTable.Cell(i+iTitleLine,k).Range.ParagraphFormat.Alignment:=wdAlignParagraphCenter

  else if dbG.Columns[j-1].Alignment=taRightJustify then

  wTable.Cell(i+iTitleLine,k).Range.ParagraphFormat.Alignment:=wdAlignParagraphRight

  else if dbG.Columns[j-1].Alignment=taLeftJustify then

  wTable.Cell(i+iTitleLine,k).Range.ParagraphFormat.Alignment:=wdAlignParagraphJustify;

  k:=k+1;

  end;

  end;

  dbG.DataSource.DataSet.Next;

  end;

  end;

  //结尾行

  for i:=1 to dbG.FooterRowCount Do

  begin

  k:=1;

  for j:=1 to dbG.Columns.Count Do

  begin

  if dbG.Columns[j-1].Visible then

  begin

  wTable.Cell(iLine+1+i,k).Range.InsertAfter(dbG.GetFooterValue(i-1,dbG.Columns[j-1]));

  //设置单元格对齐方式

  if dbG.Columns[j-1].Footer.Alignment=taCenter then

  wTable.Cell(iLine+1+i,k).Range.ParagraphFormat.Alignment:=wdAlignParagraphCenter

  else if dbG.Columns[j-1].Footer.Alignment=taRightJustify then

  wTable.Cell(iLine+1+i,k).Range.ParagraphFormat.Alignment:=wdAlignParagraphRight

  else if dbG.Columns[j-1].Footer.Alignment=taLeftJustify then

  wTable.Cell(iLine+1+i,k).Range.ParagraphFormat.Alignment:=wdAlignParagraphJustify;

  k:=k+1;

  end;

  end;

  end;

  //处理多行标题

  if dbG.UseMultiTitle then

  begin

  //先分割单元格，再逐个填入第二行

  k:=1;

  titleCol:=1;

  lastTitleSplit:=1;

  SubTitle:=0;

  lastTitle:='';

  for j:=1 to dbG.Columns.Count Do

  begin

  if dbG.Columns[j-1].Visible then

  begin

  titleList:=strSplit(dbG.Columns[j-1].Title.Caption,'|');

  if titleList.Count>1 then

  begin

  //处理第二行以上的内容

  wTable.Cell(1,k-SubTitle).Range.Cells.Split(titleList.Count,1,false);

   for titleSplit:=1 to titleList.Count-1 Do

  begin

  wTable.Cell(titleSplit+1,titleCol).Range.InsertAfter(titleList.Strings[titleSplit]);

  end;

  titleCol:=titleCol+1;

  //处理第一行合并

  if (lastTitleSplit=titleList.Count) and (lastTitle=titleList.Strings[0]) then

  begin

  //内容相同时，合并单元格

  wTable.Cell(1,k-SubTitle).Range.Copy;

  wRange:=wDoc.Range(wTable.Cell(1,k-SubTitle-1).Range.Start,wTable.Cell(1,k-SubTitle).Range.End);

  wRange.Cells.Merge;

  wRange.Paste;

  SubTitle:=SubTitle+1;

  end;

  end;

  lastTitle:=titleList.Strings[0];

  lastTitleSplit:=titleList.Count;

  titleList.Clear;titleList.Free;

  k:=k+1;

  end;

  end;

  end;

  //自动调整表格

  wTable.AutoFitBehavior(1);//根据内容自动调整表格wdAutoFitContent

  wTable.AutoFitBehavior(2);//根据窗口自动调整表格wdAutoFitWindow

  result:=true;

  except

  result:=false;

  end;

  try

  dbG.DataSource.dataset.EnableControls;

  except

  end;

end;

 

{

功能：在Word文件中插入文本（能够自动进行换行处理）

lineText：要插入的文本

bNewLine：true时新起一行，false时在当前行插入

}

function PrnWordInsert(lineText:String;bNewLine:boolean=true):boolean;

var i:Integer;

begin

  try

  if bNewLine then

  wDoc.Range.InsertAfter(#13);

  //自动分行

  reWord.Lines.Clear;

  reWord.Lines.Add(lineText);

  //开始逐行插入

  for i:=0 to reWord.Lines.Count-1 Do

  begin

  //插入当前行

  wDoc.Range.InsertAfter(reWord.Lines[i]);

  //除最后一行外，自动加入新行

  if i

  wDoc.Range.InsertAfter(#13);

  end;

  result:=true;

  except

  result:=false;

  end;

end;

 

{

功能：在Word文件的sBookMark书签处插入TImage控件包含的图片

}

function PrnWordInsert(var imgInsert:TImage;sBookMark:String=''):boolean;

var wRange:Variant;iRangeEnd:Integer;

begin

  try

  if sBookMark='' then

  begin

  //在文档末尾

  iRangeEnd:=wDoc.Range.End-1;

  if iRangeEnd<0 then iRangeEnd:=0;

  wRange:=wDoc.Range(iRangeEnd,iRangeEnd);

  end else begin

  //在书签处

  wRange:=wDoc.Range.Goto(wdGoToBookmark,,,sBookMark);

  end;

  if imgInsert.Picture.Graphic<>nil then

  begin

  Clipboard.Assign(imgInsert.Picture);

  wRange.Paste;

  end else begin

  wRange.InsertAfter('照片');

  end;

  result:=true;

  except

  result:=false;

  end;

end;

 

{

功能：在书签sBookMark处插入TChart控件包含的图表

}

function PrnWordInsert(var chartInsert:TChart;sBookMark:String=''):boolean;

var wRange:Variant;iRangeEnd:Integer;

begin

  try

  if sBookMark='' then

  begin

  //在文档末尾

  iRangeEnd:=wDoc.Range.End-1;

  if iRangeEnd<0 then iRangeEnd:=0;

  wRange:=wDoc.Range(iRangeEnd,iRangeEnd);

  end else begin

  //在书签处

  wRange:=wDoc.Range.Goto(wdGoToBookmark,,,sBookMark);

  end;

  chartInsert.CopyToClipboardBitmap;

  wRange.Paste;

  result:=true;

  except

  result:=false;

  end;

end;

 

{

功能：保存Word文件

}

procedure PrnWordSave;

begin

  try

  wDoc.Save;

  except

  end;

end;

 

{

功能：关闭Word文件

}

procedure PrnWordEnd;

begin

  try

  wDoc.Save;

  wDoc.Close;

  wApp.Quit;

  except

  end;

end;

 

附：shFileCopy源代码

 

{

功能：安全的复制文件

srcFile，destFile：源文件和目标文件

bDelDest：如果目标文件已经存在，是否覆盖

返回值：true成功，false失败

}

function shFileCopy(srcFile,destFile:String;bDelDest:boolean=true):boolean;

begin

  result:=false;

  if not FileExists(srcFile) then

  begin

  guiInfo ('源文件不存在，不能复制。'+#10#13+srcFile);

  exit;

  end;

  if srcFile=destFile then

  begin

  guiInfo ('源文件和目标文件相同，不能复制。');

  exit;

  end;

  if FileExists(destFile) then

  begin

  if not bDelDest then

  begin

  guiInfo ('目标文件已经存在，不能复制。'+#10#13+destFile);

  exit;

  end;

  FileSetAttr(destFile,FileGetAttr(destFile) and not $00000001);

  if not DeleteFile(PChar(destFile)) then

  begin

  guiInfo ('目标文件已经存在，并且不能被删除，复制失败。'+#10#13+destFile);

  exit;

  end;

  end;

  if not CopyFileTo(srcFile,destFile) then

  begin

  guiInfo ('发生未知的错误，复制文件失败。');

  exit;

  end;

  //目标文件去掉只读属性

  FileSetAttr(destFile,FileGetAttr(destFile) and not $00000001);

  result:=true;

end;

 

附：guiInfo源代码

 

{

功能：封装了各种性质的提示框

sMsg：要提示的消息

}

procedure guiInfo(sMsg:String);

begin

  MessageDlg(sMsg,mtInformation,[mbOK],0);

end;

 

来自 “ ITPUB博客 ” ，链接：http://blog.itpub.net/10752019/viewspace-962509/，如需转载，请注明出处，否则将追究法律责任。

转载于:http://blog.itpub.net/10752019/viewspace-962509/