Task 汇总标段，根据报表文件，决定是否汇总某些特殊标段

Forms/rmSelectProjectFrm.dfm

@@ -59,6 +59,8 @@ object ProjectSelectForm: TProjectSelectForm
     DefaultFixedRowHeight = 25
     Selection.AlphaBlend = False
     Selection.TransparentColor = False
+    FrozenCol = 0
+    FrozenRow = 0
     OnGetCellText = zgSelectProjectGetCellText
     OnSetCellText = zgSelectProjectSetCellText
     OnCellTextChanging = zgSelectProjectCellTextChanging
@@ -99,6 +101,8 @@ object ProjectSelectForm: TProjectSelectForm
     DefaultFixedRowHeight = 30
     Selection.AlphaBlend = False
     Selection.TransparentColor = False
+    FrozenCol = 0
+    FrozenRow = 0
     OnGetCellText = zgResultGetCellText
     OnSetCellText = zgResultSetCellText
   end

ProjGather/GatherProjInfo.pas

@@ -13,13 +13,9 @@ type
     FFileName: string;
 
     FProjRec: TsdDataRecord;
-
-    {FIsPD: Boolean;
-    FIsCDD: Boolean;
-    FIsAB: Boolean;
-    FIsDeal: Boolean;}
+    FProjType: Integer;
   public
-    constructor Create(ARec: TsdDataRecord); virtual;
+    constructor Create(ARec: TsdDataRecord; AProjType: Integer); virtual;
     destructor Destroy; override;
 
     property ProjectID: Integer read FProjectID;
@@ -27,22 +23,15 @@ type
     property FileName: string read FFileName;
 
     property ProjRec: TsdDataRecord read FProjRec;
-
-    {// 初步设计(概算)项目
-    property IsPD: Boolean read FIsPD write FIsPD;
-    // 施工图设计(预算)项目
-    property IsCDD: Boolean read FIsCDD write FIsCDD;
-    // 批准概算项目
-    property IsAB: Boolean read FIsAB write FIsAB;
-    // 多合同项目（二三部分，土地征拆、监理等）
-    property IsDeal: Boolean read FIsDeal write FIsDeal;}
+    // 值为0 普通汇总项目，值非0 项目类型根据报表
+    property ProjType: Integer read FProjType;
   end;
 
   TSelectProjInfo = class(TGatherProjInfo)
   private
     FIsTender: Boolean;
   public
-    constructor Create(ARec: TsdDataRecord); override;
+    constructor Create(ARec: TsdDataRecord; AProjType: Integer); override;
 
     property IsTender: Boolean read FIsTender;
   end;
@@ -51,12 +40,18 @@ implementation
 
 { TGatherProjInfo }
 
-constructor TGatherProjInfo.Create(ARec: TsdDataRecord);
+constructor TGatherProjInfo.Create(ARec: TsdDataRecord; AProjType: Integer);
 begin
   FProjRec := ARec;
-  FProjectID := FProjRec.ValueByName('ID').AsInteger;
-  FProjectName := FProjRec.ValueByName('Name').AsString;
-  FFileName := FProjRec.ValueByName('FileName').AsString;
+  if Assigned(FProjRec) then
+  begin
+    FProjectID := FProjRec.ValueByName('ID').AsInteger;
+    FProjectName := FProjRec.ValueByName('Name').AsString;
+    FFileName := FProjRec.ValueByName('FileName').AsString;
+  end
+  else
+    FProjectID := -1;
+  FProjType := AProjType;
 end;
 
 destructor TGatherProjInfo.Destroy;
@@ -66,7 +61,7 @@ end;
 
 { TSelectProjInfo }
 
-constructor TSelectProjInfo.Create(ARec: TsdDataRecord);
+constructor TSelectProjInfo.Create(ARec: TsdDataRecord; AProjType: Integer);
 begin
   inherited;
   FIsTender := FProjRec.ValueByName('Type').AsInteger = 1;

ProjGather/ProjGather.pas

@@ -16,7 +16,12 @@ type
     FGclCompare: Integer;
 
     FTree: TProjGatherTree;
+
     FProjs: TList;
+    FCommonProjs: TList;
+    FSpecialProjs: TList;
+
+    FSpecialProjTypes: TStrings;
 
     FProjectData: TProjectData;
 
@@ -25,20 +30,31 @@ type
 
     function FindBillsNode(ANode: TBillsIDTreeNode; AParent: TProjGatherTreeNode): TProjGatherTreeNode;
     function CreateBillsNode(ANode: TBillsIDTreeNode; AParent: TProjGatherTreeNode): TProjGatherTreeNode;
-    procedure AddProjCalcData(AProjCalc: TProjCalc; ANode: TBillsIDTreeNode);
-    function GatherBillsNode(ANode: TBillsIDTreeNode; AParent: TProjGatherTreeNode;
-      AProjIndex: Integer): TProjGatherTreeNode;
-    procedure GatherBills(ANode: TBillsIDTreeNode; AParent: TProjGatherTreeNode; AProjIndex: Integer);
+    procedure AddProjCalcData(AProjCalc: TProjCalc; ANode: TMeasureBillsIDTreeNode);
 
+    function GatherBillsNode(ANode: TMeasureBillsIDTreeNode; AParent: TProjGatherTreeNode;
+      AProjIndex: Integer): TProjGatherTreeNode;
+    procedure GatherBills(ANode: TMeasureBillsIDTreeNode; AParent: TProjGatherTreeNode; AProjIndex: Integer);
     procedure GatherProj(AProj: TGatherProjInfo; AProjIndex: Integer);
+
+    function GatherSpecialBillsNode(ANode: TMeasureBillsIDTreeNode;
+      AParent: TProjGatherTreeNode; AProjType: Integer): TProjGatherTreeNode;
+    procedure GatherSpecialBills(ANode: TMeasureBillsIDTreeNode;
+      AParent: TProjGatherTreeNode; AProjType: Integer);
+    procedure GatherSpecialProj(AProj: TGatherProjInfo);
+
+    procedure FilterProjs;
   public
     constructor Create(AWriter: TWriteGatherData; AXmjCompare, AGclCompare: Integer);
     destructor Destroy; override;
 
-    procedure Gather(AProjs: TList);
-
-    property Projs: TList read FProjs;
+    procedure Gather(AProjs: TList; ASpecialProjTypes: TStrings);
+                                      
     property Tree: TProjGatherTree read FTree;
+    property Projs: TList read FProjs;
+    property CommonProj: TList read FCommonProjs;
+    property SpecialProj: TList read FSpecialProjs;
+    property SpecialProjTypes: TStrings read FSpecialProjTypes;
   end;
 
 implementation
@@ -49,7 +65,7 @@ uses
 { TProjGather }
 
 procedure TProjGather.AddProjCalcData(AProjCalc: TProjCalc;
-  ANode: TBillsIDTreeNode);
+  ANode: TMeasureBillsIDTreeNode);
 var
   StageRec: TStageRecord;
 begin
@@ -108,10 +124,24 @@ begin
   FWriter := AWriter;
   FXmjCompare := AXmjCompare;
   FGclCompare := AGclCompare;
+
+  FCommonProjs := TList.Create;
+  FSpecialProjs := TList.Create;
 end;
 
 function TProjGather.CreateBillsNode(ANode: TBillsIDTreeNode;
   AParent: TProjGatherTreeNode): TProjGatherTreeNode;
+
+  function GetB_CodeChapter(const AB_Code: string): Integer;
+  var
+    iValue, iError: Integer;
+  begin
+    Result := -1;
+    Val(AB_Code, iValue, iError);
+    if iValue > 0 then
+      Result := iValue div 100;
+  end;
+
 var
   vNextSibling: TProjGatherTreeNode;
 begin
@@ -130,14 +160,33 @@ begin
   Result.JieCode := ANode.Rec.JieCode.AsString;
   Result.XiMuCode := ANode.Rec.XimuCode.AsString;
   Result.IndexCode := ANode.Rec.IndexCode.AsString;
+  Result.B_CodeChapter := GetB_CodeChapter(Result.B_Code);
 end;
 
 destructor TProjGather.Destroy;
 begin
-
+  FCommonProjs.Free;
+  FSpecialProjs.Free;
   inherited;
 end;
 
+procedure TProjGather.FilterProjs;
+var
+  i: Integer;
+  vProjInfo: TSelectProjInfo;
+begin
+  FCommonProjs.Clear;
+  FSpecialProjs.Clear;
+  for i := 0 to FProjs.Count - 1 do
+  begin
+    vProjInfo := TSelectProjInfo(FProjs.Items[i]);
+    if vProjInfo.ProjType = 0 then
+      FCommonProjs.Add(vProjInfo)
+    else
+      FSpecialProjs.Add(vProjInfo);
+  end;
+end;
+
 function TProjGather.FindBillsNode(ANode: TBillsIDTreeNode;
   AParent: TProjGatherTreeNode): TProjGatherTreeNode;
 var
