wordunit.pas

工程预算系统

unit wordunit;

interface

uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    Db, ADODB, ImgList, StdCtrls, Buttons, ComCtrls, dbctrls, menus,Variants,
    Math,ComObj,Gauges,grids,DBGrids,pubunit,Contnrs,printers, FR_Class,DBGridEh,
    Word2000,Office2000,pub_rep;

  {连接Word}
  procedure lineword;
  {将封面导到Word文档中}
  procedure zybtoword;      //导到
  {取得封面的对齐方式}
  function getzybdj(i:integer):OleVariant;
  {把人材机导入Word 中}
  procedure rcjtoword(mygrid:Tstringgrid;b_flag:boolean);     //报表导到Word
  {把表注部分导入Word}
  procedure bztoword;
  {将表头导到Word}
  procedure bttoword(mygrid:TStringGrid);
  procedure lineword1;
  procedure bztoword1(wddoc,wdapp:OleVariant;mygrid:Tstringgrid);
  procedure bttoword1(mygrid:TStringGrid;const wwddoc,wwdapp:OleVariant);
  procedure bttoword2(mygrid:TStringGrid;wwddoc,wwdapp:OleVariant);
  procedure bttoword3(mygrid:TStringGrid;wwddoc,wwdapp:OleVariant);
  {人材机导到Word}{价差和人材机导到Word是同一个函数}
  procedure rcjtoword1(mygrid:Tstringgrid;IsAllrcj:TdmAllrcj);  ////报表导到Word
    {取费表导到Word}
  procedure qftoWord(mygrid:TStringGrid);     ////报表导到Word
  {动态费率导到Word文档}
  procedure dtfltoWord(mygrid:TStringGrid);  ////报表导到Word
  {万用表导到Word文档中}
  procedure wybtoWord(mygrid:TStringGrid); ////报表导到Word
  {单价分析导到Word}
  procedure djfxtoWord(mygrid:TStringGrid); ////报表导到Word
  {单价分析相当于表头部分导到Word}
  procedure djfxbttoword(const wwddoc,wwdapp:OleVariant);
  {计算表导到Word文档中}
  procedure jsbtoword(mygrid:TStringGrid);            ////报表导到Word
  procedure lx;
  {分部*加表头的地方的}
  procedure jsbbttoword(mygrid:Tstringgrid;const wwddoc,wwdapp:OleVariant);
  {表注下导到Word中}
  procedure bzxtoword(wddoc,wdapp:OleVariant;mygrid:TStringgrid);
  {取得表注下的行数}
  function getbzline:integer;
  {(把竖排表导到Word文档中}
  procedure jsbhtoword(mygrid:Tstringgrid;wddoc,wdapp:OleVariant);   ////报表导到Word
  {取得计算表相当于表头的行数}
  function getjsbrow:integer;
  {创建表头}
  procedure jsbhbttoword(wddoc,wdapp:OleVariant;nlinew:integer);
  //给单元格
  procedure megerdyg(wddoc,wdapp:OleVariant;nrow:integer;str:string);
  {给单元格}
  procedure setword(wddoc,wdapp:OleVariant;str:string);
  procedure setword1(wddoc,wdapp:OleVariant;nrow:integer);
  procedure setword2(wddoc,wdapp:OleVariant;nwidth:integer;str:string);
  function isone:boolean;
  function istwo:boolean;
  function isthree:boolean;
  procedure setcellvalue(wddoc,wdapp:OleVariant;nrow,ncol,nlinew:integer;str:string);
  procedure setcellvalue1(wddoc,wdapp:OleVariant;nrow,ncol,nlinew:integer;str:string);
  procedure setcellvalue2(wddoc,wdapp:OleVariant;nrow,ncol,nlinew:integer;str:string);
  procedure hjtoword(wddoc,wdapp:OleVariant;nrow:integer;str:string);   //合计
  procedure hjtoword1(wddoc,wdapp:OleVariant;nrow:integer;str:string);
  procedure bttoword4(mygrid:TStringGrid;wwddoc,wwdapp:OleVariant);

var
  array_down:array[1..1000] of string;
  array_left:array[1..1000] of string;
  nk:integer;
  word_path:OleVariant;
  wordddd:string;
implementation
  uses ys,hu_pub,MAIN,Excelunit,Hu_jsfy;

procedure lineword1;
begin
 // showmessage(lowercase(copy(trim(mainform.SaveDialog1.FileName),length(trim(mainform.SaveDialog1.FileName))-3,4)));
  if lowercase(copy(trim(mainform.SaveDialog1.FileName),length(trim(mainform.SaveDialog1.FileName))-3,4))<>'.doc' then
    Excel_path:=mainform.SaveDialog1.FileName+'.doc'
  else
    Excel_path:=mainform.SaveDialog1.FileName;
  if trim(Excel_path)='' then
    abort;
  if fileexists(Excel_path) then
  begin
    if application.MessageBox(pchar('在当前位置发现已经存在名为'+'"'+Excel_path+'"'+'的文件。'+#13#10
                                   +'是否替换现有的'+'"'+Excel_path+'"文件?'),'文件重名',mb_iconquestion+mb_yesno+mb_defbutton2)=IDno then
      abort
    else
    begin
      if deletefile(Excel_path)=false then  //0为删除文件失败
      begin
        application.MessageBox(pchar('在替换当前位置文件失败。'+#13#10
                                    +'出错原因：源文件或目标文件可能正在使用!'),'提示',mb_iconinformation);
        abort;
      end;
    end;
  end;
  word_path:=Trim(Excel_path);
  wordddd:=Excel_path;
//  showmessage(word_path);
  mainform.statusbar1.Panels[2].Text:='正在将数据导入到Word文档，请稍候....................';
  mainform.StatusBar1.Update;
  screen.Cursor:=crhourglass;

end;

{连接Word文档}
procedure lineword;
begin
  if uppercase(copy(trim(mainform.SaveDialog1.FileName),length(trim(mainform.SaveDialog1.FileName))-3,4))<>'.doc' then
    Excel_path:=mainform.SaveDialog1.FileName+'.doc'
  else
    Excel_path:=mainform.SaveDialog1.FileName;
  if trim(Excel_path)='' then
    abort;
  if fileexists(Excel_path) then
  begin
    if application.MessageBox(pchar('在当前位置发现已经存在名为'+'"'+Excel_path+'"'+'的文件。'+#13#10
                                   +'是否替换现有的'+'"'+Excel_path+'"文件?'),'文件重名',mb_iconquestion+mb_yesno+mb_defbutton2)=IDno then
      abort
    else
    begin
      if deletefile(Excel_path)=false then  //0为删除文件失败
      begin
        application.MessageBox(pchar('在替换当前位置文件失败。'+#13#10
                                    +'出错原因：源文件或目标文件可能正在使用!'),'提示',mb_iconinformation);
        abort;
      end;
    end;
  end;
  word_path:=Excel_path;
  mainform.statusbar1.Panels[2].Text:='正在将数据导入到Word文档，请稍候....................';
  mainform.StatusBar1.Update;
  screen.Cursor:=crhourglass;
  try
    mainform.wordapp.Connect;
  except
     application.MessageBox(pchar('与Word应用程序连接失败！请确定是否已经装有Word,或者Word应用程序已被破坏！'+#13#10
                   +'如有必要，请联络程序设计人员！'),'温馨提示',mb_iconexclamation);
     screen.Cursor:=crdefault;
     Abort;
  end;
  mainform.wordapp.Visible:=True;
end;

procedure zybtoword1;
begin
end;


{将封面导到Word文档中}
procedure zybtoword;
var
  Template,NewTemplate,type1,v1,ItemIndex,djfs,myShape,wddoc,wdapp:OleVariant;
  i:integer;
  lzyb:Tjc_rcj;
  Orientation: MsoTextOrientation;
  nLeft,nTop,nWidth,nheight: integer;
  strselectid:string;
begin
  npagecount:=1;
  if (getactiveform as Tfrm_ys).tv_js.Selected<>nil then
    strselectid:=PData2((getactiveform as Tfrm_ys).tv_js.Selected.Data)^.ID
  else
    abort;
  getxx(strselectid);  //取得报表基本信息
//  setxx(strselectid,mygrid);   //给临时的grid赋值
  getwyb(strselectid);
  getzyb(strselectid);

  lineword1;
  try
    wdapp:=CreateOleObject('Word.Application');
  except
     application.MessageBox(pchar('与Word应用程序连接失败！请确定是否已经装有Word,或者Word应用程序已被破坏！'+#13#10
                   +'如有必要，请联络程序设计人员！'),'温馨提示',mb_iconexclamation);
     screen.Cursor:=crdefault;
     Abort;
  end;
  wdapp.Visible:=True;
  try
    Template := EmptyParam;
    NewTemplate := EmptyParam;
    type1 := 1;
    v1:= true;  ItemIndex :=1;
    wddoc:=wdapp.Documents.Add(Template,NewTemplate,type1,v1);  //.wordapp.Documents.Item(ItemIndex)

    if Trim(array_jbxx[8])='0' then      //判断是否是纵向打印
      wdapp.Documents.Item(itemindex).PageSetup.Orientation := wdOrientLandscape;// 横向打印

    wdapp.Documents.Item(itemindex).PageSetup.TopMargin:=5;
    wdapp.Documents.Item(itemindex).PageSetup.BottomMargin:=5;
    wdapp.Documents.Item(itemindex).PageSetup.LeftMargin:=5;
    wdapp.Documents.Item(itemindex).PageSetup.RightMargin:=5;
    
    if wdapp.ActiveWindow.View.SplitSpecial= wdPaneNone then
     wdapp.ActiveWindow.ActivePane.View.Type:=wdPrintView
    else
       wdapp.ActiveWindow.View.Type:=wdPrintView;
    if zyblist.Count>0 then
    begin
    for i:=0 to zyblist.Count-1 do
    begin
      lzyb:=Tjc_rcj(zyblist.Items[i]);
      if Trim(lzyb.column7)<>'' then
      begin
        Orientation:=1;
        nLeft:=getlbj(i);
        nTop:=getsbj(i);
        //nWidth:=250;
        mainform.l_label.Canvas.Font.Name:=getzt(i);
        mainform.l_label.Canvas.Font.Size:=getzh(i);
        nwidth:=mainform.l_label.Canvas.TextWidth(getfmstr(i))+30;
        nheight:=mainform.l_label.Canvas.TextHeight(getfmstr(i))+20;
        djfs:=getzybdj(i);
        myShape:=wddoc.Shapes.AddTextbox(Orientation,nLeft,nTop,nWidth,nheight,Template);
        myShape.Line.Visible := msoFalse;
        myShape.TextFrame.TextRange.Font.Name:=getzt(i);
        myShape.TextFrame.TextRange.Font.Size:=getzh(i);
        myShape.TextFrame.TextRange.ParagraphFormat.Alignment:=getzybdj(i);
        myShape.TextFrame.TextRange.Text:=getfmstr(i);
      end;
      mainform.statusbar1.Panels[2].Text:='正在检查数据并导入Word['+inttostr(i+1)+'/'+inttostr(zyblist.Count)+']，请稍候....................';
      mainform.StatusBar1.Update;
    end;
  end  
  else
    abort;

    wddoc.saveas(word_path);
    wddoc.Close;
    wdapp.Quit;
  except
    screen.Cursor:=crdefault;
    wddoc.saveas(word_path);
    wddoc.Close;
    wdapp.Quit;
  end;
  screen.Cursor:=crdefault;
  mainform.statusbar1.Panels[2].Text:='导入Word成功!';
  mainform.statusbar1.Update;
  application.MessageBox('导入Word成功','温馨提示',mb_iconinformation);
end;


{取得封面的对齐方式}
function getzybdj(i:integer):OleVariant;
var
  ntemp:OleVariant;
begin
  ntemp:=wdAlignParagraphJustify;
  if Trim(Tjc_rcj(zyblist.Items[i]).column4)='0' then
    ntemp:=wdAlignParagraphJustify
  else if Trim(Tjc_rcj(zyblist.Items[i]).column4)='1' then
    ntemp:=wdAlignParagraphRight
  else if Trim(Tjc_rcj(zyblist.Items[i]).column4)='2' then
    ntemp:=wdAlignParagraphCenter
  else if Trim(Tjc_rcj(zyblist.Items[i]).column4)='' then
    ntemp:=wdAlignParagraphJustify;
    Result:=ntemp;
end;
procedure bztoword1(wddoc,wdapp:OleVariant;mygrid:Tstringgrid);
var
  wdAutoFit,WdTableBehavior,nindex:OleVariant;
  ncount,nrow,ncol,nunit:OleVariant;
  nitem:integer;
  ntemp,nwidth:integer;
  nw,i:integer;
begin
  ntemp:=0;
  for i:=0 to mygrid.ColCount-1 do
    ntemp:=ntemp+mygrid.ColWidths[i];

  if Trim(array_jbxx[1])='1' then               //表头框架的宽度
    nwidth:=ntemp
  else
    nwidth:=ntemp-mygrid.ColWidths[0];
  nw:=Round(nwidth/3);
  nitem:=1;
  wdapp.Selection.Font.Name := Trim(array_jbxx[14]);
//  mainform.wordapp.Selection.Font.Color :=;
  wdapp.Selection.Font.Size := strtoint(array_jbxx[15]);
  wdapp.Selection.ParagraphFormat.Alignment := wdAlignParagraphCenter;
  wdapp.Selection.TypeText(Trim(array_jbxx[12]));
  wdapp.Selection.TypeParagraph;
  wdapp.Selection.ParagraphFormat.Alignment := wdAlignParagraphJustify;
  wdapp.Selection.Font.Name := '宋体';
  wdapp.Selection.Font.Size := 9;
  if getline(0)>=1 then
  begin
    WdTableBehavior:=wdWord9TableBehavior;
    wdAutoFit:=wdAutoFitFixed;
    wddoc.Tables.Add(wdapp.Selection.Range,getline(0),3,WdTableBehavior,wdAutoFit);
    for i:=1 to 3 do
      wdapp.Selection.Tables.Item(nitem).Columns.Item(i).Width:=nw*0.75;
//    with  wdapp.Selection.Tables.Item(nitem) do
//    begin
      wdapp.Selection.Tables.Item(nitem).Borders.Item(wdBorderLeft).LineStyle:=wdLineStyleNone;
      wdapp.Selection.Tables.Item(nitem).Borders.Item(wdBorderRight).LineStyle:=wdLineStyleNone;
      wdapp.Selection.Tables.Item(nitem).Borders.Item(wdBorderTop).LineStyle:=wdLineStyleNone;
      wdapp.Selection.Tables.Item(nitem).Borders.Item(wdBorderBottom).LineStyle:=wdLineStyleNone;
      wdapp.Selection.Tables.Item(nitem).Borders.Item(wdBorderHorizontal).LineStyle:=wdLineStyleNone;
      wdapp.Selection.Tables.Item(nitem).Borders.Item(wdBorderVertical).LineStyle:=wdLineStyleNone;
      wdapp.Selection.Tables.Item(nitem).Borders.Item(wdBorderDiagonalDown).LineStyle:=wdLineStyleNone;
      wdapp.Selection.Tables.Item(nitem).Borders.Item(wdBorderDiagonalUp).LineStyle:=wdLineStyleNone;
      wdapp.Selection.Tables.Item(nitem).Borders.Shadow := False;
      if Trim(array_jbxx[26])<>'' then
      begin
        nrow:=1;  ncol:=1;
        wdapp.Selection.Tables.Item(nitem).Cell(nrow,ncol).Range.ParagraphFormat.Alignment:=wdAlignParagraphJustify;
        wdapp.Selection.Tables.Item(nitem).Cell(nrow,ncol).Range.Text:=getstr(array_jbxx[26]);
      end;
      if Trim(array_jbxx[27])<>'' then
      begin
        nrow:=2;  ncol:=1;
        wdapp.Selection.Tables.Item(nitem).Cell(nrow,ncol).Range.ParagraphFormat.Alignment:=wdAlignParagraphJustify;
        wdapp.Selection.Tables.Item(nitem).Cell(nrow,ncol).Range.Text:=getstr(array_jbxx[27]);
      end;
      if Trim(array_jbxx[28])<>'' then
      begin
        nrow:=3;  ncol:=1;
        wdapp.Selection.Tables.Item(nitem).Cell(nrow,ncol).Range.ParagraphFormat.Alignment:=wdAlignParagraphJustify;
        wdapp.Selection.Tables.Item(nitem).Cell(nrow,ncol).Range.Text:=getstr(array_jbxx[28]);
      end;
      if Trim(array_jbxx[29])<>'' then
      begin
        nrow:=1;  ncol:=2;
        wdapp.Selection.Tables.Item(nitem).Cell(nrow,ncol).Range.ParagraphFormat.Alignment:=wdAlignParagraphCenter;
        wdapp.Selection.Tables.Item(nitem).Cell(nrow,ncol).Range.Text:=getstr(array_jbxx[29]);
      end;
      if Trim(array_jbxx[30])<>'' then
      begin
        nrow:=2;  ncol:=2;
        wdapp.Selection.Tables.Item(nitem).Cell(nrow,ncol).Range.ParagraphFormat.Alignment:=wdAlignParagraphCenter;
        wdapp.Selection.Tables.Item(nitem).Cell(nrow,ncol).Range.Text:=getstr(array_jbxx[30]);
      end;
      if Trim(array_jbxx[31])<>'' then
      begin
        nrow:=3;  ncol:=2;
        wdapp.Selection.Tables.Item(nitem).Cell(nrow,ncol).Range.ParagraphFormat.Alignment:=wdAlignParagraphCenter;
        wdapp.Selection.Tables.Item(nitem).Cell(nrow,ncol).Range.Text:=getstr(array_jbxx[31]);
      end;
      if Trim(array_jbxx[32])<>'' then
      begin
        nrow:=1;  ncol:=3;
        wdapp.Selection.Tables.Item(nitem).Cell(nrow,ncol).Range.ParagraphFormat.Alignment:=wdAlignParagraphRight;
        wdapp.Selection.Tables.Item(nitem).Cell(nrow,ncol).Range.Text:=getstr(array_jbxx[32]);
      end;
      if Trim(array_jbxx[33])<>'' then
      begin
        nrow:=2;  ncol:=3;
        wdapp.Selection.Tables.Item(nitem).Cell(nrow,ncol).Range.ParagraphFormat.Alignment:=wdAlignParagraphRight;
        wdapp.Selection.Tables.Item(nitem).Cell(nrow,ncol).Range.Text:=getstr(array_jbxx[33]);
      end;