科技行者

行者学院 转型私董会 科技行者专题报道 网红大战科技行者

知识库

知识库 安全导航

至顶网软件频道应用软件Delphi+Word解决方案参考

Delphi+Word解决方案参考

  • 扫一扫
    分享文章到微信

  • 扫一扫
    关注官方公众号
    至顶头条

本文是Delphi+Word解决方案参考的代码实例

作者:51cto.com整理 来源:网络 2007年9月15日

关键字: 软件

  • 评论
  • 分享微博
  • 分享邮件

//设置单元格对齐方式

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领域最新产品与技术信息,那么订阅至顶网技术邮件将是您的最佳途径之一。

    重磅专题
    往期文章
    最新文章