//这是我做项目过程中自己做的几个函数,见到大家都在问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,do
cName: 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,do
cName: string): boolean;
begin
result := false;
//复制模版
if tempDoc <> '' then
if not shFileCopy(tempDoc,do
cName) 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 :=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: 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;
这个你看一下呗