使用 delphi 控制 word.txt

大量Delphi开发资料

  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;