⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 qd_worde.pas

📁 工程预算系统
💻 PAS
📖 第 1 页 / 共 5 页
字号:
          b_break:=True;
          break;
        end;
        ntempcount:=i+2;
        if i>0 then
        begin
          nunit:=wdCharacter;
          ncount:=1;
          nindex:=0;
          wdapp.Selection.MoveRight(nunit,ncount,nindex);
          nunit:=wdLine;
          ncount:=1;
          nindex:=0;
          wdapp.Selection.MoveDown(nunit,ncount,nindex);
          if i<gcqdlist.Count-1 then
            wdapp.Selection.InsertRowsAbove(ncount);
        end;  
      end;  //end for i:=ntempcount to gcqdlist.count-1 do
      if b_break then
      begin
        if Trim(array_jbxx[1])='1' then
        begin
          wdapp.Selection.Tables.Item(nitem).Cell(nrowcount,ntmpcol).Select;
          if nxhheight>=1 then
          begin
            if nxhheight>=1 then
            begin
              if nxhheight=1 then
              wdapp.Selection.TypeText(strxh)
              else if nxhheight>1 then
              begin
                nunit:=wdLine;
                ncount:=nxhheight-1;
                nindex:=1;
                wdapp.Selection.MoveDown(nunit,ncount,nindex);
                if ncount>0 then
                wdapp.Selection.Cells.Merge;
                wdapp.Selection.TypeText(strxh);
              end;  
            end;
          end;
          nunit:=wdLine;
          ncount:=1;
          nindex:=0;
          wdapp.Selection.MoveDown(nunit,ncount,nindex);
        end;
      end;   //end if b_break then
      if i>=gcqdlist.Count-1 then
      begin
        if Trim(array_jbxx[1])='1' then
        begin
          wdapp.Selection.Tables.Item(nitem).Cell(nrowcount,ntmpcol).Select;
          if nxhheight>=1 then
          begin
            if nxhheight>=1 then
            begin
              if nxhheight=1 then
              wdapp.Selection.TypeText(strxh)
              else if nxhheight>1 then
              begin
                nunit:=wdLine;
                ncount:=nxhheight-2;
                nindex:=1;
                wdapp.Selection.MoveDown(nunit,ncount,nindex);
                if ncount>0 then
                wdapp.Selection.Cells.Merge;
                wdapp.Selection.TypeText(strxh);
              end;  
            end;
          end;
          nunit:=wdLine;
          ncount:=1;
          nindex:=0;
          wdapp.Selection.MoveDown(nunit,ncount,nindex);
        end;
      end;
      nunit:=wdCharacter;
      ncount:=1;
      nindex:=0;
      wdapp.Selection.MoveRight(nunit,ncount,nindex);
      nunit:=wdLine;
      ncount:=1;
      nindex:=0;
      wdapp.Selection.MoveDown(nunit,ncount,nindex);
      wdapp.Selection.TypeParagraph;
      bzxtoword(wddoc,wdapp,mygrid);
    end;   //end while
    wddoc.saveas(word_path);
    wddoc.Close;
    wdapp.Quit;
  except
    screen.Cursor:=crdefault;
    wddoc.saveas(word_path);
    wddoc.Close;
    wdapp.Quit;
  end;     //end try
  screen.Cursor:=crdefault;
  mainform.statusbar1.Panels[2].Text:='导入Word成功!';
  mainform.statusbar1.Update;
  application.MessageBox('导入Word成功','温馨提示',mb_iconinformation);
end;


{把其他项目工程量清单报表导到Word文档中}
procedure qtxmqdtoword(mygrid:TStringGrid);
var
  i,j,k:integer;
  ntopdis,nleftdis,nbottomdis,nrightdis:integer;//报表上,下,左,右边距的值
  dy:integer;                                //报表纸张的宽度和高度
  nh,nb:integer;                                   //标题离纸的高度
  ntop:integer;                                //表头离纸的高度
  nbottomtop:integer;                          //纸张表注部分所占的高度
  nhheight:integer;                           //表头边框的高度
  rcj:Tjc_rcj;
  ntup:integer;
  strselectid:string;
  ntempcount:integer;
  nmin,nmax:integer;
  nht:integer;
  ncol:integer;        //用于本页小计用
  b_frist,b_break:boolean;
  nxh:integer;
  Template,NewTemplate,type1,v1,ItemIndex:OleVariant;
  ncount,nunit,nindex,numrow,wdapp,wddoc:OleVariant;
  oldpage:OleVariant;
  nitem:integer;
  ntmppage:integer;
