网上文章"Delphi＋Word解决方案参考"中使用的参数reWord,究竟是什么?谁可以告诉我 ( 积分: 100 )

  • 主题发起人 主题发起人 sstsgqyj
  • 开始时间 开始时间
S

sstsgqyj

Unregistered / Unconfirmed
GUEST, unregistred user!
这是我做项目过程中自己做的几个函数，见到大家都在问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 :=do
cText;
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 :=do
cText;
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-1do

begin

//插入当前行
wApp.Selection.InsertAfter(reWord.Lines);
//除最后一行外，自动加入新行
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 :=do
cText;
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-1do

begin

if dbG.Columns.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.Countdo

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 iLinedo

begin

k:=1;
for j:=1 to dbG.Columns.Countdo

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.FooterRowCountdo

begin

k:=1;
for j:=1 to dbG.Columns.Countdo

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.Countdo

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-1do

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-1do

begin

//插入当前行
wDoc.Range.InsertAfter(reWord.Lines);
//除最后一行外，自动加入新行
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&amp;: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;
 
真的无人帮手咩?还是无人明白我的意思啊
 
快帮帮我手
 
编译不能通过,请问reWord什么来的
 
您必须登录或注册才可回复。

Similar threads

I
导出DBGrid文件到Excel
回复
0
查看
658
import
I
I
网络函数大公开
回复
0
查看
842
import
I
I
一个数列
回复
0
查看
846
import
I
I
在Delphi程序中获取网络资源信息
回复
0
查看
768
import
I
X
为什么网上找的这个代码比较不出两张图呢?(50)
回复
1
查看
1K
菜鸟黄
菜
后退
顶部