@@ -172,16 +221,20 @@ begin
     FProjectData.Free;
 end;
 
-procedure TProjGather.Gather(AProjs: TList);
+procedure TProjGather.Gather(AProjs: TList; ASpecialProjTypes: TStrings);
 var
   i: Integer;
 begin
   FProjs := AProjs;
-  FTree := TProjGatherTree.Create(FProjs.Count);
+  FilterProjs;
+  FSpecialProjTypes := ASpecialProjTypes;
+  FTree := TProjGatherTree.Create(FCommonProjs.Count, ASpecialProjTypes.Count);
   FTree.NewNodeID := 101;
   try
-    for i := 0 to FProjs.Count - 1 do
-      GatherProj(TGatherProjInfo(FProjs.Items[i]), i);
+    for i := 0 to FCommonProjs.Count - 1 do
+      GatherProj(TGatherProjInfo(FCommonProjs.Items[i]), i);
+    for i := 0 to FSpecialProjs.Count - 1 do
+      GatherSpecialProj(TGatherProjInfo(FSpecialProjs.Items[i]));
     FTree.CalculateAll;
     if Assigned(FWriter) then
       FWriter(Self);
@@ -190,7 +243,7 @@ begin
   end;
 end;
 
-procedure TProjGather.GatherBills(ANode: TBillsIDTreeNode;
+procedure TProjGather.GatherBills(ANode: TMeasureBillsIDTreeNode;
   AParent: TProjGatherTreeNode; AProjIndex: Integer);
 var
   vCur: TProjGatherTreeNode;
@@ -198,11 +251,11 @@ begin
   if not Assigned(ANode) then Exit;
 
   vCur := GatherBillsNode(ANode, AParent, AProjIndex);
-  GatherBills(TBillsIDTreeNode(ANode.FirstChild), vCur, AProjIndex);
-  GatherBills(TBillsIDTreeNode(ANode.NextSibling), AParent, AProjIndex );
+  GatherBills(TMeasureBillsIDTreeNode(ANode.FirstChild), vCur, AProjIndex);
+  GatherBills(TMeasureBillsIDTreeNode(ANode.NextSibling), AParent, AProjIndex );
 end;
 
-function TProjGather.GatherBillsNode(ANode: TBillsIDTreeNode;
+function TProjGather.GatherBillsNode(ANode: TMeasureBillsIDTreeNode;
   AParent: TProjGatherTreeNode; AProjIndex: Integer): TProjGatherTreeNode;
 begin
   Result := FindBillsNode(ANode, AParent);
@@ -223,6 +276,32 @@ begin
   end;
 end;
 
+procedure TProjGather.GatherSpecialProj(AProj: TGatherProjInfo);
+begin
+  if (AProj.ProjType > 0) and (AProj.ProjType <= FSpecialProjTypes.Count) then
+  begin
+    OpenProjectData(AProj);
+    try
+      with FProjectData.BillsMeasureData do
+        GatherSpecialBills(TMeasureBillsIDTreeNode(BillsMeasureTree.FirstNode), nil, AProj.ProjType);
+    finally
+      FreeProjectData;
+    end;
+  end;
+end;
+
+procedure TProjGather.GatherSpecialBills(ANode: TMeasureBillsIDTreeNode;
+  AParent: TProjGatherTreeNode; AProjType: Integer);
+var
+  vCur: TProjGatherTreeNode;
+begin
+  if not Assigned(ANode) then Exit;
+
+  vCur := GatherSpecialBillsNode(ANode, AParent, AProjType);
+  GatherSpecialBills(TMeasureBillsIDTreeNode(ANode.FirstChild), vCur, AProjType);
+  GatherSpecialBills(TMeasureBillsIDTreeNode(ANode.NextSibling), AParent, AProjType );
+end;
+
 procedure TProjGather.OpenProjectData(AProj: TGatherProjInfo);
 begin
   FProjectData := OpenProjectManager.FindProjectData(AProj.ProjectID);
@@ -233,4 +312,14 @@ begin
   end;
 end;
 
+function TProjGather.GatherSpecialBillsNode(
+  ANode: TMeasureBillsIDTreeNode; AParent: TProjGatherTreeNode;
+  AProjType: Integer): TProjGatherTreeNode;
+begin
+  Result := FindBillsNode(ANode, AParent);
+  if not Assigned(Result) then
+    Result := CreateBillsNode(ANode, AParent);
+  AddProjCalcData(Result.SpecialProj[AProjType - 1], ANode);
+end;
+
 end.

ProjGather/ProjGatherSelectFrm.dfm

@@ -1,7 +1,7 @@
 object ProjGatherSelectForm: TProjGatherSelectForm
   Left = 454
   Top = 235
-  Width = 735
+  Width = 758
   Height = 554
   Caption = #36873#25321#27719#24635#39033#30446
   Color = clBtnFace
@@ -12,7 +12,7 @@ object ProjGatherSelectForm: TProjGatherSelectForm
   Font.Style = []
   OldCreateOrder = False
   DesignSize = (
-    727
+    750
     523)
   PixelsPerInch = 96
   TextHeight = 12
@@ -67,22 +67,24 @@ object ProjGatherSelectForm: TProjGatherSelectForm
   object zgResult: TZJGrid
     Left = 384
     Top = 24
-    Width = 337
+    Width = 360
     Height = 457
     OptionsEx = []
     ColCount = 2
     RowCount = 1
     ShowGridLine = False
-    DefaultColWidth = 200
+    DefaultColWidth = 308
     DefaultFixedColWidth = 25
     DefaultFixedRowHeight = 25
     Selection.AlphaBlend = False
     Selection.TransparentColor = False
     FrozenCol = 0
     FrozenRow = 0
+    OnGetCellText = zgResultGetCellText
+    OnSetCellText = zgResultSetCellText
   end
   object btnOk: TButton
-    Left = 560
+    Left = 583
     Top = 489
     Width = 74
     Height = 25
@@ -92,7 +94,7 @@ object ProjGatherSelectForm: TProjGatherSelectForm
     OnClick = btnOkClick
   end
   object btnCancel: TButton
-    Left = 647
+    Left = 670
     Top = 489
     Width = 74
     Height = 25

ProjGather/ProjGatherSelectFrm.pas

@@ -5,7 +5,7 @@ interface
 uses
   sdIDTree, sdDB,
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
-  Dialogs, sdGridDBA, sdGridTreeDBA, StdCtrls, ZJGrid;
+  Dialogs, sdGridDBA, sdGridTreeDBA, StdCtrls, ZJGrid, ZJCells;
 
 type
   TProjGatherSelectForm = class(TForm)
@@ -26,10 +26,16 @@ type
     procedure zgSelectProjectDrawCellText(ACanvas: TCanvas;
       const ARect: TRect; const ACoord: TPoint; AGrid: TZJGrid;
       const Text: String; var ADefaultDraw: Boolean);
+    procedure zgResultGetCellText(Sender: TObject; const ACoord: TPoint;
+      var Value: String; DisplayText: Boolean);
+    procedure zgResultSetCellText(Sender: TObject; const ACoord: TPoint;
+      var Value: String; DisplayText: Boolean);
   private
     FProjectID: Integer;
     FValidProjs: TList;
     FSelectProjs: TList;
+    FSpecialProjTypes: TStrings;
+    FSpecialProjIDs: array of Integer;
 
     function HasSelect(AProjectID: Integer): Boolean;
 
@@ -47,26 +53,26 @@ type
 
     procedure LoadHistorySelects(AProjs: TList);
   public
-    constructor Create(AProjectID: Integer; AProjs: TList);
+    constructor Create(AProjectID: Integer; AProjs: TList; ASpecialProjTypes: TStrings);
     destructor Destroy; override;
 
     procedure AssignResult(AProjs: TList);
   end;
 
-function SelectGatherProject(AProjectID: Integer; AOrgProjs, ANewProjs: TList): Boolean;
+function SelectGatherProject(AProjectID: Integer; AOrgProjs, ANewProjs: TList; ASpecialProjTypes: TStrings = nil): Boolean;
 
 implementation
 
 uses
-  Globals, GatherProjInfo, MainFrm;
+  Globals, GatherProjInfo, MainFrm, Math, ZhAPI;
 
 {$R *.dfm}
 
-function SelectGatherProject(AProjectID: Integer; AOrgProjs, ANewProjs: TList): Boolean;
+function SelectGatherProject(AProjectID: Integer; AOrgProjs, ANewProjs: TList; ASpecialProjTypes: TStrings = nil): Boolean;
 var
   vSelectFrm: TProjGatherSelectForm;
 begin
-  vSelectFrm := TProjGatherSelectForm.Create(AProjectID, AOrgProjs);
+  vSelectFrm := TProjGatherSelectForm.Create(AProjectID, AOrgProjs, ASpecialProjTypes);
   try
     Result := vSelectFrm.ShowModal = mrOk;
     if Result then
@@ -98,12 +104,22 @@ begin
 end;
 
 constructor TProjGatherSelectForm.Create(AProjectID: Integer;
-  AProjs: TList);
+  AProjs: TList; ASpecialProjTypes: TStrings);
+var
+  i: Integer;
 begin
   inherited Create(nil);
   ClientHeight := 523;
-  ClientWidth := 727;
+  ClientWidth := 750;
   FProjectID := AProjectID;
+  FSpecialProjTypes := ASpecialProjTypes;
+  if FSpecialProjTypes <> nil then
+  begin
+    SetLength(FSpecialProjIDs, FSpecialProjTypes.Count);
+    for i := 0 to ASpecialProjTypes.Count - 1 do
+      FSpecialProjIDs[i] := -1;
+  end;
+
   FValidProjs := TList.Create;
   FilterValidProject;
   ProjectManager.sdvProjectsSpare.OnFilterRecord := DoOnFilterRecord;
@@ -171,9 +187,15 @@ end;
 procedure TProjGatherSelectForm.RemoveProjs(ANode: TsdIDTreeNode);
 var
   iChild: Integer;
+  i: Integer;
 begin
   if FSelectProjs.IndexOf(Pointer(ANode.ID)) <> -1 then
+  begin
     FSelectProjs.Remove(Pointer(ANode.id));
+    for i := Low(FSpecialProjIDs) to High(FSpecialProjIDs) do
+      if FSpecialProjIDs[i] = ANode.ID then
+        FSpecialProjIDs[i] := -1;
+  end;
   for iChild := 0 to ANode.ChildCount - 1 do
     RemoveProjs(ANode.ChildNodes[iChild]);
 end;
@@ -217,11 +239,24 @@ end;
 procedure TProjGatherSelectForm.AssignSelectTenders;
 
   procedure InitResultGrid;
+  var
+    i: Integer;
   begin
     zgResult.ColCount := 2;
     zgResult.RowCount := 1;
     zgResult.Cells[1, 0].Text := 'ËùÑ¡ÏîÄ¿';
-    zgResult.ColWidths[1] := 270;
+    zgResult.ColWidths[1] := 308;
+    if Assigned(FSpecialProjTypes) then
+    begin
+      zgResult.ColWidths[1] := 308 - (Min(FSpecialProjTypes.Count, 2)*45);
+      for i := 0 to FSpecialProjTypes.Count - 1 do
+      begin
+        zgResult.ColCount := zgResult.ColCount + 1;
+        zgResult.Cells[2+i, 0].Text := FSpecialProjTypes.Strings[i];
+        zgResult.ColWidths[2+i] := 45;
+        zgResult.CellClass.Cols[2+i] := TZjCheckBoxCell;
+      end;
+    end;
   end;
   
 var
@@ -247,9 +282,15 @@ end;
 procedure TProjGatherSelectForm.LoadHistorySelects(AProjs: TList);
 var
   i: Integer;
+  vGatherProjInfo: TGatherProjInfo;
 begin
   for i := 0 to AProjs.Count - 1 do
-    FSelectProjs.Add(Pointer(TGatherProjInfo(AProjs.Items[i]).ProjectID));
+  begin
+    vGatherProjInfo := TGatherProjInfo(AProjs.Items[i]);
+    FSelectProjs.Add(Pointer(vGatherProjInfo.ProjectID));
+    if (vGatherProjInfo.ProjType > 0) and (vGatherProjInfo.ProjType <= FSpecialProjTypes.Count) then
+      FSpecialProjIDs[vGatherProjInfo.ProjType-1] := vGatherProjInfo.ProjectID;
+  end;
 end;
 
 procedure TProjGatherSelectForm.btnOkClick(Sender: TObject);
@@ -259,15 +300,32 @@ begin
 end;
 
 procedure TProjGatherSelectForm.AssignResult(AProjs: TList);
+
+  function SpecialProjType(AID: Integer): Integer;
+  var
+    i: Integer;
+  begin
+    Result := 0;
+    for i := Low(FSpecialProjIDs) to High(FSpecialProjIDs) do
+    begin
+      if AID = FSpecialProjIDs[i] then
+      begin
+        Result := i+1;
+        Break;
+      end;
+    end;
+  end;
+
 var
   iRow: Integer;
   stnNode: TsdIDTreeNode;
   vGatherProj: TGatherProjInfo;
 begin
+  AProjs.Clear;
   for iRow := 1 to zgResult.RowCount - 1 do
   begin
     stnNode := TsdIDTreeNode(zgResult.Rows[iRow].Data);
-    vGatherProj := TGatherProjInfo.Create(stnNode.Rec);
+    vGatherProj := TGatherProjInfo.Create(stnNode.Rec, SpecialProjType(stnNode.ID));
     AProjs.Add(vGatherProj);
   end;
 end;
@@ -320,4 +378,42 @@ begin
   end;
 end;
 
+procedure TProjGatherSelectForm.zgResultGetCellText(Sender: TObject;
+  const ACoord: TPoint; var Value: String; DisplayText: Boolean);
+begin
+  if (ACoord.X > 1) and (ACoord.Y > 0) then
+  begin
+    if Assigned(zgResult.Rows[ACoord.Y].Data) and (TsdIDTreeNode(zgResult.Rows[ACoord.Y].Data).ID = FSpecialProjIDs[ACoord.X-2]) then
+      Value := 'True'
+    else
+      Value := 'False';
+  end;
+end;
+
+procedure TProjGatherSelectForm.zgResultSetCellText(Sender: TObject;
+  const ACoord: TPoint; var Value: String; DisplayText: Boolean);
+var
+  iProjID, i: Integer;
+  stnNode: TsdIDTreeNode;
+begin
+  if (ACoord.X > 1) and (ACoord.Y > 0) then
+  begin
+    stnNode := TsdIDTreeNode(zgResult.Rows[ACoord.Y].Data);
+    iProjID := stnNode.ID;
+    if FSpecialProjIDs[ACoord.X-2] <> iProjID then
+    begin
+      for i := Low(FSpecialProjIDs) to High(FSpecialProjIDs) do
+      begin
+        if FSpecialProjIDs[i] = iProjID then
+          FSpecialProjIDs[i] := -1
+      end;
+      FSpecialProjIDs[ACoord.X-2] := iProjID;
+    end
+    else
+      FSpecialProjIDs[ACoord.X-2] := -1;
+    for i := 0 to FSpecialProjTypes.Count - 1 do
+      zgResult.InvalidateCol(i+2);
+  end;
+end;
+
 end.

ProjGather/ProjGatherTree.pas

@@ -19,17 +19,21 @@ type
     FMuCode: string;
     FJieCode: string;
     FXiMuCode: string;
-    FIndexCode: string;
+    FIndexCode: string;  
+    FB_CodeChapter: Integer;
     FChapterParentID: Integer;
 
     FGatherCalc: TProjCalc;
     FProjs: TList;
+    FSpecialProjs: TList;
     function GetProjCount: Integer;
     function GetProj(AIndex: Integer): TProjCalc;
     function GetChapterParentID: Integer;
     function GetLevel: Integer;
+    function GetSpecialProj(AIndex: Integer): TProjCalc;
+    function GetSpecialProjCount: Integer;
   public
-    constructor Create(ACacheTree: TCacheTree; AID: Integer; AProjCount: Integer);
+    constructor Create(ACacheTree: TCacheTree; AID: Integer; AProjCount, ASpeicalProjCount: Integer);
     destructor Destroy; override;
 
     procedure InitTotalPrice_Rc;
@@ -52,7 +56,9 @@ type
     property MuCode: string read FMuCode write FMuCode;
     property JieCode: string read FJieCode write FJieCode;
     property XiMuCode: string read FXiMuCode write FXiMuCode;
+
     property IndexCode: string read FIndexCode write FIndexCode;
+    property B_CodeChapter: Integer read FB_CodeChapter write FB_CodeChapter;
 
     property Level: Integer read GetLevel;
     property ChapterParentID: Integer read GetChapterParentID;
@@ -61,11 +67,15 @@ type
 
     property ProjCount: Integer read GetProjCount;
     property Proj[AIndex: Integer]: TProjCalc read GetProj;
+
+    property SpecialProjCount: Integer read GetSpecialProjCount;
+    property SpecialProj[AIndex: Integer]: TProjCalc read GetSpecialProj;
   end;
 
   TProjGatherTree = class(TCacheTree)
   private
     FProjCount: Integer;
+    FSpecialProjCount: Integer;
     FFixedIDNodes: TList;
     FGatherNode: TProjGatherTreeNode;
 
@@ -75,7 +85,7 @@ type
     procedure Calculate(ANode: TProjGatherTreeNode);
     procedure CalcGatherNode;
   public
-    constructor Create(AProjCount: Integer);
+    constructor Create(AProjCount, ASpecialProjCount: Integer);
     destructor Destroy; override;
 
     function AddNode(AParent, ANextSibling: TProjGatherTreeNode; AFixedID: Integer = -1): TProjGatherTreeNode;
@@ -93,6 +103,8 @@ type
     procedure SaveDebugFile(const AFileName: string);
 
     property GatherNode: TProjGatherTreeNode read FGatherNode;
+    property ProjCount: Integer read FProjCount;
+    property SpecialProjCount: Integer read FSpecialProjCount;
   end;
 
 implementation
@@ -120,7 +132,7 @@ begin
     Proj[iProj].CalcTotalPrice_Rc(Price);
 end;
 
-constructor TProjGatherTreeNode.Create(ACacheTree: TCacheTree; AID: Integer; AProjCount: Integer);
+constructor TProjGatherTreeNode.Create(ACacheTree: TCacheTree; AID: Integer; AProjCount, ASpeicalProjCount: Integer);
 var
   i: Integer;
   ProjCalc: TProjCalc;
@@ -133,6 +145,12 @@ begin
     ProjCalc := TProjCalc.Create;
     FProjs.Add(ProjCalc);
   end;
+  FSpecialProjs := TList.Create;
+  for i := 0 to ASpeicalProjCount - 1 do
+  begin
+    ProjCalc := TProjCalc.Create;
+    FSpecialProjs.Add(ProjCalc);
+  end;
 end;
 
 destructor TProjGatherTreeNode.Destroy;
@@ -140,6 +158,8 @@ begin
   FGatherCalc.free;
   ClearObjects(FProjs);
   FProjs.Free;
+  ClearObjects(FSpecialProjs);
+  FSpecialProjs.Free;
   inherited;
 end;
 
@@ -175,6 +195,16 @@ begin
   Result := FProjs.Count;
 end;
 
+function TProjGatherTreeNode.GetSpecialProj(AIndex: Integer): TProjCalc;
+begin
+  Result := TProjCalc(FSpecialProjs.Items[AIndex]);
+end;
+
+function TProjGatherTreeNode.GetSpecialProjCount: Integer;
+begin
+  Result := FSpecialProjs.Count;
+end;
+
 procedure TProjGatherTreeNode.InitCalcData;
 var
   iProj: Integer;
@@ -249,12 +279,13 @@ begin
   CalcGatherNode;
 end;
 
-constructor TProjGatherTree.Create(AProjCount: Integer);
+constructor TProjGatherTree.Create(AProjCount, ASpecialProjCount: Integer);
 begin
   inherited Create;
   FProjCount := AProjCount;
+  FSpecialProjCount := ASpecialProjCount;
   FFixedIDNodes := TList.Create;
-  FGatherNode := TProjGatherTreeNode.Create(nil, -2, AProjCount);
+  FGatherNode := TProjGatherTreeNode.Create(nil, -2, AProjCount, ASpecialProjCount);
 end;
 
 destructor TProjGatherTree.Destroy;
@@ -375,11 +406,11 @@ function TProjGatherTree.GetNewNode(AFixedID: Integer): TProjGatherTreeNode;
 begin
   if AFixedID <> -1 then
   begin
-    Result := TProjGatherTreeNode.Create(Self, AFixedID, FProjCount);
+    Result := TProjGatherTreeNode.Create(Self, AFixedID, FProjCount, FSpecialProjCount);
     FFixedIDNodes.Add(Result);
   end
   else
-    Result := TProjGatherTreeNode.Create(Self, GetNewNodeID, FProjCount);
+    Result := TProjGatherTreeNode.Create(Self, GetNewNodeID, FProjCount, FSpecialProjCount);
   CacheNodes.Add(Result);
 end;
 

Report/ProjGather/rProjGatherTables.pas

@@ -7,8 +7,10 @@ uses
 
 const
   SGatherProj = 'r_GatherProj';
-  tdGatherProj: array [0..2] of TScFieldDef =(
+  tdGatherProj: array [0..3] of TScFieldDef =(
     (FieldName: 'ID'; FieldType: ftInteger; Size: 0; Precision: 0; NotNull: True; PrimaryKey: True; ForceUpdate: False),
+    // 标段类型
+    (FieldName: 'ProjType'; FieldType: ftInteger; Size: 0; Precision: 0; NotNull: True; PrimaryKey: True; ForceUpdate: False),
     // 标段 -- 项目管理ID
     (FieldName: 'ProjectID'; FieldType: ftInteger; Size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
     // 标段 -- 名称
@@ -16,7 +18,7 @@ const
   );
 
   SBills = 'r_Bills';
-  tdBills: array [0..15] of TScFieldDef =(
+  tdBills: array [0..16] of TScFieldDef =(
     (FieldName: 'ID'; FieldType: ftInteger; Size: 0; Precision: 0; NotNull: True; PrimaryKey: True; ForceUpdate: False),
     (FieldName: 'ParentID'; FieldType: ftInteger; Size: 0; Precision: 0; NotNull: True; PrimaryKey: False; ForceUpdate: False),
     (FieldName: 'NextSiblingID'; FieldType: ftInteger; Size: 0; Precision: 0; NotNull: True; PrimaryKey: False; ForceUpdate: False),
@@ -49,18 +51,25 @@ const
     // 工程量清单排序编号
     (FieldName: 'IndexCode'; FieldType: ftString; Size: 50; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
     // 章级父项ID
-    (FieldName: 'ChapterParentID'; FieldType: ftInteger; size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False)
+    (FieldName: 'ChapterParentID'; FieldType: ftInteger; size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 清单编号所属章级
+    (FieldName: 'B_CodeChapter'; FieldType: ftInteger; Size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False)
     //--8
   );
 
   SBills_Gather = 'r_Bills_Gather'; // 合计, 默认ProjID为 -2
   SBills_Proj = 'r_Bills_Proj'; // 存在N个项目则，有r_Bills_Proj1 ... r_Bills_ProjN，分别存储个项目数据
   SBills_TransProj = 'r_Bills_TransProj'; // 合并所有的r_Bills_Proj
-  tdBills_Calc: array [0..73] of TScFieldDef =(
+  // 此部分数据不汇总至r_Bills_Gather
+  SBills_SProj = 'r_Bills_SProj';
+
+  tdBills_Calc: array [0..74] of TScFieldDef =(
     // 与Bills表ID对应
     (FieldName: 'ID'; FieldType: ftInteger; Size: 0; Precision: 0; NotNull: True; PrimaryKey: True; ForceUpdate: False),
     // 对应于r_GatherProj中的ID字段
     (FieldName: 'ProjID'; FieldType: ftInteger; Size: 0; Precision: 0; NotNull: True; PrimaryKey: True; ForceUpdate: False),
+    // 项目类型（r_Bills_SProj使用，用于标记非正常汇总项目）
+    (FieldName: 'ProjType'; FieldType: ftInteger; Size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
 
     // 施工图原设计 -- 数量
     (FieldName: 'OrgQuantity'; FieldType: ftDouble; Size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),

Report/ProjGather/rpgBillsCalcDm.pas

@@ -10,12 +10,16 @@ type
     sdpBillsCalc: TsdADOProvider;
     sddBillsCalc: TsdDataSet;
   private
-    procedure SaveBillsNodeCalc(ANode: TProjGatherTreeNode; AProjCalc: TProjCalc; AProjIndex: Integer);
-    procedure SaveBillsCalc(ATree: TProjGatherTree; AProjIndex: Integer);
+    FProjIndex: Integer;
+    FProjType: Integer;
+
+    procedure SaveBillsNodeCalc(ANode: TProjGatherTreeNode; AProjCalc: TProjCalc);
+    procedure SaveBillsCalc(ATree: TProjGatherTree);
     procedure SaveBillsGather(ATree: TProjGatherTree);
   public
     constructor Create(AConnection: TADOConnection);
 
+    procedure SaveSpecialProjDataTo(ATree: TProjGatherTree; AProjType: Integer; const ATableName: string);
     procedure SaveProjDataTo(ATree: TProjGatherTree; AProjIndex: Integer; const ATableName: string);
     procedure SaveGatherDataTo(ATree: TProjGatherTree; const ATableName: string);
   end;
@@ -34,8 +38,7 @@ begin
   sdpBillsCalc.Connection := AConnection;
 end;
 
-procedure TrpgBillsCalcData.SaveBillsCalc(ATree: TProjGatherTree;
-  AProjIndex: Integer);
+procedure TrpgBillsCalcData.SaveBillsCalc(ATree: TProjGatherTree);
 var
   iNode: Integer;
   vNode: TProjGatherTreeNode;
@@ -43,7 +46,10 @@ begin
   for iNode := 0 to ATree.CacheNodes.Count - 1 do
   begin
     vNode := TProjGatherTreeNode(ATree.CacheNodes.Items[iNode]);
-    SaveBillsNodeCalc(vNode, vNode.Proj[AProjIndex], AProjIndex);
+    if FProjType = 0 then
+      SaveBillsNodeCalc(vNode, vNode.Proj[FProjIndex])
+    else if FProjType > 0 then
+      SaveBillsNodeCalc(vNode, vNode.SpecialProj[FProjType-1]);
   end;
 end;
 
@@ -55,18 +61,19 @@ begin
   for iNode := 0 to ATree.CacheNodes.Count - 1 do
   begin
     vNode := TProjGatherTreeNode(ATree.CacheNodes.Items[iNode]);
-    SaveBillsNodeCalc(vNode, vNode.GatherCalc, -2);
+    SaveBillsNodeCalc(vNode, vNode.GatherCalc);
   end;
 end;
 
 procedure TrpgBillsCalcData.SaveBillsNodeCalc(ANode: TProjGatherTreeNode;
-  AProjCalc: TProjCalc; AProjIndex: Integer);
+  AProjCalc: TProjCalc);
 var
   Rec: TsdDataRecord;
 begin
   Rec := sddBillsCalc.Add;
   Rec.ValueByName('ID').AsInteger := ANode.ID;
-  Rec.ValueByName('ProjID').AsInteger := AProjIndex;
+  Rec.ValueByName('ProjID').AsInteger := FProjIndex;
+  Rec.ValueByName('ProjType').AsInteger := FProjType;
 
   Rec.ValueByName('OrgQuantity').AsFloat := AProjCalc.Compile.Org.Quantity;
   Rec.ValueByName('OrgTotalPrice').AsFloat := AProjCalc.Compile.Org.TotalPrice;
@@ -132,12 +139,15 @@ end;
 procedure TrpgBillsCalcData.SaveGatherDataTo(ATree: TProjGatherTree;
   const ATableName: string);
 begin
+  FProjIndex := -2;
+  FProjType := 0;
+
   sdpBillsCalc.TableName := ATableName;
   sddBillsCalc.Open;
   sddBillsCalc.BeginUpdate;
   try
     SaveBillsGather(ATree);
-    SaveBillsNodeCalc(ATree.GatherNode, ATree.GatherNode.GatherCalc, -2);
+    SaveBillsNodeCalc(ATree.GatherNode, ATree.GatherNode.GatherCalc);
   finally
     sddBillsCalc.EndUpdate;
     sddBillsCalc.Save;
@@ -147,12 +157,33 @@ end;
 procedure TrpgBillsCalcData.SaveProjDataTo(ATree: TProjGatherTree; AProjIndex: Integer;
   const ATableName: string);
 begin
+  FProjIndex := AProjIndex;
+  FProjType := 0;
+
+  sdpBillsCalc.TableName := ATableName;
+  sddBillsCalc.Open;
+  sddBillsCalc.BeginUpdate;
+  try
+    SaveBillsCalc(ATree);
+    SaveBillsNodeCalc(ATree.GatherNode, ATree.GatherNode.Proj[AProjIndex]);
+  finally
+    sddBillsCalc.EndUpdate;
+    sddBillsCalc.Save;
+  end;
+end;
+
+procedure TrpgBillsCalcData.SaveSpecialProjDataTo(ATree: TProjGatherTree;
+  AProjType: Integer; const ATableName: string);
+begin
+  FProjIndex := -3;
+  FProjType := AProjType;
+
   sdpBillsCalc.TableName := ATableName;
   sddBillsCalc.Open;
   sddBillsCalc.BeginUpdate;
   try
-    SaveBillsCalc(ATree, AProjIndex);
-    SaveBillsNodeCalc(ATree.GatherNode, ATree.GatherNode.Proj[AProjIndex], AProjIndex);
+    SaveBillsCalc(ATree);
+    SaveBillsNodeCalc(ATree.GatherNode, ATree.GatherNode.SpecialProj[AProjType-1]);
   finally
     sddBillsCalc.EndUpdate;
     sddBillsCalc.Save;

Report/ProjGather/rpgBillsDm.dfm

@@ -16,44 +16,57 @@ object rpgBillsData: TrpgBillsData
     FieldListData = {
       0101044E616D6506024944094669656C644E616D650602494408446174615479
       70650203084461746153697A6502040549734B6579080F4E65656450726F6365
-      73734E616D65090001044E616D650608506172656E744944094669656C644E61
-      6D650608506172656E7449440844617461547970650203084461746153697A65
-      02040549734B6579080F4E65656450726F636573734E616D65090001044E616D
-      65060D4E6578745369626C696E674944094669656C644E616D65060D4E657874
-      5369626C696E6749440844617461547970650203084461746153697A65020405
-      49734B6579080F4E65656450726F636573734E616D65090001044E616D650604
-      436F6465094669656C644E616D650604436F6465084461746154797065021808
-      4461746153697A6502320549734B6579080F4E65656450726F636573734E616D
-      65090001044E616D650606425F436F6465094669656C644E616D650606425F43
-      6F64650844617461547970650218084461746153697A6502320549734B657908
-      0F4E65656450726F636573734E616D65090001044E616D6506044E616D650946
-      69656C644E616D6506044E616D65084461746154797065021808446174615369
-      7A6503FF000549734B6579080F4E65656450726F636573734E616D6509000104
-      4E616D650605556E697473094669656C644E616D650605556E69747308446174
-      61547970650218084461746153697A6502140549734B6579080F4E6565645072
-      6F636573734E616D65090001044E616D6506055072696365094669656C644E61
-      6D65060550726963650844617461547970650206084461746153697A65020805
-      49734B6579080F4E65656450726F636573734E616D65090001044E616D650608
-      53657269616C4E6F094669656C644E616D65060853657269616C4E6F08446174
-      61547970650203084461746153697A6502040549734B6579080F4E6565645072
-      6F636573734E616D65090001044E616D65060649734C656166094669656C644E
-      616D65060649734C6561660844617461547970650205084461746153697A6502
-      010549734B6579080F4E65656450726F636573734E616D65090001044E616D65
-      06095869616E67436F6465094669656C644E616D6506095869616E67436F6465
+      73734E616D650909507265636973696F6E02000453697A6502000001044E616D
+      650608506172656E744944094669656C644E616D650608506172656E74494408
+      44617461547970650203084461746153697A6502040549734B6579080F4E6565
+      6450726F636573734E616D650909507265636973696F6E02000453697A650200
+      0001044E616D65060D4E6578745369626C696E674944094669656C644E616D65
+      060D4E6578745369626C696E6749440844617461547970650203084461746153
+      697A6502040549734B6579080F4E65656450726F636573734E616D6509095072
+      65636973696F6E02000453697A6502000001044E616D650604436F6465094669
+      656C644E616D650604436F64650844617461547970650218084461746153697A
+      6502320549734B6579080F4E65656450726F636573734E616D65090950726563
+      6973696F6E02000453697A6502000001044E616D650606425F436F6465094669
+      656C644E616D650606425F436F64650844617461547970650218084461746153
+      697A6502320549734B6579080F4E65656450726F636573734E616D6509095072
+      65636973696F6E02000453697A6502000001044E616D6506044E616D65094669
+      656C644E616D6506044E616D650844617461547970650218084461746153697A
+      6503FF000549734B6579080F4E65656450726F636573734E616D650909507265
+      636973696F6E02000453697A6502000001044E616D650605556E697473094669
+      656C644E616D650605556E697473084461746154797065021808446174615369
+      7A6502140549734B6579080F4E65656450726F636573734E616D650909507265
+      636973696F6E02000453697A6502000001044E616D6506055072696365094669
+      656C644E616D6506055072696365084461746154797065020608446174615369
+      7A6502080549734B6579080F4E65656450726F636573734E616D650909507265
+      636973696F6E02000453697A6502000001044E616D65060853657269616C4E6F
+      094669656C644E616D65060853657269616C4E6F084461746154797065020308
+      4461746153697A6502040549734B6579080F4E65656450726F636573734E616D
+      650909507265636973696F6E02000453697A6502000001044E616D6506064973
+      4C656166094669656C644E616D65060649734C65616608446174615479706502
+      05084461746153697A6502010549734B6579080F4E65656450726F636573734E
+      616D650909507265636973696F6E02000453697A6502000001044E616D650609
+      5869616E67436F6465094669656C644E616D6506095869616E67436F64650844
+      617461547970650218084461746153697A65020A0549734B6579080F4E656564
+      50726F636573734E616D650909507265636973696F6E02000453697A65020000
+      01044E616D6506064D75436F6465094669656C644E616D6506064D75436F6465
       0844617461547970650218084461746153697A65020A0549734B6579080F4E65
-      656450726F636573734E616D65090001044E616D6506064D75436F6465094669
-      656C644E616D6506064D75436F64650844617461547970650218084461746153
-      697A65020A0549734B6579080F4E65656450726F636573734E616D6509000104
-      4E616D6506074A6965436F6465094669656C644E616D6506074A6965436F6465
-      0844617461547970650218084461746153697A65020A0549734B6579080F4E65
-      656450726F636573734E616D65090001044E616D65060858696D75436F646509
-      4669656C644E616D65060858696D75436F646508446174615479706502180844
-      61746153697A65021E0549734B6579080F4E65656450726F636573734E616D65
-      090001044E616D650609496E646578436F6465094669656C644E616D65060949
-      6E646578436F64650844617461547970650218084461746153697A6502320549
-      734B6579080F4E65656450726F636573734E616D65090001044E616D65060F43
-      686170746572506172656E744944094669656C644E616D65060F436861707465
-      72506172656E7449440844617461547970650203084461746153697A65020405
-      49734B6579080F4E65656450726F636573734E616D65090000}
+      656450726F636573734E616D650909507265636973696F6E02000453697A6502
+      000001044E616D6506074A6965436F6465094669656C644E616D6506074A6965
+      436F64650844617461547970650218084461746153697A65020A0549734B6579
+      080F4E65656450726F636573734E616D650909507265636973696F6E02000453
+      697A6502000001044E616D65060858696D75436F6465094669656C644E616D65
+      060858696D75436F64650844617461547970650218084461746153697A65021E
+      0549734B6579080F4E65656450726F636573734E616D65090950726563697369
+      6F6E02000453697A6502000001044E616D650609496E646578436F6465094669
+      656C644E616D650609496E646578436F64650844617461547970650218084461
+      746153697A6502320549734B6579080F4E65656450726F636573734E616D6509
+      09507265636973696F6E02000453697A6502000001044E616D65060F43686170
+      746572506172656E744944094669656C644E616D65060F436861707465725061
+      72656E7449440844617461547970650203084461746153697A6502040549734B
+      6579080F4E65656450726F636573734E616D650909507265636973696F6E0200
+      0453697A6502000001044E616D65060D425F436F646543686170746572094669
+      656C644E616D65060D425F436F64654368617074657208446174615479706502
+      03084461746153697A6502040549734B6579080F4E65656450726F636573734E
+      616D650909507265636973696F6E02000453697A6502000000}
   end
 end

Report/ProjGather/rpgBillsDm.pas

@@ -62,6 +62,7 @@ begin
   Rec.ValueByName('XimuCode').AsString := ANode.XimuCode;
   Rec.ValueByName('IndexCode').AsString := ANode.IndexCode;
   Rec.ValueByName('ChapterParentID').AsInteger := ANode.ChapterParentID;
+  Rec.ValueByName('B_CodeChapter').AsInteger := ANode.B_CodeChapter;
 end;
 
 procedure TrpgBillsData.SaveDataTo(ATree: TProjGatherTree; const ATableName: string);

Report/ProjGather/rpgGatherControl.pas

@@ -3,13 +3,15 @@ unit rpgGatherControl;
 interface
 
 uses
-  Classes, rpgGatherData, ADODB;
+  Classes, rpgGatherData, ADODB, ReportManager;
 
 type
   TrpgGatherControl = class
   private
     // 当前打开项目，根据其筛选项目
     FProjectID: Integer;
+    // 当前汇总的报表 -- 主要用于读取报表中的附加信息
+    FTemplate: TTemplateNode;
     FHistroyProjs: TList;
     // 选择的汇总项目
     FSelectProjs: TList;
@@ -24,13 +26,14 @@ type
     constructor Create(AProjectID: Integer);
     destructor Destroy; override;
 
-    function RefreshConnection: TADOConnection;
+    function RefreshConnection(ATemplate: TTemplateNode): TADOConnection;
   end;
 
 implementation
 
 uses
-  ZhAPI, GatherProjInfo, ProjGather, ProjGatherSelectFrm, Globals;
+  ZhAPI, GatherProjInfo, ProjGather, ProjGatherSelectFrm, Globals, Forms,
+  Controls;
 
 { TrpgGatherControl }
 
@@ -45,17 +48,22 @@ end;
 destructor TrpgGatherControl.Destroy;
 begin
   FGatherData.Free;
-  ClearObjects(FSelectProjs);
   FSelectProjs.Free;
   ClearObjects(FHistroyProjs);
   FHistroyProjs.Free;
   inherited;
 end;
 
-function TrpgGatherControl.RefreshConnection: TADOConnection;
+function TrpgGatherControl.RefreshConnection(ATemplate: TTemplateNode): TADOConnection;
 begin
-  if SelectProject and not SameSelect then
-    RefreshGather;
+  FTemplate := ATemplate;
+  if SelectProject then
+  begin
+   if not SameSelect then
+     RefreshGather
+   else if Assigned(ATemplate.InteractInfo) then
+     FGatherData.UpdateDataBase(ATemplate.InteractInfo.SpecialProjGatherTypes);
+  end;
   Result := FGatherData.Connection;
 end;
 
@@ -63,15 +71,20 @@ procedure TrpgGatherControl.RefreshGather;
 var
   Gather: TProjGather;
 begin
+  Screen.Cursor := crHourGlass;
   Gather := TProjGather.Create(FGatherData.WriteGatherData,
     ReportConfig.XmjCompare, ReportConfig.GclCompare);
   try
-    Gather.Gather(FSelectProjs);
+    if Assigned(FTemplate.InteractInfo) then
+      Gather.Gather(FSelectProjs, FTemplate.InteractInfo.SpecialProjGatherTypes)
+    else
+      Gather.Gather(FSelectProjs, nil);
     FGatherData.LoadRelaData(FProjectID);
     ClearObjects(FHistroyProjs);
     FHistroyProjs.Assign(FSelectProjs);
   finally
     Gather.Free;
+    Screen.Cursor := crDefault;
   end;
 end;
 
@@ -80,11 +93,13 @@ function TrpgGatherControl.SameSelect: Boolean;
   function IncludeProj(AList: TList; AProj: TGatherProjInfo): Boolean;
   var
     i: Integer;
+    vProj: TGatherProjInfo;
   begin
     Result := False;
     for i := 0 to AList.Count - 1 do
     begin
-      if AProj.ProjectID = TGatherProjInfo(AList.Items[i]).ProjectID then
+      vProj := TGatherProjInfo(AList.Items[i]);
+      if (AProj.ProjectID = vProj.ProjectID) and (AProj.ProjType = vProj.ProjType) then
       begin
         Result := True;
         Break;
@@ -99,7 +114,7 @@ function TrpgGatherControl.SameSelect: Boolean;
     Result := True;
     for iSmall := 0 to ASmall.Count - 1 do
     begin
-      if IncludeProj(ALarge, TGatherProjInfo(ASmall.Items[iSmall])) then
+      if not IncludeProj(ALarge, TGatherProjInfo(ASmall.Items[iSmall])) then
       begin
         Result := False;
         Break;
@@ -116,7 +131,10 @@ end;
 
 function TrpgGatherControl.SelectProject: Boolean;
 begin
-  Result := SelectGatherProject(FProjectID, FHistroyProjs, FSelectProjs);
+  if FTemplate.IsExtra then
+    Result := SelectGatherProject(FProjectID, FHistroyProjs, FSelectProjs, FTemplate.InteractInfo.SpecialProjGatherTypes)
+  else
+    Result := SelectGatherProject(FProjectID, FHistroyProjs, FSelectProjs);
 end;
 
 end.

Report/ProjGather/rpgGatherData.pas

@@ -17,20 +17,23 @@ type
 
     procedure ClearHistoryData;
 
-    procedure CreateDataTables(AProjCount: Integer);
+    procedure CreateDataTables(AProjCount, ASProjCount: Integer);
 
-    procedure SaveGatherProjInfo(AProjs: TList);
+    procedure SaveGatherProjInfo(AProjs, ASProjs: TList);
     procedure SaveBills(ATree: TProjGatherTree);
     procedure SaveBillsGatherCalc(ATree: TProjGatherTree);
     procedure SaveBillsProjCalc(ATree: TProjGatherTree; AProjIndex: Integer);
+    procedure SaveBillsSpecialProjCalc(ATree: TProjGatherTree; AProjType: Integer);
     procedure SaveGatherData(AGather: TProjGather);
 
     procedure CalcDgnData(const ATableName: string);
-    procedure CalcOtherData(AProjCount: Integer);
+    procedure CalcOtherData(AProjCount, ASProjCount: Integer);
 
     procedure TransposeProjCalc(AProjCount: Integer);
+
+    function GetCurSpecialProjCount: Integer;
   protected
-    procedure AddTables(AProjCount: Integer; AUpdater: TScUpdater); virtual;
+    procedure AddTables(AProjCount, ASProjCount: Integer; AUpdater: TScUpdater); virtual;
   public
     constructor Create;
     destructor Destroy; override;
@@ -38,6 +41,7 @@ type
     procedure WriteGatherData(AGather: TProjGather);
 
     procedure LoadRelaData(AProjectID: Integer);
+    procedure UpdateDataBase(ASpecialProjTypes: TStrings);
 
     property GatherFile: string read FGatherFile;
     property Connection: TADOConnection read FConnection;
@@ -51,7 +55,7 @@ uses
 
 { TrpgGatherData }
 
-procedure TrpgGatherData.AddTables(AProjCount: Integer;
+procedure TrpgGatherData.AddTables(AProjCount, ASProjCount: Integer;
   AUpdater: TScUpdater);
 var
   iProj: Integer;
@@ -62,6 +66,8 @@ begin
   for iProj := 0 to AProjCount - 1 do
     AUpdater.AddTableDef(SBills_Proj+IntToStr(iProj+1), @tdBills_Calc, Length(tdBills_Calc), False, False);
   AUpdater.AddTableDef(SBills_TransProj, @tdBills_Calc, Length(tdBills_Calc), False, False);
+  for iProj := 0 to ASProjCount - 1 do
+    AUpdater.AddTableDef(SBills_SProj+IntToStr(iProj+1), @tdBills_Calc, Length(tdBills_Calc), False, False);
 end;
 
 procedure TrpgGatherData.CalcDgnData(const ATableName: string);
@@ -93,13 +99,15 @@ begin
   ExecuteSql(Format(sDgn, [ATableName]));
 end;
 
-procedure TrpgGatherData.CalcOtherData(AProjCount: Integer);
+procedure TrpgGatherData.CalcOtherData(AProjCount, ASProjCount: Integer);
 var
   iProj: Integer;
 begin
   CalcDgnData(SBills_Gather);
   for iProj := 0 to AProjCount - 1 do
-    CalcDgnData(SBills_Proj+IntToStr(iProj+1)); 
+    CalcDgnData(SBills_Proj+IntToStr(iProj+1));
+  for iProj := 0 to ASProjCount - 1 do
+    CalcDgnData(SBills_SProj+IntToStr(iProj+1));
 end;
 
 procedure TrpgGatherData.ClearHistoryData;
@@ -140,7 +148,7 @@ begin
   FQuery.Connection := FConnection;
 end;
 
-procedure TrpgGatherData.CreateDataTables(AProjCount: Integer);
+procedure TrpgGatherData.CreateDataTables(AProjCount, ASProjCount: Integer);
 var
   Updater: TScUpdater;
 begin
@@ -148,7 +156,7 @@ begin
   try
     Updater.ForceUpdate := True;
     Updater.Open('', FConnection, '', '');
-    AddTables(AProjCount, Updater);
+    AddTables(AProjCount, ASProjCount, Updater);
     Updater.ExcuteUpdate;
   finally
     Updater.Free;
@@ -165,10 +173,27 @@ begin
 end;
 
 procedure TrpgGatherData.ExecuteSql(const ASql: string);
+var
+  vQuery: TADOQuery;
 begin
-  FQuery.SQL.Clear;
+  vQuery := TADOQuery.Create(nil);
+  try
+    vQuery.Connection := FConnection;
+    vQuery.SQL.Add(ASql);
+    vQuery.ExecSQL;
+  finally
+    vQuery.Free;
+  end;
+
+  {FQuery.SQL.Clear;
   FQuery.SQL.Add(ASql);
-  FQuery.ExecSQL;
+  FQuery.ExecSQL;}
+end;
+
+function TrpgGatherData.GetCurSpecialProjCount: Integer;
+begin
+  Result := 0;
+
 end;
 
 procedure TrpgGatherData.LoadRelaData(AProjectID: Integer);
@@ -230,24 +255,44 @@ begin
   end;
 end;
 
+procedure TrpgGatherData.SaveBillsSpecialProjCalc(ATree: TProjGatherTree;
+  AProjType: Integer);
+var
+  vBillsCalcData: TrpgBillsCalcData;
+begin
+  vBillsCalcData := TrpgBillsCalcData.Create(FConnection);
+  try
+    vBillsCalcData.SaveSpecialProjDataTo(ATree, AProjType, SBills_SProj+IntToStr(AProjType));
+  finally
+    vBillsCalcData.Free;
+  end;
+end;
+
 procedure TrpgGatherData.SaveGatherData(AGather: TProjGather);
+const
+  sInsert = 'Insert Into %s Select * From %s';
 var
   iProj: Integer;
 begin
-  SaveGatherProjInfo(AGather.Projs);
+  SaveGatherProjInfo(AGather.CommonProj, AGather.SpecialProj);
   SaveBills(AGather.Tree);
   SaveBillsGatherCalc(AGather.Tree);
-  for iProj := 0 to AGather.Projs.Count - 1 do
+  for iProj := 0 to AGather.CommonProj.Count - 1 do
+  begin
     SaveBillsProjCalc(AGather.Tree, iProj);
+    ExecuteSql(Format(sInsert, [SBills_TransProj, SBills_Proj+IntToStr(iProj+1)]));
+  end;
+  for iProj := 0 to AGather.Tree.SpecialProjCount - 1 do
+    SaveBillsSpecialProjCalc(AGather.Tree, iProj+1);
 end;
 
-procedure TrpgGatherData.SaveGatherProjInfo(AProjs: TList);
+procedure TrpgGatherData.SaveGatherProjInfo(AProjs, ASProjs: TList);
 var
   vGatherInfoData: TrpgGatherProjData;
 begin
   vGatherInfoData := TrpgGatherProjData.Create(FConnection);
   try
-    vGatherInfoData.SaveDataTo(AProjs, SGatherProj);
+    vGatherInfoData.SaveDataTo(AProjs, ASProjs, SGatherProj);
   finally
     vGatherInfoData.Free;
   end;
@@ -259,17 +304,79 @@ const
 var
   iProj: Integer;
 begin
-  for iProj := 0 to  AProjCount - 1 do
+  for iProj := 0 to AProjCount - 1 do
     ExecuteSql(Format(sInsert, [SBills_TransProj, SBills_Proj+IntToStr(iProj+1)]));
 end;
 
+procedure TrpgGatherData.UpdateDataBase(ASpecialProjTypes: TStrings);
+const
+  sUpdateSql = 'Insert Into %s (BillsID, ProjID, ProjType,' +
+               '    OrgQuantity, OrgTotalPrice, OrgTotalPrice_Rc,' +
+               '    MisQuantity, MisTotalPrice, MisTotalPrice_Rc,' +
+               '    OthQuantity, OthTotalPrice, OthTotalPrice_Rc,' +
+               '    Quantity, TotalPrice, TotalPrice_Rc,' +
+               '    DgnQuantity1, DgnQuantity2, DgnQuantity,' +
+               '    DgnPrice1, DgnPrice2, DgnPrice,' +
+               '    DgnPrice1_Rc, DgnPrice2_Rc, DgnPrice_Rc,' +
+               '    DealDgnQuantity1, DealDgnQuantity2, DealDgnQuantity,' +
+               '    CDgnQuantity1, CDgnQuantity2, CDgnQuantity,' +
+               '    FinalDgnQuantity1, FinalDgnQuantity2, FinalDgnQuantity,' +
+               '    FinalDgnPrice1, FinalDgnPrice2, FinalDgnPrice,' +
+               '    FinalDgnPrice1_Rc, FinalDgnPrice2_Rc, FinalDgnPrice_Rc,' +
+               '    AddDealQuantity, AddDealTotalPrice, AddDealTotalPrice_Rc,' +
+               '    AddQcQuantity, AddQcTotalPrice, AddQcTotalPrice_Rc,' +
+               '    AddGatherQuantity, AddGatherTotalPrice, AddGatherTotalPrice_Rc,' +
+               '    CurDealQuantity, CurDealTotalPrice, CurDealTotalPrice_Rc,' +
+               '    CurQcQuantity, CurQcTotalPrice, CurQcTotalPrice_Rc,' +
+               '    CurGatherQuantity, CurGatherTotalPrice, CurGatherTotalPrice_Rc,' +
+               '    PreDealQuantity, PreDealTotalPrice, PreDealTotalPrice_Rc,' +
+               '    PreQcQuantity, PreQcTotalPrice, PreQcTotalPrice_Rc,' +
+               '    PreGatherQuantity, PreGatherTotalPrice, PreGatherTotalPrice_Rc,' + 
+               '    EndDealQuantity, EndDealTotalPrice, EndDealTotalPrice_Rc,' +
+               '    EndQcQuantity, EndQcTotalPrice, EndQcTotalPrice_Rc,' +
+               '    EndGatherQuantity, EndGatherTotalPrice, EndGatherTotalPrice_Rc,' +
+               '  Select BillsID, %d, %d,'+
+               '    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,'+ // 台账明细
+               '    0, 0, 0,'+ // 台账
+               '    0, 0, '''', 0, 0, '''', 0, 0, '''','+ // 台账--设计数量、经济指标
+               '    0, 0, '''', 0, 0, '''','+ // 计量--设计数量
+               '    0, 0, '''', 0, 0, '''', 0, 0, '''','+ // 计量--经济指标
+               '    0, 0, 0, 0, 0, 0, 0, 0, 0, 0,'+ // 累计数据
+               '    0, 0, 0, 0, 0, 0, 0, 0, 0, 0,'+ // 本期
+               '    0, 0, 0, 0, 0, 0, 0, 0, 0, 0,'+ // 截止上期
+               '    0, 0, 0, 0, 0, 0, 0, 0, 0, 0'+  // 截止本期
+               '  From r_Bills_Gather';
+var
+  Updater: TScUpdater;
+  iProj, iSpecialProjCount: Integer;
+begin
+  iSpecialProjCount := GetCurSpecialProjCount;
+  if ASpecialProjTypes.Count > iSpecialProjCount then
+  begin
+    Updater := TScUpdater.Create;
+    try
+      Updater.ForceUpdate := True;
+      Updater.Open('', FConnection, '', '');
+      for iProj := iSpecialProjCount to ASpecialProjTypes.Count - 1 do
+        Updater.AddTableDef(SBills_SProj+IntToStr(iProj+1), @tdBills_Calc, Length(tdBills_Calc), False, False);
+      Updater.ExcuteUpdate;
+    finally
+      Updater.Free;
+    end;
+
+    for iProj := iSpecialProjCount to ASpecialProjTypes.Count - 1 do
+      ExecuteSql(Format(sUpdateSql, [SBills_SProj+IntToStr(iProj+1), iProj, iProj+1]));
+  end;
+end;
+
 procedure TrpgGatherData.WriteGatherData(AGather: TProjGather);
 begin
   ClearHistoryData;
-  CreateDataTables(AGather.Projs.Count);
+  CreateDataTables(AGather.Tree.ProjCount, AGather.Tree.SpecialProjCount);
   SaveGatherData(AGather);
-  CalcOtherData(AGather.Projs.Count);
-  TransposeProjCalc(AGather.Projs.Count);
+  CalcOtherData(AGather.Tree.ProjCount, AGather.Tree.SpecialProjCount);
+  // 集中处理TranProj时，最后一个标段数据丢失
+  //TransposeProjCalc(AGather.Tree.ProjCount);
   if _IsDebugView then
     CopyFileOrFolder(FGatherFile, GetAppFilePath+'CommonProjGather.dat');
 end;

Report/ProjGather/rpgGatherProjDm.dfm

@@ -12,12 +12,17 @@ object rpgGatherProjData: TrpgGatherProjData
     FieldListData = {
       0101044E616D6506024944094669656C644E616D650602494408446174615479
       70650203084461746153697A6502040549734B6579080F4E65656450726F6365
-      73734E616D65090001044E616D65060950726F6A6563744944094669656C644E
-      616D65060950726F6A6563744944084461746154797065020308446174615369
-      7A6502040549734B6579080F4E65656450726F636573734E616D65090001044E
-      616D65060B50726F6A6563744E616D65094669656C644E616D65060B50726F6A
-      6563744E616D650844617461547970650218084461746153697A6503FF000549
-      734B6579080F4E65656450726F636573734E616D65090000}
+      73734E616D650909507265636973696F6E02000453697A6502000001044E616D
+      65060850726F6A54797065094669656C644E616D65060850726F6A5479706508
+      44617461547970650203084461746153697A6502040549734B6579080F4E6565
+      6450726F636573734E616D650909507265636973696F6E02000453697A650200
+      0001044E616D65060950726F6A6563744944094669656C644E616D6506095072
+      6F6A65637449440844617461547970650203084461746153697A650204054973
+      4B6579080F4E65656450726F636573734E616D650909507265636973696F6E02
+      000453697A6502000001044E616D65060B50726F6A6563744E616D6509466965
+      6C644E616D65060B50726F6A6563744E616D6508446174615479706502180844
+      61746153697A6503FF000549734B6579080F4E65656450726F636573734E616D
+      650909507265636973696F6E02000453697A6502000000}
   end
   object sdpGatherProj: TsdADOProvider
     Left = 56

Report/ProjGather/rpgGatherProjDm.pas

@@ -14,7 +14,7 @@ type
   public
     constructor Create(AConnection: TADOConnection);
 
-    procedure SaveDataTo(AProjs: TList; const ATableName: string);
+    procedure SaveDataTo(AProjs, ASProjs: TList; const ATableName: string);
   end;
 
 implementation
@@ -29,13 +29,14 @@ begin
   sdpGatherProj.Connection := AConnection;
 end;
 
-procedure TrpgGatherProjData.SaveDataTo(AProjs: TList; const ATableName: string);
+procedure TrpgGatherProjData.SaveDataTo(AProjs, ASProjs: TList; const ATableName: string);
 begin
   sdpGatherProj.TableName := ATableName;
   sddGatherProj.Open;
   sddGatherProj.BeginUpdate;
   try
     SaveGatherInfo(AProjs);
+    SaveGatherInfo(ASProjs);
   finally
     sddGatherProj.EndUpdate;
     sddGatherProj.Save;
@@ -52,9 +53,13 @@ begin
   begin
     ProjInfo := TGatherProjInfo(AProjs.Items[i]);
     Rec := sddGatherProj.Add;
-    Rec.ValueByName('ID').AsInteger := i;
+    if ProjInfo.ProjType = 0 then
+      Rec.ValueByName('ID').AsInteger := i
+    else
+      Rec.ValueByName('ID').AsInteger := -3;
     Rec.ValueByName('ProjectID').AsInteger := ProjInfo.ProjectID;
     Rec.ValueByName('ProjectName').AsString := ProjInfo.ProjectName;
+    Rec.ValueByName('ProjType').AsInteger := ProjInfo.ProjType;
   end;
 end;
 

Report/ReportConnection.pas

@@ -41,7 +41,7 @@ procedure TReportConnection.RefreshConnection(ATemplate: TTemplateNode);
 begin
   case ATemplate.DataBaseFlag of
     0: FConnection := FProjectData.ADOConnection;
-    1: FConnection := FCommonGather.RefreshConnection;
+    1: FConnection := FCommonGather.RefreshConnection(ATemplate);
   end;
 end;
 

Units/ReportInteractInfo.pas

@@ -15,11 +15,14 @@ Type
     FMemoryStream: TMemoryStream;
     FAudits: TStringList;
     FSql: string;
+    FSpecialProjGatherTypes: TStringList;
 
     procedure LoadReportTemplate;
 
     procedure LoadAuditor(AXmlNode: IXMLNode);
     procedure LoadSql(AXmlNode: IXMLNode);
+    procedure LoadSpecialProjGatherTypes(AXmlNode: IXMLNode);
+
     procedure LoadInteractInfo(AXmlNode: IXMLNode);
     procedure LoadXmlFromStream;
   public
@@ -28,6 +31,7 @@ Type
 
     property Audits: TStringList read FAudits;
     property Sql: string read FSql;
+    property SpecialProjGatherTypes: TStringList read FSpecialProjGatherTypes;
   end;
 
 implementation
@@ -41,6 +45,7 @@ constructor TInteractInfo.Create(const AFileName: string);
 begin
   FTemplateFile := AFileName;
   FAudits := TStringList.Create;
+  FSpecialProjGatherTypes := TStringList.Create;
   LoadReportTemplate;
   LoadXmlFromStream;
 end;
@@ -75,6 +80,7 @@ begin
   XmlNode := AXmlNode.ChildNodes.FindNode('附加信息');
   LoadAuditor(XmlNode.ChildNodes.FindNode('审核意见'));
   LoadSql(XmlNode.ChildNodes.FindNode('查询语句'));
+  LoadSpecialProjGatherTypes(XmlNode.ChildNodes.FindNode('特殊汇总项目'));
 end;
 
 procedure TInteractInfo.LoadReportTemplate;
@@ -86,6 +92,23 @@ begin
   FMemoryStream := vArchiver.Extract;
 end;
 
+procedure TInteractInfo.LoadSpecialProjGatherTypes(AXmlNode: IXMLNode);
+var
+  vSpecialProjs: IXMLNodeList;
+  vSpecialProj: IXMLNode;
+  i: Integer;
+begin
+  if AXmlNode = nil then Exit;
+
+  vSpecialProjs := AXmlNode.ChildNodes;
+  for i := 0 to vSpecialProjs.Count - 1 do
+  begin
+    vSpecialProj := vSpecialProjs.Nodes[i];
+    if vSpecialProj.HasAttribute('类型') then
+      FSpecialProjGatherTypes.Add(vSpecialProj.Attributes['类型']);
+  end;
+end;
+
 procedure TInteractInfo.LoadSql(AXmlNode: IXMLNode);
 begin
   if AXmlNode = nil then Exit;