begin
  oldpage:=0;
  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赋值

  getqtxmqd;         //取得其他项目工程量清单

  nht:=strtoint(array_jbxx[48]);
  ntopdis:=strtoint(array_jbxx[5])*3;
  nbottomdis:=strtoint(array_jbxx[7])*3;
  nleftdis:=strtoint(array_jbxx[4])*3;
  nrightdis:=strtoint(array_jbxx[6])*3;
  nhheight:=gethead(mygrid,strtoint(array_jbxx[48]));

  if Trim(array_jbxx[8])='1' then
    dy:=getpageh(0,True)
  else
    dy:=getpageh(0,False);

  nh:=getup(array_jbxx[26],array_jbxx[27],array_jbxx[28],array_jbxx[29],array_jbxx[30],array_jbxx[31],array_jbxx[32],array_jbxx[33],array_jbxx[34]);
  nb:=getup(array_jbxx[35],array_jbxx[38],array_jbxx[41],array_jbxx[36],array_jbxx[39],array_jbxx[42],array_jbxx[37],array_jbxx[40],array_jbxx[43]);

  ntop:=ntopdis+60+nh;                    //表头开始离纸的高度
  nbottomtop:=dy-nbottomdis-nb;           //作为换页的依据;

  ntmppage:=0; ntempcount:=0;
  while ntempcount<=qtxmqdlist.Count do
  begin
    ntup:=ntop+nhheight;
    for i:=ntempcount to qtxmqdlist.Count-1 do
    begin
      nmax:=1;
      for j:=1 to mygrid.ColCount-1 do
      begin
        nmin:=getlinecount(calqtxmqd(i,mygrid,j),mygrid.ColWidths[j]);
        if nmin>nmax then
          nmax:=nmin;
      end;   //  end for j
      if array_jbxx[46]='1' then
      begin
        if i+1=qtxmqdlist.Count-1 then    //创建本页小计  因为记录不够,那就在合计前
        begin                           //创建本页小计了
          if array_dyxx[1]='1' then
          begin
            ntup:=ntup+nht*nmax;
            nmax:=1;
          end;
        end;
      end;
      ntup:=ntup+nht*nmax;
      if ntup+50>nbottomtop then
        break;
    end;
    ntempcount:=i+1;
    inc(ntmppage);
  end;
  npagecount:=ntmppage;

  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;// 横向打印
    if (ntopdis-65)<0 then
      wdapp.Documents.Item(itemindex).PageSetup.TopMargin:=5
    else
      wdapp.Documents.Item(itemindex).PageSetup.TopMargin:=ntopdis-65;
    if (nbottomdis-65)<0 then
      wdapp.Documents.Item(itemindex).PageSetup.BottomMargin:=5
    else
      wdapp.Documents.Item(itemindex).PageSetup.BottomMargin:=nbottomdis-65;
    wdapp.Documents.Item(itemindex).PageSetup.LeftMargin:=nleftdis;
    wdapp.Documents.Item(itemindex).PageSetup.RightMargin:=nrightdis;
    if wdapp.ActiveWindow.View.SplitSpecial= wdPaneNone then
      wdapp.ActiveWindow.ActivePane.View.Type:=wdPrintView
    else
      wdapp.ActiveWindow.View.Type:=wdPrintView;

    nxh:=1;
    b_frist:=False;
    ntempcount:=0; npagetmp:=0;
    while ntempcount<=qtxmqdlist.Count do
    begin
    b_break:=False;
      if oldpage<>0 then oldpage:=wdapp.Selection.Information[wdActiveEndAdjustedPageNumber];
      while wdapp.Selection.Information[wdActiveEndAdjustedPageNumber]<>oldpage+1 do
        wdapp.Selection.TypeParagraph;
      for k:=1 to 40 do
        array_hj[k]:=0;

      oldpage:=1;    npagetmp:=npagetmp+1;
      bztoword1(wddoc,wdapp,mygrid);     //表注部分导到word {这里必须要重写}
      bttoword4(mygrid,wddoc,wdapp);      //表头部分导到word
      ntup:=ntop+nhheight;
      for i:=ntempcount to qtxmqdlist.Count-1 do
      begin
        rcj:=Tjc_rcj(qtxmqdlist.Items[i]);
        nmax:=1;
        for j:=1 to mygrid.ColCount-1 do
        begin
          nmin:=getlinecount(calqtxmqd(i,mygrid,j),mygrid.ColWidths[j]);
          if nmin>nmax then
            nmax:=nmin;
        end;   //  end for j
        if Trim(array_jbxx[1])='1' then
        begin
          wdapp.Selection.TypeText(inttostr(nxh));
          nunit:=wdCharacter;
          ncount:=1;
          nindex:=0;
          wdapp.Selection.MoveRight(nunit,ncount,nindex);
          inc(nxh);
        end;
        for j:=1 to mygrid.ColCount-1 do
        begin
          if isnumber(calqtxmqd(i,mygrid,j))=0  then
            array_hj[j]:=array_hj[j]+strtofloat(calqtxmqd(i,mygrid,j));  //创建本页小计 合计本页信息

          if lowercase(Trim(mygrid.Cells[j,1]))='mc' then
            wdapp.Selection.TypeText(calqtxmqd(i,mygrid,j))
          else if (Trim(array_jbxx[46])='1')  and (Trim(mygrid.Cells[j,4])='') and ((rcj.flag=2) or (rcj.flag=3)) then
            wdapp.Selection.TypeText('')
          else if i<qtxmqdlist.Count then
            wdapp.Selection.TypeText(calqtxmqd(i,mygrid,j));

          nunit:=wdCharacter;
          ncount:=1;
          nindex:=0;
          wdapp.Selection.MoveRight(nunit,ncount,nindex);            
        end;
        if array_jbxx[46]='1' then
        begin
          if i+1=gcqdlist.Count-1 then    //创建本页小计  因为记录不够,那就在合计前
          begin                           //创建本页小计了
            if array_dyxx[1]='1' then
            begin
              nunit:=wdCharacter;
              ncount:=1;
              nindex:=0;
              wdapp.Selection.MoveRight(nunit,ncount,nindex);
              nunit:=wdLine;
              ncount:=1;
              nindex:=0;
              wdapp.Selection.MoveDown(nunit,ncount,nindex);
              wdapp.Selection.InsertRowsAbove(ncount);
              b_frist:=True;
              ntup:=ntup+nht*nmax;
              nmax:=1;
              if Trim(array_jbxx[1])='1' then
              begin
                wdapp.Selection.TypeText('');
                nunit:=wdCharacter;
                ncount:=1;
                nindex:=0;
                wdapp.Selection.MoveRight(nunit,ncount,nindex);
              end;
              for ncol:=1 to mygrid.ColCount-1 do
              begin
                if (lowercase(Trim(mygrid.Cells[ncol,1]))='mc') then
                  wdapp.Selection.TypeText('本页小计')
                else if Trim(mygrid.Cells[ncol,4])='' then
                  wdapp.Selection.TypeText('')
                else if i<qtxmqdlist.Count then
                  wdapp.Selection.TypeText(Trim(floattostr(array_hj[ncol])));

                nunit:=wdCharacter;
                ncount:=1;
                nindex:=0;
                wdapp.Selection.MoveRight(nunit,ncount,nindex);
              end;  //  end for ncol
            end;
          end;
        end;
        ntup:=ntup+nht*nmax;
        if ntup+50>nbottomtop then
        begin
          b_break:=True;
          break;
        end;
        nunit:=wdCharacter;
        ncount:=1;
        nindex:=0;
        wdapp.Selection.MoveRight(nunit,ncount,nindex);
        nunit:=wdLine;
        ncount:=1;
        nindex:=0;
        wdapp.Selection.MoveDown(nunit,ncount,nindex);
        if i<qtxmqdlist.Count-1 then
          wdapp.Selection.InsertRowsAbove(ncount);
      end;    // end for i:=ntempcount

      if b_frist=False then
      begin
        if array_dyxx[1]='1' then
        begin
          if b_break then
          begin
            nunit:=wdCharacter;
            ncount:=1;
            nindex:=0;
            wdapp.Selection.MoveRight(nunit,ncount,nindex);
            nunit:=wdLine;
            ncount:=1;
            nindex:=0;
            wdapp.Selection.MoveDown(nunit,ncount,nindex);
          end;
          wdapp.Selection.InsertRowsAbove(ncount);
          if Trim(array_jbxx[1])='1' then
          begin

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -