Delphi+Word解决方案参考.doc_第1页
Delphi+Word解决方案参考.doc_第2页
Delphi+Word解决方案参考.doc_第3页
Delphi+Word解决方案参考.doc_第4页
Delphi+Word解决方案参考.doc_第5页
已阅读5页,还剩7页未读 继续免费阅读

下载本文档

版权说明:本文档由用户提供并上传,收益归属内容提供方,若内容存在侵权,请进行举报或认领

文档简介

DelphiWord解决方案参考这是我做项目过程中自己做的几个函数,见到大家都在问Word的问题。现在拿出来和大家共享。(希望有朋友可以进一步添加新的功能,或者做成包或者lib等,更方便大家使用。我自己是没有时间啦,呵呵) 使用前,先根据需要建立一个空的WORD文件作为模板,在模板文件中设置好各种格式和文本。另外,其中的PrnWordTable的参数是TDBGridEh类型的控件,取自Ehlib2.6其中用到的shFileCopy函数(用于复制文件)和guiInfo函数(用于显示消息框)也是自己编写的,代码也附后。 示范代码如下: 代码完成的功能:1. 替换打印模板中的“#TITLE#”文本为“示范代码1”2. 并且将DBGridEh1控件当前显示的内容插入到文档的末尾3. 在文档末尾插入一个空行4. 在文档末尾插入新的一行文本5. 将文档中的空行去掉 if PrnWordBegin(C:打印模板.DOC,C:目标文件1.DOC) thenbeginPrnWordReplace(#TITLE#,示范代码1);PrnWordTable(DBGridEh1);PrnWordInsert();PrnWordInsert(这是新的一行文本);PrnWordReplace(pp,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(lineText: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;beginresult:=false;/复制模版if tempDoc thenif not shFileCopy(tempDoc,docName) then exit;/连接WordtrywApp:=CreateOleObject(Word.Application);exceptguiInfo(请先安装 Microsoft Word 。);exit;end;try/打开if tempDoc= thenbegin/创建新文档wDoc:=wApp.documentAdd;wDoc.SaveAs(docName);end else begin/打开模版wDoc:=wApp.document.Open(docName);end;exceptguiInfo(打开模版失败,请检查模版是否正确。);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;beginif bSimpleReplace thenbegin/简单处理,直接执行替换操作trywApp.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;exceptresult:=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 Dobegin/插入当前行wApp.Selection.InsertAfter(reWord.Linesi);/除最后一行外,自动加入新行if ireWord.Lines.Count-1 thenwApp.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;exceptresult:=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;beginresult:=false;try/计算表格的列数(不包括隐藏的列)iTitleLine:=1; /始终默认为1iCol:=0;for i:=0 to dbG.Columns.Count-1 Dobeginif dbG.Columnsi.Visible thenbeginiCol:=iCol+1;end;end;/计算表格的行数(不包括隐藏的列)if dbG.DataSource.DataSet.Active theniLine:=dbG.DataSource.DataSet.RecordCountelseiLine:=0;iGridLine:=iLine+iTitleLine+dbG.FooterRowCount;/定位插入点if sBookMark= thenbegin/在文档末尾iRangeEnd:=wDoc.Range.End-1;if iRangeEnd0 thenbegindbG.DataSource.dataset.DisableControls;dbG.DataSource.DataSet.First;for i:=1 to iLine Dobegink:=1;for j:=1 to dbG.Columns.Count Dobeginif dbG.Columnsj-1.Visible thenbeginif dbG.Columnsj-1.FieldName then /避免由于空列而出错begin/如果该列有自己的格式化显示函数,则调用显示函数获取显示串getTextText:=;if Assigned(dbG.DataSource.DataSet.FieldByName(dbG.Columnsj-1.FieldName).OnGetText) thenbegindbG.DataSource.DataSet.FieldByName(dbG.Columnsj-1.FieldName).OnGetText(dbG.DataSource.DataSet.FieldByName(dbG.Columnsj-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.Columnsj-1.FieldName).AsString);end;end;/设置单元格对齐方式if dbG.Columnsj-1.Alignment=taCenter thenwTable.Cell(i+iTitleLine,k).Range.ParagraphFormat.Alignment:=wdAlignParagraphCenterelse if dbG.Columnsj-1.Alignment=taRightJustify thenwTable.Cell(i+iTitleLine,k).Range.ParagraphFormat.Alignment:=wdAlignParagraphRightelse if dbG.Columnsj-1.Alignment=taLeftJustify thenwTable.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 Dobegink:=1;for j:=1 to dbG.Columns.Count Dobeginif dbG.Columnsj-1.Visible thenbeginwTable.Cell(iLine+1+i,k).Range.InsertAfter(dbG.GetFootervalue(i-1,dbG.Columnsj-1);/设置单元格对齐方式if dbG.Columnsj-1.Footer.Alignment=taCenter thenwTable.Cell(iLine+1+i,k).Range.ParagraphFormat.Alignment:=wdAlignParagraphCenterelse if dbG.Columnsj-1.Footer.Alignment=taRightJustify thenwTable.Cell(iLine+1+i,k).Range.ParagraphFormat.Alignment:=wdAlignParagraphRightelse if dbG.Columnsj-1.Footer.Alignment=taLeftJustify thenwTable.Cell(iLine+1+i,k).Range.ParagraphFormat.Alignment:=wdAlignParagraphJustify;k:=k+1;end;end;end;/处理多行标题if dbG.UseMultiTitle thenbegin/先分割单元格,再逐个填入第二行k:=1;titleCol:=1;lastTitleSplit:=1;SubTitle:=0;lastTitle:=;for j:=1 to dbG.Columns.Count Dobeginif dbG.Columnsj-1.Visible thenbegintitleList:=strSplit(dbG.Columnsj-1.Title.Caption,|);if titleList.Count1 thenbegin/处理第二行以上的内容wTable.Cell(1,k-SubTitle).Range.Cells.Split(titleList.Count,1,false);for titleSplit:=1 to titleList.Count-1 DobeginwTable.Cell(titleSplit+1,titleCol).Range.InsertAfter(titleList.StringstitleSplit);end;titleCol:=titleCol+1;/处理第一行合并if (lastTitleSplit=titleList.Count) and (lastTitle=titleList.Strings0) thenbegin/内容相同时,合并单元格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.Strings0;lastTitleSplit:=titleList.Count;titleList.Clear;titleList.Free;k:=k+1;end;end;end;/自动调整表格wTable.AutoFitBehavior(1);/根据内容自动调整表格wdAutoFitContentwTable.AutoFitBehavior(2);/根据窗口自动调整表格wdAutoFitWindowresult:=true;exceptresult:=false;end;trydbG.DataSource.dataset.EnableControls;exceptend;end; 功能:在Word文件中插入文本(能够自动进行换行处理)lineText:要插入的文本bNewLine:true时新起一行,false时在当前行插入function PrnWordInsert(lineText:String;bNewLine:boolean=true):boolean;var i:Integer;begintryif bNewLine thenwDoc.Range.InsertAfter(#13);/自动分行reWord.Lines.Clear;reWord.Lines.Add(lineText);/开始逐行插入for i:=0 to reWord.Lines.Count-1 Dobegin/插入当前行wDoc.Range.InsertAfter(reWord.Linesi);/除最后一行外,自动加入新行if ireWord.Lines.Count-1 thenwDoc.Range.InsertAfter(#13);end;result:=true;exceptresult:=false;end;end; 功能:在Word文件的sBookMark书签处插入TImage控件包含的图片function PrnWordInsert(var imgInsert:TImage;sBookMark:String=):boolean;var wRange:Variant;iRangeEnd:Integer;begintryif sBookMark= thenbegin/在文档末尾iRangeEnd:=wDoc.Range.End-1;if iRangeEnd0 then iRangeEnd:=0;wRange:=wDoc.Range(iRangeEnd,iRangeEnd);end else begin/在书签处wRange:=wDoc.Range.Goto(wdGoToBookmark,sBookMark);end;if imgInsert.Picture.Graphicnil thenbeginClipboard.Assign(imgInsert.Picture);wRange.Paste;end else beginwRange.InsertAfter(照片);end;result:=true;exceptresult:=false;end;end; 功能:在书签sBookMark处插入TChart控件包含的图表function PrnWordInsert(var chartInsert:TChart;sBookMark:String=):boolean;var wRange:Variant;iRangeEnd:Integer;begintryif sBookMark= thenbegin/在文档末尾iRangeEnd:=wDoc.Range.End-1;if iRangeEnd0 then iRangeEnd:=0;wRange:=wDoc.Range(iRangeEnd,iRangeEnd);end else begin/在书签处wRange:=wDoc.Range.Goto(wdGoToBookmark,sBookMark);end;chartInsert.CopyToClipboardBitmap;wRange.Paste;result:=true;exceptresult:=false;end;end; 功能:保存Word文件procedure PrnWordSave;begint

温馨提示

  • 1. 本站所有资源如无特殊说明,都需要本地电脑安装OFFICE2007和PDF阅读器。图纸软件为CAD,CAXA,PROE,UG,SolidWorks等.压缩文件请下载最新的WinRAR软件解压。
  • 2. 本站的文档不包含任何第三方提供的附件图纸等,如果需要附件,请联系上传者。文件的所有权益归上传用户所有。
  • 3. 本站RAR压缩包中若带图纸,网页内容里面会有图纸预览,若没有图纸预览就没有图纸。
  • 4. 未经权益所有人同意不得将文件中的内容挪作商业或盈利用途。
  • 5. 人人文库网仅提供信息存储空间,仅对用户上传内容的表现方式做保护处理,对用户上传分享的文档内容本身不做任何修改或编辑,并不能对任何下载内容负责。
  • 6. 下载文件中如有侵权或不适当内容,请与我们联系,我们立即纠正。
  • 7. 本站不保证下载资源的准确性、安全性和完整性, 同时也不承担用户因使用这些下载资源对自己和他人造成任何形式的伤害或损失。

最新文档

评论

0/150

提交评论