分享
 
 
 

Delphi+Word解决方案参考

王朝delphi·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

[转]这是我做项目过程中自己做的几个函数,见到大家都在问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(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;

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.document..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<reWord.Lines.Count-1 then

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<reWord.Lines.Count-1 then

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;

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有