程序博客网 > 学术论文 知乎

Delphi+Word解决方案参考

来源：互联网 发布：学术论文 知乎 编辑：程序博客网 时间：2024/05/21 17:47

 Delphi+Word解决方案参考

    使用前，先根据需要建立一个空的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;
学术论文 知乎 学术论文 知乎
原创粉丝点击
热门IT博客
易语言批量解析源码易语言批量解析源码
恶搞理发软件恶搞理发软件
js base64转化为图片
德国 知乎
linux嗅探工具
我国网络舆论的特点是?
怎么开淘宝话费充值店
大数据的新应用
如何优化经济发展环境
ospf网络设计解决方案
广发淘宝潮女信用卡
淘宝店铺交易网
航拍图像拼接软件
php json 汉字乱码
华大基因股票知乎
java手册chm
centos自建邮件服务器
fps鼠标推荐 知乎
公路预算定额软件
mv字幕制作软件
热门问题 老师的惩罚 人脸识别 我在镇武司摸鱼那些年 重生之率土为王 我在大康的咸鱼生活 盘龙之生命进化 天生仙种 凡人之先天五行 春回大明朝 姑娘不必设防，我是瞎子 木盆泡脚有什么好处 木盆价格 香樟木洗脚盆 洗脚盆木盆价格 足疗木盆 洗脚的木盆 泡脚木盆价格及图片 洗脚木盆什么牌子好 巴西木多少钱一盆 泡脚的木盆 洗脚盆 木盆 清香木多少钱一盆 橡木洗脸盆 泡脚木盆多少钱一个 泡脚木盆 洗澡木盆 木盆图片 木盆 足浴盆木盆 木盆足浴 木盆养金鱼 洗澡的大木盆 木盆泡脚好处 木监 一个木一个监 木加监读什么 木盒和天下 木盒包装 木盒包装厂 木盒公司 木盒子 红酒木盒厂 葡萄酒木盒 小木盒 木盒加工厂 木盒厂家 小木盒图片 木盒制作 木盒中华 包装木盒 木盒论道

程序博客网，程序员的互联网技术博客家园。csdn论坛精品 msdn技术资料都在这里