فهرست منبع

报表,新的汇总功能,提供数据库

MaiXinRong 9 سال پیش
والد
کامیت
8252bff04a

+ 3 - 1
Forms/MainFrm.pas

@@ -275,7 +275,9 @@ procedure TMainForm.FormCreate(Sender: TObject);
       Result := Result + '¹ã¶«';
     if _ModuleType = mtAll then
     begin
-      if G_IsTest then
+      if _IsDebugView then
+        Result := 'Debug'
+      else if G_IsTest then
         Result := '²âÊÔ'
       else if G_IsCloud then
         Result := Result + 'ÔÆ'

+ 7 - 2
Forms/ReportsFrm.pas

@@ -9,7 +9,7 @@ interface
 
 uses
   ProjectData, ScFileArchiver, ReportManager, ConditionalDefines,
-  PrintComTypeDefUnit, ADODB, DB, ReportPrepare,
+  PrintComTypeDefUnit, ADODB, DB, ReportPrepare, ReportConnection,
   AuditSelectFrm,
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, PrintCom, PrintComXML, ExtCtrls, ExTreeView, ImgList,
@@ -100,6 +100,8 @@ type
 
     FLockForm: Boolean;
 
+    // 数据库管理
+    FReportCon: TReportConnection;
     // 报表数据准备
     FReportDataPrepare: TReportPrepare;
 
@@ -291,6 +293,7 @@ begin
   // 准备额外数据
   if vTemplateNode.DataPrepareFlag <> 0 then
     FReportDataPrepare.PrepareData(vTemplateNode.DataPrepareFlag);
+  FReportCon.RefreshConnection(vTemplateNode);
 
   Screen.Cursor := crHourGlass;
   try
@@ -308,6 +311,7 @@ procedure TReportsForm.SetProjectData(const Value: TProjectData);
 begin
   FProjectData := Value;
   FReportDataPrepare := TReportPrepare.Create(FProjectData);
+  FReportCon := TReportConnection.Create(FProjectData);
   extvReport.Selected := extvReport.Items[0];
   LoadReportTemplets;
   LoadTempletAndDisplay;
@@ -316,7 +320,7 @@ end;
 procedure TReportsForm.PreviewComXMLGetDataConnection(
   var ADOCon: TADOConnection);
 begin
-  ADOCon := FProjectData.ADOConnection;
+  ADOCon := FReportCon.Connection;
 end;
 
 procedure TReportsForm.PreviewReportCurPage;
@@ -1492,6 +1496,7 @@ end;
 
 destructor TReportsForm.Destroy;
 begin
+  FReportCon.Free;
   FReportDataPrepare.Free;
   inherited;
 end;

+ 2 - 2
Frames/BGLFme.pas

@@ -70,7 +70,7 @@ implementation
 
 uses
   UtilMethods, MergeTextFrm, ProjectData, MainFrm, mEncryptEditions,
-  BGLClipboard, ConstUnit, ZjCells;
+  BGLClipboard, ConditionalDefines, ZjCells;
 
 {$R *.dfm}
 
@@ -201,7 +201,7 @@ end;
 
 procedure TBGLFrame.actnCopyBGLBlockUpdate(Sender: TObject);
 begin
-  if G_IsTest then
+  if _IsDebugView then
     TAction(Sender).Visible := True
   else
     TAction(Sender).Visible := False;

+ 2 - 2
Frames/BillsMeasureFme.pas

@@ -118,7 +118,7 @@ implementation
 
 uses
   MainFrm, ProjectFme, ProjectData, ExportExcel, BGLDm, BGLSelectFrm,
-  Types, ZhAPI, BillsTree, mDataRecord, ConstUnit;
+  Types, ZhAPI, BillsTree, mDataRecord, ConditionalDefines;
 
 { TBillsFrame }
 
@@ -154,7 +154,7 @@ var
 begin
   if Button = mbRight then
   begin
-    if G_IsTest and (zgBillsMeasure.Selection.SelectType = stCol) and (Y < (zgBillsMeasure.RowHeights[0] + zgBillsMeasure.RowHeights[1])) then
+    if _IsDebugView and (zgBillsMeasure.Selection.SelectType = stCol) and (Y < (zgBillsMeasure.RowHeights[0] + zgBillsMeasure.RowHeights[1])) then
       dxpmBillsCol.PopupFromCursorPos
     else
       dxpmBills.PopupFromCursorPos;

+ 1 - 1
Frames/ProjectFme.pas

@@ -644,7 +644,7 @@ end;
 
 procedure TProjectFrame.dxpmExpandBillsPopup(Sender: TObject);
 begin
-  dxpmExpandBills.ItemLinks.Items[8].Visible := G_IsTest;
+  dxpmExpandBills.ItemLinks.Items[8].Visible := _IsDebugView;
   dxpmExpandBills.ItemLinks.Items[7].Visible := jpsMain.ActivePageIndex in [0, 1, 4];
   dxpmExpandBills.ItemLinks.Items[6].Visible := jpsMain.ActivePageIndex in [1, 4];
   SetDxBtnAction(actnFirstLevel, MainForm.dxbtnFirstLevel);

+ 75 - 0
ProjGather/GatherProjInfo.pas

@@ -0,0 +1,75 @@
+unit GatherProjInfo;
+
+interface
+
+uses
+  sdDB;
+
+type
+  TGatherProjInfo = class
+  private
+    FProjectID: Integer;
+    FProjectName: string;
+    FFileName: string;
+
+    FProjRec: TsdDataRecord;
+
+    {FIsPD: Boolean;
+    FIsCDD: Boolean;
+    FIsAB: Boolean;
+    FIsDeal: Boolean;}
+  public
+    constructor Create(ARec: TsdDataRecord); virtual;
+    destructor Destroy; override;
+
+    property ProjectID: Integer read FProjectID;
+    property ProjectName: string read FProjectName;
+    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;}
+  end;
+
+  TSelectProjInfo = class(TGatherProjInfo)
+  private
+    FIsTender: Boolean;
+  public
+    constructor Create(ARec: TsdDataRecord); override;
+
+    property IsTender: Boolean read FIsTender;
+  end;
+
+implementation
+
+{ TGatherProjInfo }
+
+constructor TGatherProjInfo.Create(ARec: TsdDataRecord);
+begin
+  FProjRec := ARec;
+  FProjectID := FProjRec.ValueByName('ID').AsInteger;
+  FProjectName := FProjRec.ValueByName('Name').AsString;
+  FFileName := FProjRec.ValueByName('FileName').AsString;
+end;
+
+destructor TGatherProjInfo.Destroy;
+begin
+  inherited;
+end;
+
+{ TSelectProjInfo }
+
+constructor TSelectProjInfo.Create(ARec: TsdDataRecord);
+begin
+  inherited;
+  FIsTender := FProjRec.ValueByName('Type').AsInteger = 1;
+end;
+
+end.

+ 236 - 0
ProjGather/ProjGather.pas

@@ -0,0 +1,236 @@
+unit ProjGather;
+
+interface
+
+uses
+  Classes, ProjGatherTree, GatherProjInfo, ProjectData, BillsTree, CalcData;
+
+type
+  TProjGather = class;
+  TWriteGatherData = procedure (AGather: TProjGather) of Object;
+
+  TProjGather = class
+  private
+    FWriter: TWriteGatherData;
+    FXmjCompare: Integer;
+    FGclCompare: Integer;
+
+    FTree: TProjGatherTree;
+    FProjs: TList;
+
+    FProjectData: TProjectData;
+
+    procedure OpenProjectData(AProj: TGatherProjInfo);
+    procedure FreeProjectData;
+
+    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 GatherProj(AProj: TGatherProjInfo; AProjIndex: Integer);
+  public
+    constructor Create(AWriter: TWriteGatherData; AXmjCompare, AGclCompare: Integer);
+    destructor Destroy; override;
+
+    procedure Gather(AProjs: TList);
+
+    property Projs: TList read FProjs;
+    property Tree: TProjGatherTree read FTree;
+  end;
+
+implementation
+
+uses
+  Globals, UtilMethods, sdIDTree, sdDB, mDataRecord, BillsMeasureDm;
+
+{ TProjGather }
+
+procedure TProjGather.AddProjCalcData(AProjCalc: TProjCalc;
+  ANode: TBillsIDTreeNode);
+var
+  StageRec: TStageRecord;
+begin
+  AProjCalc.Compile.Org.AddQuantity(ANode.Rec.OrgQuantity.AsFloat);
+  AProjCalc.Compile.Org.AddTotalPrice(ANode.Rec.OrgTotalPrice.AsFloat);
+  AProjCalc.Compile.Mis.AddQuantity(ANode.Rec.MisQuantity.AsFloat);
+  AProjCalc.Compile.Mis.AddTotalPrice(ANode.Rec.MisTotalPrice.AsFloat);
+  AProjCalc.Compile.Oth.AddQuantity(ANode.Rec.OthQuantity.AsFloat);
+  AProjCalc.Compile.Oth.AddTotalPrice(ANode.Rec.OthTotalPrice.AsFloat);
+  AProjCalc.Compile.SubTotal.AddQuantity(ANode.Rec.Quantity.AsFloat);
+  AProjCalc.Compile.SubTotal.AddTotalPrice(ANode.Rec.TotalPrice.AsFloat);
+
+  AProjCalc.AddMeasure.Deal.AddQuantity(ANode.Rec.AddDealQuantity.AsFloat);
+  AProjCalc.AddMeasure.Deal.AddTotalPrice(ANode.Rec.AddDealTotalPrice.AsFloat);
+  AProjCalc.AddMeasure.Qc.AddQuantity(ANode.Rec.AddQcQuantity.AsFloat);
+  AProjCalc.AddMeasure.Qc.AddTotalPrice(ANode.Rec.AddQcTotalPrice.AsFloat);
+  AProjCalc.AddMeasure.Gather.AddQuantity(ANode.Rec.AddGatherQuantity.AsFloat);
+  AProjCalc.AddMeasure.Gather.AddTotalPrice(ANode.Rec.AddGatherTotalPrice.AsFloat);
+
+  AProjCalc.DgnQuantity1 := AProjCalc.DgnQuantity1 + ANode.Rec.DgnQuantity1.AsFloat;
+  AProjCalc.DgnQuantity2 := AProjCalc.DgnQuantity2 + ANode.Rec.DgnQuantity2.AsFloat;
+  AProjCalc.DealDgnQuantity1 := AProjCalc.DealDgnQuantity1 + ANode.Rec.DealDgnQuantity1.AsFloat;
+  AProjCalc.DealDgnQuantity2 := AProjCalc.DealDgnQuantity2 + ANode.Rec.DealDgnQuantity2.AsFloat;
+  AProjCalc.CDgnQuantity1 := AProjCalc.CDgnQuantity1 + ANode.Rec.CDgnQuantity1.AsFloat;
+  AProjCalc.CDgnQuantity2 := AProjCalc.CDgnQuantity2 + ANode.Rec.CDgnQuantity2.AsFloat;
+
+  StageRec := ANode.StageRec;
+  if Assigned(StageRec) then
+  begin
+    AProjCalc.CurMeasure.Deal.AddQuantity(StageRec.DealQuantity.AsFloat);
+    AProjCalc.CurMeasure.Deal.AddTotalPrice(StageRec.DealTotalPrice.AsFloat);
+    AProjCalc.CurMeasure.Qc.AddQuantity(StageRec.QcQuantity.AsFloat);
+    AProjCalc.CurMeasure.Qc.AddTotalPrice(StageRec.QcTotalPrice.AsFloat);
+    AProjCalc.CurMeasure.Gather.AddQuantity(StageRec.GatherQuantity.AsFloat);
+    AProjCalc.CurMeasure.Gather.AddTotalPrice(StageRec.GatherTotalPrice.AsFloat);
+
+    AProjCalc.PreMeasure.Deal.AddQuantity(StageRec.PreDealQuantity.AsFloat);
+    AProjCalc.PreMeasure.Deal.AddTotalPrice(StageRec.PreDealTotalPrice.AsFloat);
+    AProjCalc.PreMeasure.Qc.AddQuantity(StageRec.PreQcQuantity.AsFloat);
+    AProjCalc.PreMeasure.Qc.AddTotalPrice(StageRec.PreQcTotalPrice.AsFloat);
+    AProjCalc.PreMeasure.Gather.AddQuantity(StageRec.PreGatherQuantity.AsFloat);
+    AProjCalc.PreMeasure.Gather.AddTotalPrice(StageRec.PreGatherTotalPrice.AsFloat);
+
+    AProjCalc.EndMeasure.Deal.AddQuantity(StageRec.EndDealQuantity.AsFloat);
+    AProjCalc.EndMeasure.Deal.AddTotalPrice(StageRec.EndDealTotalPrice.AsFloat);
+    AProjCalc.EndMeasure.Qc.AddQuantity(StageRec.EndQcQuantity.AsFloat);
+    AProjCalc.EndMeasure.Qc.AddTotalPrice(StageRec.EndQcTotalPrice.AsFloat);
+    AProjCalc.EndMeasure.Gather.AddQuantity(StageRec.EndGatherQuantity.AsFloat);
+    AProjCalc.EndMeasure.Gather.AddTotalPrice(StageRec.EndGatherTotalPrice.AsFloat);    
+  end;
+end;
+
+constructor TProjGather.Create(AWriter: TWriteGatherData;
+  AXmjCompare, AGclCompare: Integer);
+begin
+  FWriter := AWriter;
+  FXmjCompare := AXmjCompare;
+  FGclCompare := AGclCompare;
+end;
+
+function TProjGather.CreateBillsNode(ANode: TBillsIDTreeNode;
+  AParent: TProjGatherTreeNode): TProjGatherTreeNode;
+var
+  vNextSibling: TProjGatherTreeNode;
+begin
+  vNextSibling := FTree.FindNextSibling(AParent, ANode.Rec.Code.AsString, ANode.Rec.B_Code.AsString);
+  if ANode.ID < 100 then
+    Result := FTree.AddNode(AParent, vNextSibling, ANode.ID)
+  else
+    Result := FTree.AddNode(AParent, vNextSibling);
+  Result.Code := ANode.Rec.Code.AsString;
+  Result.B_Code := ANode.Rec.B_Code.AsString;
+  Result.Name := ANode.Rec.Name.AsString;
+  Result.Units := ANode.Rec.Units.AsString;
+  Result.Price := ANode.Rec.Price.AsFloat;
+  Result.XiangCode := ANode.Rec.XiangCode.AsString;
+  Result.MuCode := ANode.Rec.MuCode.AsString;
+  Result.JieCode := ANode.Rec.JieCode.AsString;
+  Result.XiMuCode := ANode.Rec.XimuCode.AsString;
+  Result.IndexCode := ANode.Rec.IndexCode.AsString;
+end;
+
+destructor TProjGather.Destroy;
+begin
+
+  inherited;
+end;
+
+function TProjGather.FindBillsNode(ANode: TBillsIDTreeNode;
+  AParent: TProjGatherTreeNode): TProjGatherTreeNode;
+var
+  iCompareType: Integer;
+begin
+  if ANode.ID > 100 then
+  begin
+    if ANode.Rec.B_Code.AsString <> '' then
+      iCompareType := FGclCompare
+    else
+      iCompareType := FXmjCompare;
+
+    case iCompareType of
+      // °´±àºÅ
+      0: if (ANode.Rec.Code.AsString <> '') or (ANode.Rec.B_Code.asString <> '') then
+           Result := FTree.FindNode(AParent, ANode.Rec.Code.AsString, ANode.Rec.B_Code.AsString, ANode.Rec.Price.AsFloat)
+         else
+           Result := FTree.FindNode(AParent, ANode.Rec.Name.AsString, ANode.Rec.Price.AsFloat);
+      // °´Ãû³Æ
+      1: Result := FTree.FindNode(AParent, ANode.Rec.Name.AsString, ANode.Rec.Price.AsFloat);
+      // °´±àºÅ+Ãû³Æ
+      2: Result := FTree.FindNode(AParent, ANode.Rec.Code.AsString, ANode.Rec.B_Code.AsString, ANode.Rec.Name.AsString, ANode.Rec.Price.AsFloat);
+    end;
+  end
+  else
+    Result := FTree.FindNode(ANode.ID);
+end;
+
+procedure TProjGather.FreeProjectData;
+begin
+  if not Assigned(OpenProjectManager.FindProjectData(FProjectData.ProjectID)) then
+    FProjectData.Free;
+end;
+
+procedure TProjGather.Gather(AProjs: TList);
+var
+  i: Integer;
+begin
+  FProjs := AProjs;
+  FTree := TProjGatherTree.Create(FProjs.Count);
+  FTree.NewNodeID := 101;
+  try
+    for i := 0 to FProjs.Count - 1 do
+      GatherProj(TGatherProjInfo(FProjs.Items[i]), i);
+    FTree.CalculateAll;
+    if Assigned(FWriter) then
+      FWriter(Self);
+  finally
+    FTree.Free;
+  end;
+end;
+
+procedure TProjGather.GatherBills(ANode: TBillsIDTreeNode;
+  AParent: TProjGatherTreeNode; AProjIndex: Integer);
+var
+  vCur: TProjGatherTreeNode;
+begin
+  if not Assigned(ANode) then Exit;
+
+  vCur := GatherBillsNode(ANode, AParent, AProjIndex);
+  GatherBills(TBillsIDTreeNode(ANode.FirstChild), vCur, AProjIndex);
+  GatherBills(TBillsIDTreeNode(ANode.NextSibling), AParent, AProjIndex );
+end;
+
+function TProjGather.GatherBillsNode(ANode: TBillsIDTreeNode;
+  AParent: TProjGatherTreeNode; AProjIndex: Integer): TProjGatherTreeNode;
+begin
+  Result := FindBillsNode(ANode, AParent);
+  if not Assigned(Result) then
+    Result := CreateBillsNode(ANode, AParent);
+  AddProjCalcData(Result.GatherCalc, ANode);
+  AddProjCalcData(Result.Proj[AProjIndex], ANode);
+end;
+
+procedure TProjGather.GatherProj(AProj: TGatherProjInfo; AProjIndex: Integer);
+begin
+  OpenProjectData(AProj);
+  try
+    with FProjectData.BillsMeasureData do
+      GatherBills(TMeasureBillsIDTreeNode(BillsMeasureTree.FirstNode), nil, AProjIndex);
+  finally
+    FreeProjectData;
+  end;
+end;
+
+procedure TProjGather.OpenProjectData(AProj: TGatherProjInfo);
+begin
+  FProjectData := OpenProjectManager.FindProjectData(AProj.ProjectID);
+  if not Assigned(FProjectData) then
+  begin
+    FProjectData := TProjectData.Create;
+    FProjectData.OpenForReport3(GetMyProjectsFilePath + AProj.FileName);
+  end;
+end;
+
+end.

+ 17 - 0
ProjGather/ProjGatherCalcData.pas

@@ -0,0 +1,17 @@
+unit ProjGatherCalcData;
+
+interface
+
+type
+  Tpg_Calc = class
+  private
+    FQuantity: Double;
+    FTotalPrice: Double;
+  public
+    property Quantity: Double read FQuantity write FQuantity;
+    property TotalPrice: Double read FTotalPrice write FTotalPrice;
+  end;
+
+implementation
+
+end.

+ 155 - 0
ProjGather/ProjGatherSelectFrm.dfm

@@ -0,0 +1,155 @@
+object ProjGatherSelectForm: TProjGatherSelectForm
+  Left = 454
+  Top = 235
+  Width = 735
+  Height = 554
+  Caption = 'ProjGatherSelectForm'
+  Color = clBtnFace
+  Font.Charset = ANSI_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -12
+  Font.Name = #23435#20307
+  Font.Style = []
+  OldCreateOrder = False
+  DesignSize = (
+    727
+    520)
+  PixelsPerInch = 96
+  TextHeight = 12
+  object lblProjectList: TLabel
+    Left = 11
+    Top = 8
+    Width = 72
+    Height = 12
+    Caption = #21487#36873#39033#30446#21015#34920
+    Font.Charset = ANSI_CHARSET
+    Font.Color = clBlue
+    Font.Height = -12
+    Font.Name = #23435#20307
+    Font.Style = []
+    ParentFont = False
+  end
+  object lblResult: TLabel
+    Left = 384
+    Top = 8
+    Width = 48
+    Height = 12
+    Caption = #25152#36873#32467#26524
+    Font.Charset = ANSI_CHARSET
+    Font.Color = clBlue
+    Font.Height = -12
+    Font.Name = #23435#20307
+    Font.Style = []
+    ParentFont = False
+  end
+  object zgSelectProject: TZJGrid
+    Left = 8
+    Top = 24
+    Width = 369
+    Height = 457
+    Options = [goRangeSelect, goRowSizing, goColSizing, goCellNotMaintainData, goFixedRowShowNo, goFixedColShowNo, goAlwaysShowSelection, goShowTreeLine]
+    OptionsEx = []
+    ColCount = 3
+    RowCount = 1
+    ShowGridLine = False
+    DefaultColWidth = 35
+    DefaultFixedColWidth = 25
+    DefaultFixedRowHeight = 25
+    Selection.AlphaBlend = False
+    Selection.TransparentColor = False
+    FrozenCol = 0
+    FrozenRow = 0
+    OnGetCellText = zgSelectProjectGetCellText
+    OnSetCellText = zgSelectProjectSetCellText
+    OnCellTextChanged = zgSelectProjectCellTextChanged
+    OnDrawCellText = zgSelectProjectDrawCellText
+  end
+  object zgResult: TZJGrid
+    Left = 384
+    Top = 24
+    Width = 337
+    Height = 457
+    OptionsEx = []
+    ColCount = 2
+    RowCount = 1
+    ShowGridLine = False
+    DefaultColWidth = 200
+    DefaultFixedColWidth = 25
+    DefaultFixedRowHeight = 25
+    Selection.AlphaBlend = False
+    Selection.TransparentColor = False
+    FrozenCol = 0
+    FrozenRow = 0
+  end
+  object btnOk: TButton
+    Left = 560
+    Top = 489
+    Width = 74
+    Height = 25
+    Anchors = [akTop, akRight]
+    Caption = #30830' '#23450
+    TabOrder = 2
+    OnClick = btnOkClick
+  end
+  object btnCancel: TButton
+    Left = 647
+    Top = 489
+    Width = 74
+    Height = 25
+    Anchors = [akTop, akRight]
+    Caption = #21462' '#28040
+    ModalResult = 2
+    TabOrder = 3
+  end
+  object stdSelectProject: TsdGridTreeDBA
+    Columns = <
+      item
+        Title.Caption = #36873#25321
+        Title.CaptionAcrossCols = '1'
+        Title.Font.Charset = GB2312_CHARSET
+        Title.Font.Color = clWindowText
+        Title.Font.Height = -12
+        Title.Font.Name = #23435#20307
+        Title.Font.Style = []
+        Alignment = taLeftJustify
+        EditType = sgeCheckBox
+        Font.Charset = GB2312_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -12
+        Font.Name = #23435#20307
+        Font.Style = []
+        Width = 35
+        ReadOnly = False
+      end
+      item
+        Title.Caption = #21517#31216
+        Title.CaptionAcrossCols = '1'
+        Title.Font.Charset = GB2312_CHARSET
+        Title.Font.Color = clWindowText
+        Title.Font.Height = -12
+        Title.Font.Name = #23435#20307
+        Title.Font.Style = []
+        Alignment = taLeftJustify
+        Font.Charset = GB2312_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -12
+        Font.Name = #23435#20307
+        Font.Style = []
+        FieldName = 'Name'
+        Width = 280
+        ReadOnly = True
+      end>
+    Grid = zgSelectProject
+    ExtendRowCount = 0
+    Options = [aoAllowEdit]
+    AutoExpand = True
+    TreeCellCol = 2
+    KeyFieldName = 'ID'
+    ParentFieldName = 'ParentID'
+    NextSiblingFieldName = 'NextSiblingID'
+    TreeOptions = []
+    TopLevelBold = True
+    Left = 120
+    Top = 160
+  end
+end

+ 321 - 0
ProjGather/ProjGatherSelectFrm.pas

@@ -0,0 +1,321 @@
+unit ProjGatherSelectFrm;
+
+interface
+
+uses
+  sdIDTree, sdDB,
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, sdGridDBA, sdGridTreeDBA, StdCtrls, ZJGrid;
+
+type
+  TProjGatherSelectForm = class(TForm)
+    lblProjectList: TLabel;
+    lblResult: TLabel;
+    zgSelectProject: TZJGrid;
+    zgResult: TZJGrid;
+    btnOk: TButton;
+    btnCancel: TButton;
+    stdSelectProject: TsdGridTreeDBA;
+    procedure zgSelectProjectGetCellText(Sender: TObject;
+      const ACoord: TPoint; var Value: String; DisplayText: Boolean);
+    procedure zgSelectProjectSetCellText(Sender: TObject;
+      const ACoord: TPoint; var Value: String; DisplayText: Boolean);
+    procedure zgSelectProjectCellTextChanged(Sender: TObject; Col,
+      Row: Integer);
+    procedure btnOkClick(Sender: TObject);
+    procedure zgSelectProjectDrawCellText(ACanvas: TCanvas;
+      const ARect: TRect; const ACoord: TPoint; AGrid: TZJGrid;
+      const Text: String; var ADefaultDraw: Boolean);
+  private
+    FProjectID: Integer;
+    FValidProjs: TList;
+    FSelectProjs: TList;
+
+    function HasSelect(AProjectID: Integer): Boolean;
+
+    procedure AddProjs(ANode: TsdIDTreeNode);
+    procedure RemoveProjs(ANode: TsdIDTreeNode);
+
+    procedure AssignSelectTenders;
+
+    function GetTopParent: TsdIDTreeNode;
+    procedure AddValidProject(ANode: TsdIDTreeNode);
+    procedure FilterValidProject;
+
+    function IsValidProj(AID: Integer): Boolean;
+    procedure DoOnFilterRecord(ARecord: TsdDataRecord; var AAllow: Boolean);
+
+    procedure LoadHistorySelects(AProjs: TList);
+  public
+    constructor Create(AProjectID: Integer; AProjs: TList);
+    destructor Destroy; override;
+
+    procedure AssignResult(AProjs: TList);
+  end;
+
+function SelectGatherProject(AProjectID: Integer; AOrgProjs, ANewProjs: TList): Boolean;
+
+implementation
+
+uses
+  Globals, GatherProjInfo, MainFrm;
+
+{$R *.dfm}
+
+function SelectGatherProject(AProjectID: Integer; AOrgProjs, ANewProjs: TList): Boolean;
+var
+  vSelectFrm: TProjGatherSelectForm;
+begin
+  vSelectFrm := TProjGatherSelectForm.Create(AProjectID, AOrgProjs);
+  try
+    Result := vSelectFrm.ShowModal = mrOk;
+    if Result then
+      vSelectFrm.AssignResult(ANewProjs);
+  finally
+    vSelectFrm.Free;
+  end;
+end;
+
+{ TProjGatherSelectForm }
+
+procedure TProjGatherSelectForm.AddProjs(ANode: TsdIDTreeNode);
+var
+  iChild: Integer;
+begin
+  if FSelectProjs.IndexOf(Pointer(ANode.ID)) = -1 then
+    FSelectProjs.Add(Pointer(ANode.id));
+  for iChild := 0 to ANode.ChildCount - 1 do
+    AddProjs(ANode.ChildNodes[iChild]);
+end;
+
+procedure TProjGatherSelectForm.AddValidProject(ANode: TsdIDTreeNode);
+var
+  iChild: Integer;
+begin
+  FValidProjs.Add(ANode);
+  for iChild := 0 to ANode.ChildCount - 1 do
+    AddValidProject(ANode.ChildNodes[iChild]);
+end;
+
+constructor TProjGatherSelectForm.Create(AProjectID: Integer;
+  AProjs: TList);
+begin
+  inherited Create(nil);
+  FProjectID := AProjectID;
+  FValidProjs := TList.Create;
+  FilterValidProject;
+  ProjectManager.sdvProjectsSpare.OnFilterRecord := DoOnFilterRecord;
+  ProjectManager.sdvProjectsSpare.Filtered := True;
+  stdSelectProject.DataView := ProjectManager.sdvProjectsSpare;
+
+  FSelectProjs := TList.Create;
+  LoadHistorySelects(AProjs);
+  AssignSelectTenders;
+end;
+
+destructor TProjGatherSelectForm.Destroy;
+begin
+  ProjectManager.sdvProjectsSpare.Filtered := False;
+  ProjectManager.sdvProjectsSpare.OnFilterRecord := nil;
+  FValidProjs.Free;
+  FSelectProjs.Free;
+  inherited;
+end;
+
+procedure TProjGatherSelectForm.DoOnFilterRecord(ARecord: TsdDataRecord;
+  var AAllow: Boolean);
+begin
+  AAllow := Assigned(ARecord) and IsValidProj(ARecord.ValueByName('ID').AsInteger);
+end;
+
+procedure TProjGatherSelectForm.FilterValidProject;
+var
+  vTopParent: TsdIDTreeNode;
+  i: Integer;
+begin
+  vTopParent := GetTopParent;
+  AddValidProject(vTopParent);
+end;
+
+function TProjGatherSelectForm.GetTopParent: TsdIDTreeNode;
+begin
+  Result := ProjectManager.ProjectsTree.FindNode(FProjectID);
+  while Assigned(Result.Parent) do
+    Result := Result.Parent;
+end;
+
+function TProjGatherSelectForm.HasSelect(AProjectID: Integer): Boolean;
+begin
+  Result := FSelectProjs.IndexOf(Pointer(AProjectID)) <> -1;
+end;
+
+function TProjGatherSelectForm.IsValidProj(AID: Integer): Boolean;
+var
+  i: Integer;
+  vNode: TsdIDTreeNode;
+begin
+  Result := False;
+  for i := 0 to FValidProjs.Count - 1 do
+  begin
+    vNode := TsdIDTreeNode(FValidProjs.Items[i]);
+    if vNode.ID = AID then
+    begin
+      Result := True;
+      Break;
+    end;
+  end;
+end;
+
+procedure TProjGatherSelectForm.RemoveProjs(ANode: TsdIDTreeNode);
+var
+  iChild: Integer;
+begin
+  if FSelectProjs.IndexOf(Pointer(ANode.ID)) <> -1 then
+    FSelectProjs.Remove(Pointer(ANode.id));
+  for iChild := 0 to ANode.ChildCount - 1 do
+    RemoveProjs(ANode.ChildNodes[iChild]);
+end;
+
+procedure TProjGatherSelectForm.zgSelectProjectGetCellText(Sender: TObject;
+  const ACoord: TPoint; var Value: String; DisplayText: Boolean);
+var
+  stnNode: TsdIDTreeNode;
+begin
+  if ACoord.X = 1 then
+  begin
+    stnNode := stdSelectProject.IDTree.Items[ACoord.Y - 1];
+    if Assigned(stnNode) and HasSelect(stnNode.ID) then
+      Value := 'True';
+  end;
+end;
+
+procedure TProjGatherSelectForm.zgSelectProjectSetCellText(Sender: TObject;
+  const ACoord: TPoint; var Value: String; DisplayText: Boolean);
+var
+  stnNode: TsdIDTreeNode;
+begin
+  if ACoord.X = 1 then
+  begin
+    stnNode := stdSelectProject.IDTree.Items[ACoord.Y - 1];
+    if Value = 'True' then
+      AddProjs(stnNode)
+    else
+      RemoveProjs(stnNode);
+  end;
+  zgSelectProject.InvalidateCol(1);
+end;
+
+procedure TProjGatherSelectForm.zgSelectProjectCellTextChanged(
+  Sender: TObject; Col, Row: Integer);
+begin
+  if (Col = 1) then
+    AssignSelectTenders;
+end;
+
+procedure TProjGatherSelectForm.AssignSelectTenders;
+
+  procedure InitResultGrid;
+  begin
+    zgResult.ColCount := 2;
+    zgResult.RowCount := 1;
+    zgResult.Cells[1, 0].Text := 'ËùÑ¡ÏîÄ¿';
+    zgResult.ColWidths[1] := 270;
+  end;
+  
+var
+  stnNode: TsdIDTreeNode;
+  i, iProjectID: Integer;
+begin
+  InitResultGrid;
+  for i := 0 to FSelectProjs.Count - 1 do
+  begin
+    iProjectID := Integer(FSelectProjs.Items[i]);
+    stnNode := stdSelectProject.IDTree.FindNode(iProjectID);
+    if stnNode.Rec.ValueByName('Type').AsInteger = 1 then
+    begin
+      zgResult.RowCount := zgResult.RowCount + 1;
+      zgResult.Cells[1, zgResult.RowCount - 1].Text :=
+        stnNode.Rec.ValueByName('Name').AsString;
+      zgResult.Cells[1, zgResult.RowCount - 1].Align := gaCenterLeft;
+      zgResult.Rows[zgResult.RowCount - 1].Data := stnNode;
+    end;
+  end;
+end;
+
+procedure TProjGatherSelectForm.LoadHistorySelects(AProjs: TList);
+var
+  i: Integer;
+begin
+  for i := 0 to AProjs.Count - 1 do
+    FSelectProjs.Add(Pointer(TGatherProjInfo(AProjs.Items[i]).ProjectID));
+end;
+
+procedure TProjGatherSelectForm.btnOkClick(Sender: TObject);
+begin
+  if zgResult.RowCount > 1 then
+    ModalResult := mrOk;
+end;
+
+procedure TProjGatherSelectForm.AssignResult(AProjs: TList);
+var
+  iRow: Integer;
+  stnNode: TsdIDTreeNode;
+  vGatherProj: TGatherProjInfo;
+begin
+  for iRow := 1 to zgResult.RowCount - 1 do
+  begin
+    stnNode := TsdIDTreeNode(zgResult.Rows[iRow].Data);
+    vGatherProj := TGatherProjInfo.Create(stnNode.Rec);
+    AProjs.Add(vGatherProj);
+  end;
+end;
+
+procedure TProjGatherSelectForm.zgSelectProjectDrawCellText(
+  ACanvas: TCanvas; const ARect: TRect; const ACoord: TPoint;
+  AGrid: TZJGrid; const Text: String; var ADefaultDraw: Boolean);
+
+  procedure GetBitmap(AImage: TBitmap);
+  begin
+    with stdSelectProject.IDTree.Items[ACoord.Y - 1] do
+      if Rec.ValueByName('Type').AsInteger = 0 then
+        if Expanded and HasChildren then
+          MainForm.Images.GetBitmap(34, AImage)
+        else
+          MainForm.Images.GetBitmap(34, AImage)
+      else
+        MainForm.Images.GetBitmap(11, AImage);
+  end;
+
+const
+  rIconWidth = 16;
+  rIconHeight = 16;
+var
+  Img: TBitmap;
+  Cell: TZjCell;
+  rImg: TRect;
+begin
+ if (ACoord.X = 2) and (ACoord.Y > zgSelectProject.FixedRowCount - 1) then
+  begin
+    Cell := zgSelectProject.Cells[ACoord.X, ACoord.Y];
+    Img := TBitmap.Create;
+    try
+      GetBitmap(Img);
+      case Cell.Align of
+        gaTopLeft, gaTopCenter, gaTopRight:
+          rImg := Rect(ARect.Left + 2, ARect.Top, ARect.Left + rIconWidth, ARect.Top + rIconHeight);
+        gaCenterLeft, gaCenterCenter, gaCenterRight:
+          rImg := Rect(ARect.Left + 2, ARect.Top + (ARect.Bottom - ARect.Top - rIconHeight) div 2, ARect.Left + rIconWidth, ARect.Bottom - (ARect.Bottom - ARect.Top - rIconHeight) div 2);
+        gaBottomLeft, gaBottomCenter, gaBottomRight:
+          rImg := Rect(ARect.Left + 2, ARect.Bottom - rIconHeight, ARect.Left + rIconWidth, ARect.Bottom);
+      end;
+      ACanvas.StretchDraw(rImg, Img);
+      WriteText(ACanvas, Rect(ARect.Left + rIconWidth, ARect.Top, ARect.Right, ARect.Bottom)
+        , 2, 2, Text, Cell.Align, False);
+      ADefaultDraw := False;
+    finally
+      Img.Free;
+    end;
+  end;
+end;
+
+end.

+ 456 - 0
ProjGather/ProjGatherTree.pas

@@ -0,0 +1,456 @@
+unit ProjGatherTree;
+
+interface
+
+uses
+  CacheTree, Classes, CalcData;
+
+type
+  TProjGatherTreeNode = class(TCacheNode)
+  private
+    FCode: string;
+    FB_Code: string;
+    FName: string;
+    FUnits: string;
+    FPrice: Double;
+
+    FSerialNo: Integer;
+    FXiangCode: string;
+    FMuCode: string;
+    FJieCode: string;
+    FXiMuCode: string;
+    FIndexCode: string;
+    FChapterParentID: Integer;
+
+    FGatherCalc: TProjCalc;
+    FProjs: TList;
+    function GetProjCount: Integer;
+    function GetProj(AIndex: Integer): TProjCalc;
+    function GetChapterParentID: Integer;
+    function GetLevel: Integer;
+  public
+    constructor Create(ACacheTree: TCacheTree; AID: Integer; AProjCount: Integer);
+    destructor Destroy; override;
+
+    procedure InitTotalPrice_Rc;
+    procedure UpdateTotalPrice_Rc(ANode: TProjGatherTreeNode);
+    procedure CalcTotalPrice_Rc;
+
+    procedure InitCalcData;
+    procedure AddCalcData(ANode: TProjGatherTreeNode);
+    procedure MinusCalcData(ANode: TProjGatherTreeNode);
+
+    property Code: string read FCode write FCode;
+    property B_Code: string read FB_Code write FB_Code;
+    property Name: string read FName write FName;
+    property Units: string read FUnits write FUnits;
+    property Price: Double read FPrice write FPrice;
+
+    property SerialNo: Integer read FSerialNo write FSerialNo;
+
+    property XiangCode: string read FXiangCode write FXiangCode;
+    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 Level: Integer read GetLevel;
+    property ChapterParentID: Integer read GetChapterParentID;
+
+    property GatherCalc: TProjCalc read FGatherCalc;
+
+    property ProjCount: Integer read GetProjCount;
+    property Proj[AIndex: Integer]: TProjCalc read GetProj;
+  end;
+
+  TProjGatherTree = class(TCacheTree)
+  private
+    FProjCount: Integer;
+    FFixedIDNodes: TList;
+    FGatherNode: TProjGatherTreeNode;
+
+    FSerialNo: Integer;
+    function GetNewNode(AFixedID: Integer = -1): TProjGatherTreeNode;
+
+    procedure Calculate(ANode: TProjGatherTreeNode);
+    procedure CalcGatherNode;
+  public
+    constructor Create(AProjCount: Integer);
+    destructor Destroy; override;
+
+    function AddNode(AParent, ANextSibling: TProjGatherTreeNode; AFixedID: Integer = -1): TProjGatherTreeNode;
+
+    function FindNode(AParent: TProjGatherTreeNode; const ACode, AB_Code, AName: string; APrice: Double): TProjGatherTreeNode; overload;
+    function FindNode(AParent: TProjGatherTreeNode; const ACode, AB_Code: string; APrice: Double): TProjGatherTreeNode; overload;
+    function FindNode(AParent: TProjGatherTreeNode; const AName: string; APrice: Double): TProjGatherTreeNode; overload;
+
+    function FindNode(AFixedID: Integer): TProjGatherTreeNode; overload;
+
+    function FindNextSibling(AParent: TProjGatherTreeNode; const ACode, AB_Code: string): TProjGatherTreeNode;
+
+    procedure CalculateAll;
+
+    procedure SaveDebugFile(const AFileName: string);
+
+    property GatherNode: TProjGatherTreeNode read FGatherNode;
+  end;
+
+implementation
+
+uses
+  ZhAPI, SysUtils, ConditionalDefines;
+
+{ TProjGatherTreeNode }
+
+procedure TProjGatherTreeNode.AddCalcData(ANode: TProjGatherTreeNode);
+var
+  iProj: Integer;
+begin
+  GatherCalc.AddCalcData(ANode.GatherCalc);
+  for iProj := 0 to ProjCount - 1 do
+    Proj[iProj].AddCalcData(ANode.Proj[iProj]);
+end;
+
+procedure TProjGatherTreeNode.CalcTotalPrice_Rc;
+var
+  iProj: Integer;
+begin
+  GatherCalc.CalcTotalPrice_Rc(Price);
+  for iProj := 0 to ProjCount - 1 do
+    Proj[iProj].CalcTotalPrice_Rc(Price);
+end;
+
+constructor TProjGatherTreeNode.Create(ACacheTree: TCacheTree; AID: Integer; AProjCount: Integer);
+var
+  i: Integer;
+  ProjCalc: TProjCalc;
+begin
+  inherited Create(ACacheTree, AID);
+  FGatherCalc := TProjCalc.Create;
+  FProjs := TList.Create;
+  for i := 0 to AProjCount - 1 do
+  begin
+    ProjCalc := TProjCalc.Create;
+    FProjs.Add(ProjCalc);
+  end;
+end;
+
+destructor TProjGatherTreeNode.Destroy;
+begin
+  FGatherCalc.free;
+  ClearObjects(FProjs);
+  FProjs.Free;
+  inherited;
+end;
+
+function TProjGatherTreeNode.GetChapterParentID: Integer;
+var
+  vNode: TProjGatherTreeNode;
+begin
+  Result := -1;
+  if Self.Level > 2 then
+  begin
+    vNode := TProjGatherTreeNode(Self.Parent);
+    while vNode.Level > 2 do
+      vNode := TProjGatherTreeNode(vNode.Parent);
+    Result := vNode.ID
+  end;
+end;
+
+function TProjGatherTreeNode.GetLevel: Integer;
+begin
+  if Assigned(Parent) and (Parent.ID <> -1) then
+    Result := TProjGatherTreeNode(Parent).Level + 1
+  else
+    Result := 1;
+end;
+
+function TProjGatherTreeNode.GetProj(AIndex: Integer): TProjCalc;
+begin
+  Result := TProjCalc(FProjs.Items[AIndex]);
+end;
+
+function TProjGatherTreeNode.GetProjCount: Integer;
+begin
+  Result := FProjs.Count;
+end;
+
+procedure TProjGatherTreeNode.InitCalcData;
+var
+  iProj: Integer;
+begin
+  GatherCalc.InitCalcData;
+  for iProj := 0 to ProjCount - 1 do
+    Proj[iProj].InitCalcData;
+end;
+
+procedure TProjGatherTreeNode.InitTotalPrice_Rc;
+var
+  iProj: Integer;
+begin
+  GatherCalc.InitTotalPrice_Rc;
+  for iProj := 0 to ProjCount - 1 do
+    Proj[iProj].InitTotalPrice_Rc;
+end;
+
+procedure TProjGatherTreeNode.MinusCalcData(ANode: TProjGatherTreeNode);
+var
+  iProj: Integer;
+begin
+  GatherCalc.MinusCalcData(ANode.GatherCalc);
+  for iProj := 0 to ProjCount - 1 do
+    Proj[iProj].MinusCalcData(ANode.Proj[iProj]);
+end;
+
+procedure TProjGatherTreeNode.UpdateTotalPrice_Rc(ANode: TProjGatherTreeNode);
+var
+  iProj: Integer;
+begin
+  GatherCalc.UpdateTotalPrice_Rc(ANode.GatherCalc);
+  for iProj := 0 to ANode.ProjCount - 1 do
+    Proj[iProj].UpdateTotalPrice_Rc(ANode.Proj[iProj]);
+end;
+
+{ TProjGatherTree }
+
+procedure TProjGatherTree.Calculate(ANode: TProjGatherTreeNode);
+var
+  iChild: Integer;
+  vChild: TProjGatherTreeNode;
+begin
+  ANode.SerialNo := FSerialNo;
+  Inc(FSerialNo);
+
+  ANode.InitTotalPrice_Rc;
+  if ANode.Children.Count > 0 then
+  begin
+    for iChild := 0 to ANode.Children.Count - 1 do
+    begin
+      vChild := TProjGatherTreeNode(ANode.Children.Items[iChild]);
+      Calculate(vChild);
+      ANode.UpdateTotalPrice_Rc(vChild);
+    end;
+  end
+  else
+    ANode.CalcTotalPrice_Rc;
+end;
+
+procedure TProjGatherTree.CalculateAll;
+var
+  vNode: TProjGatherTreeNode;
+begin
+  FSerialNo := 1;
+  vNode :=  TProjGatherTreeNode(FirstNode);
+  while Assigned(vNode) do
+  begin
+    Calculate(vNode);
+    vNode := TProjGatherTreeNode(vNode.NextSibling);
+  end;
+  CalcGatherNode;
+end;
+
+constructor TProjGatherTree.Create(AProjCount: Integer);
+begin
+  inherited Create;
+  FProjCount := AProjCount;
+  FFixedIDNodes := TList.Create;
+  FGatherNode := TProjGatherTreeNode.Create(nil, -2, AProjCount);
+end;
+
+destructor TProjGatherTree.Destroy;
+begin
+  FGatherNode.Free;
+  FFixedIDNodes.Free;
+  inherited;
+end;
+
+function TProjGatherTree.FindNode(AParent: TProjGatherTreeNode;
+  const ACode, AB_Code, AName: string;
+  APrice: Double): TProjGatherTreeNode;
+var
+  iChild: Integer;
+  vChild: TProjGatherTreeNode;
+begin
+  Result := nil;
+  for iChild := 0 to AParent.Children.Count - 1 do
+  begin
+    vChild := TProjGatherTreeNode(AParent.Children.Items[iChild]);
+    if (vChild.Code = ACode) and (vChild.B_Code = AB_Code) and
+       (vChild.Name = AName) and (abs(vChild.Price - APrice) < 0.00001) then
+    begin
+      Result := vChild;
+      Break;
+    end;
+  end;
+end;
+
+function TProjGatherTree.FindNode(AParent: TProjGatherTreeNode;
+  const ACode, AB_Code: string; APrice: Double): TProjGatherTreeNode;
+var
+  iChild: Integer;
+  vChild: TProjGatherTreeNode;
+begin
+  Result := nil;
+  for iChild := 0 to AParent.Children.Count - 1 do
+  begin
+    vChild := TProjGatherTreeNode(AParent.Children.Items[iChild]);
+    if (vChild.Code = ACode) and (vChild.B_Code = AB_Code) and
+       (abs(vChild.Price - APrice) < 0.00001) then
+    begin
+      Result := vChild;
+      Break;
+    end;
+  end;
+end;
+
+function TProjGatherTree.FindNode(AParent: TProjGatherTreeNode;
+  const AName: string; APrice: Double): TProjGatherTreeNode;
+var
+  iChild: Integer;
+  vChild: TProjGatherTreeNode;
+begin
+  Result := nil;
+  for iChild := 0 to AParent.Children.Count - 1 do
+  begin
+    vChild := TProjGatherTreeNode(AParent.Children.Items[iChild]);
+    if (vChild.Name = AName) and (abs(vChild.Price - APrice) < 0.00001) then
+    begin
+      Result := vChild;
+      Break;
+    end;
+  end;
+end;
+
+function TProjGatherTree.FindNextSibling(AParent: TProjGatherTreeNode;
+  const ACode, AB_Code: string): TProjGatherTreeNode;
+var
+  vNext: TProjGatherTreeNode;
+  sCodeID, sCodeID2, sB_CodeID, sB_CodeID2: string;
+begin
+  Result := nil;
+  if Assigned(AParent) then
+    vNext := TProjGatherTreeNode(AParent.FirstChild)
+  else
+    vNext := TProjGatherTreeNode(Root.FirstChild);
+  if (ACode = '') and (AB_Code = '') then Exit;
+
+  sCodeID := ConvertDigitCode(ACode, 3, '-');
+  sB_CodeID := ConvertDigitCode(AB_Code, 4, '-');
+  while Assigned(vNext) do
+  begin
+    sCodeID2 := ConvertDigitCode(vNext.Code, 3, '-');
+    sB_CodeID2 := ConvertDigitCode(vNext.B_Code, 4, '-');
+    if sCodeID < sCodeID2 then
+    begin
+      Result := vNext;
+      Break;
+    end
+    else if sB_CodeID < sB_CodeID2 then
+    begin
+      Result := vNext;
+      Break;
+    end;
+    vNext := TProjGatherTreeNode(vNext.NextSibling);
+  end;
+end;
+
+function TProjGatherTree.FindNode(AFixedID: Integer): TProjGatherTreeNode;
+var
+  i: Integer;
+  vNode: TProjGatherTreeNode;
+begin
+  Result := nil;
+  for i := 0 to FFixedIDNodes.Count - 1 do
+  begin
+    vNode := TProjGatherTreeNode(FFixedIDNodes.Items[i]);
+    if vNode.ID = AFixedID then
+    begin
+      Result := vNode;
+      Break;
+    end;
+  end;
+end;
+
+function TProjGatherTree.GetNewNode(AFixedID: Integer): TProjGatherTreeNode;
+begin
+  if AFixedID <> -1 then
+  begin
+    Result := TProjGatherTreeNode.Create(Self, AFixedID, FProjCount);
+    FFixedIDNodes.Add(Result);
+  end
+  else
+    Result := TProjGatherTreeNode.Create(Self, GetNewNodeID, FProjCount);
+  CacheNodes.Add(Result);
+end;
+
+function TProjGatherTree.AddNode(AParent, ANextSibling: TProjGatherTreeNode;
+  AFixedID: Integer): TProjGatherTreeNode;
+begin
+  Result := GetNewNode(AFixedID);
+  if Assigned(ANextSibling) then
+    ANextSibling.InsertPreSibling(Result)
+  else if Assigned(AParent) then
+    AParent.InsertChild(Result)
+  else
+    Root.InsertChild(Result);
+end;
+
+procedure TProjGatherTree.SaveDebugFile(const AFileName: string);
+var
+  sgs: TStringList;
+  i: Integer;
+  vNode: TProjGatherTreeNode;
+begin
+  sgs := TStringList.Create;
+  try
+    for i := 0 to CacheNodes.Count - 1 do
+    begin
+      vNode := TProjGatherTreeNode(CacheNodes.Items[i]);
+      sgs.Add(Format('ID: %d; Code: %s; B_Code: %s; Name: %s', [vNode.ID, vNode.Code, vNode.B_Code, vNode.Name]));
+    end;
+    sgs.SaveToFile(AFileName);
+  finally
+    sgs.Free;
+  end;
+end;
+
+procedure TProjGatherTree.CalcGatherNode;
+
+ procedure AddGatherCalc(AID: Integer);
+ var
+   vNode: TProjGatherTreeNode;
+ begin
+    vNode := FindNode(AID);
+    if Assigned(vNode) then
+      GatherNode.AddCalcData(vNode);
+ end;
+
+ procedure MinusGatherCalc(AID: Integer);
+ var
+   vNode: TProjGatherTreeNode;
+ begin
+    vNode := FindNode(AID);         
+    if Assigned(vNode) then
+      GatherNode.MinusCalcData(vNode);
+ end;
+
+begin
+  GatherNode.InitCalcData;
+  // 全国
+  // 第一部分(1)+第二部分(2)+第三部分(3)+预备费(7)+新增加费用项目(其他费用_广东)(15)-回收金额(16)
+  AddGatherCalc(1);
+  AddGatherCalc(2);
+  AddGatherCalc(3);
+  AddGatherCalc(7);
+  AddGatherCalc(15);
+  MinusGatherCalc(16);
+  // 广东
+  // 全国的基础上+建设期贷款利息(34)+公路功能以外的项目(9)
+  if _IsGuangDong then
+  begin
+    AddGatherCalc(34);
+    AddGatherCalc(9);
+  end;
+end;
+
+end.

+ 234 - 0
Report/ProjGather/rProjGatherTables.pas

@@ -0,0 +1,234 @@
+unit rProjGatherTables;
+
+interface
+
+uses
+  DataBaseTables;
+
+const
+  SGatherProj = 'r_GatherProj';
+  tdGatherProj: array [0..2] of TScFieldDef =(
+    (FieldName: 'ID'; FieldType: ftInteger; Size: 0; NotNull: True; PrimaryKey: True; ForceUpdate: False),
+    // 标段 -- 项目管理ID
+    (FieldName: 'ProjectID'; FieldType: ftInteger; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 标段 -- 名称
+    (FieldName: 'ProjectName'; FieldType: ftString; Size: 255; NotNull: False; PrimaryKey: False; ForceUpdate: False)
+  );
+
+  SBills = 'r_Bills';
+  tdBills: array [0..15] of TScFieldDef =(
+    (FieldName: 'ID'; FieldType: ftInteger; Size: 0; NotNull: True; PrimaryKey: True; ForceUpdate: False),
+    (FieldName: 'ParentID'; FieldType: ftInteger; Size: 0; NotNull: True; PrimaryKey: False; ForceUpdate: False),
+    (FieldName: 'NextSiblingID'; FieldType: ftInteger; Size: 0; NotNull: True; PrimaryKey: False; ForceUpdate: False),
+    //--3
+
+    // 项目节编号
+    (FieldName: 'Code'; FieldType: ftString; Size: 50; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 清单编号
+    (FieldName: 'B_Code'; FieldType: ftString; Size: 50; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 名称
+    (FieldName: 'Name'; FieldType: ftString; Size: 200; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 单位
+    (FieldName: 'Units'; FieldType: ftstring; Size: 20; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 单价
+    (FieldName: 'Price'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    //--5
+
+    // 排序
+    (FieldName: 'SerialNo'; FieldType: ftInteger; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 是否最底层节点
+    (FieldName: 'IsLeaf'; FieldType: ftBoolean; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 项
+    (FieldName: 'XiangCode'; FieldType: ftString; Size: 10; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 目
+    (FieldName: 'MuCode'; FieldType: ftString; Size: 10; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 节
+    (FieldName: 'JieCode'; FieldType: ftString; Size: 10; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 细目
+    (FieldName: 'XiMuCode'; FieldType: ftString; Size: 30; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 工程量清单排序编号
+    (FieldName: 'IndexCode'; FieldType: ftString; Size: 50; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 章级父项ID
+    (FieldName: 'ChapterParentID'; FieldType: ftInteger; size: 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 =(
+    // 与Bills表ID对应
+    (FieldName: 'ID'; FieldType: ftInteger; Size: 0; NotNull: True; PrimaryKey: True; ForceUpdate: False),
+    // 对应于r_GatherProj中的ID字段
+    (FieldName: 'ProjID'; FieldType: ftInteger; Size: 0; NotNull: True; PrimaryKey: True; ForceUpdate: False),
+
+    // 施工图原设计 -- 数量
+    (FieldName: 'OrgQuantity'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 施工图原设计 -- 金额
+    (FieldName: 'OrgTotalPrice'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 施工图原设计 -- 金额 -- 重算
+    (FieldName: 'OrgTotalPrice_Rc'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 设计错漏增减 -- 数量
+    (FieldName: 'MisQuantity'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 设计错漏增减 -- 金额
+    (FieldName: 'MisTotalPrice'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 设计错漏增减 -- 金额 -- 重算
+    (FieldName: 'MisTotalPrice_Rc'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 其他原因增减 -- 数量
+    (FieldName: 'OthQuantity'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 其他原因增减 -- 金额
+    (FieldName: 'OthTotalPrice'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 其他原因增减 -- 金额 -- 重算
+    (FieldName: 'OthTotalPrice_Rc'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 合同 - 数量
+    (FieldName: 'Quantity'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 合同 - 金额
+    (FieldName: 'TotalPrice'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 合同 - 金额 -- 重算
+    (FieldName: 'TotalPrice_Rc'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    //--12
+
+    // ------------ 0号台账 ----------------
+    // 设计数量1
+    (FieldName: 'DgnQuantity1'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 设计数量2
+    (FieldName: 'DgnQuantity2'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 设计数量
+    (FieldName: 'DgnQuantity'; FieldType: ftString; Size: 50; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 经济指标1
+    (FieldName: 'DgnPrice1'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 经济指标2
+    (FieldName: 'DgnPrice2'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 经济指标(经济指标1/经济指标2)
+    (FieldName: 'DgnPrice'; FieldType: ftString; Size: 50; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 经济指标1 -- 重算
+    (FieldName: 'DgnPrice1_Rc'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 经济指标2 -- 重算
+    (FieldName: 'DgnPrice2_Rc'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 经济指标(经济指标1/经济指标2)-- 重算
+    (FieldName: 'DgnPrice_Rc'; FieldType: ftString; Size: 50; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    //--9
+
+    // ------------合同----------------
+    // 设计数量1
+    (FieldName: 'DealDgnQuantity1'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 设计数量2
+    (FieldName: 'DealDgnQuantity2'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 设计数量
+    (FieldName: 'DealDgnQuantity'; FieldType: ftString; Size: 50; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // --3
+
+    // ----------------变更-------------------
+    // 设计数量1
+    (FieldName: 'CDgnQuantity1'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 设计数量2
+    (FieldName: 'CDgnQuantity2'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 设计数量
+    (FieldName: 'CDgnQuantity'; FieldType: ftString; Size: 50; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // --3
+
+    //  --------------------计量:合同+变更--------------------
+    // 设计数量1
+    (FieldName: 'FinalDgnQuantity1'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 设计数量2
+    (FieldName: 'FinalDgnQuantity2'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 设计数量
+    (FieldName: 'FinalDgnQuantity'; FieldType: ftString; Size: 50; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 经济指标1
+    (FieldName: 'FinalDgnPrice1'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 经济指标2
+    (FieldName: 'FinalDgnPrice2'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 经济指标(经济指标1/经济指标2)
+    (FieldName: 'FinalDgnPrice'; FieldType: ftString; Size: 50; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 经济指标1 -- 重算
+    (FieldName: 'FinalDgnPrice1_Rc'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 经济指标2 -- 重算
+    (FieldName: 'FinalDgnPrice2_Rc'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 经济指标(经济指标1/经济指标2)-- 重算
+    (FieldName: 'FinalDgnPrice_Rc'; FieldType: ftString; Size: 50; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // --9
+
+    // 累计合同 -- 数量
+    (FieldName: 'AddDealQuantity'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 累计合同 -- 金额
+    (FieldName: 'AddDealTotalPrice'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 累计合同 -- 金额 -- 重算
+    (FieldName: 'AddDealTotalPrice_Rc'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 累计变更 -- 数量
+    (FieldName: 'AddQcQuantity'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 累计变更 -- 金额
+    (FieldName: 'AddQcTotalPrice'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 累计变更 -- 金额 -- 重算
+    (FieldName: 'AddQcTotalPrice_Rc'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 累计完成 -- 数量
+    (FieldName: 'AddGatherQuantity'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 累计完成 -- 金额
+    (FieldName: 'AddGatherTotalPrice'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 累计完成 -- 金额 -- 重算
+    (FieldName: 'AddGatherTotalPrice_Rc'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    //--9
+
+    // 本期合同 -- 数量
+    (FieldName: 'CurDealQuantity'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 本期合同 -- 金额
+    (FieldName: 'CurDealTotalPrice'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 本期合同 -- 金额 -- 重算
+    (FieldName: 'CurDealTotalPrice_Rc'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 本期变更 -- 数量
+    (FieldName: 'CurQcQuantity'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 本期变更 -- 金额
+    (FieldName: 'CurQcTotalPrice'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 本期变更 -- 金额 -- 重算
+    (FieldName: 'CurQcTotalPrice_Rc'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 本期完成 -- 数量
+    (FieldName: 'CurGatherQuantity'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 本期完成 -- 金额
+    (FieldName: 'CurGatherTotalPrice'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 本期完成 -- 金额 -- 重算
+    (FieldName: 'CurGatherTotalPrice_Rc'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    //--9
+
+    // 截止上期合同 -- 数量
+    (FieldName: 'PreDealQuantity'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 截止上期合同 -- 金额
+    (FieldName: 'PreDealTotalPrice'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 截止上期合同 -- 金额 -- 重算
+    (FieldName: 'PreDealTotalPrice_Rc'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 截止上期变更 -- 数量
+    (FieldName: 'PreQcQuantity'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 截止上期变更 -- 金额
+    (FieldName: 'PreQcTotalPrice'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 截止上期变更 -- 金额 -- 重算
+    (FieldName: 'PreQcTotalPrice_Rc'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 截止上期完成 -- 数量
+    (FieldName: 'PreGatherQuantity'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 截止上期完成 -- 金额
+    (FieldName: 'PreGatherTotalPrice'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 截止上期完成 -- 金额 -- 重算
+    (FieldName: 'PreGatherTotalPrice_Rc'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    //--9
+
+    // 截止本期合同 -- 数量
+    (FieldName: 'EndDealQuantity'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 截止本期合同 -- 金额
+    (FieldName: 'EndDealTotalPrice'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 截止本期合同 -- 金额 -- 重算
+    (FieldName: 'EndDealTotalPrice_Rc'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 截止本期变更 -- 数量
+    (FieldName: 'EndQcQuantity'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 截止本期变更 -- 金额
+    (FieldName: 'EndQcTotalPrice'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 截止本期变更 -- 金额 -- 重算
+    (FieldName: 'EndQcTotalPrice_Rc'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 截止本期完成 -- 数量
+    (FieldName: 'EndGatherQuantity'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 截止本期完成 -- 金额
+    (FieldName: 'EndGatherTotalPrice'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 截止本期完成 -- 金额 -- 重算
+    (FieldName: 'EndGatherTotalPrice_Rc'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False)
+    //--9
+  );
+
+implementation
+
+end.

+ 7 - 0
Report/ProjGather/rgpGatherControl.pas

@@ -0,0 +1,7 @@
+unit rgpGatherControl;
+
+interface
+
+implementation
+
+end.

+ 17 - 0
Report/ProjGather/rpgBillsCalcDm.dfm

@@ -0,0 +1,17 @@
+object rpgBillsCalcData: TrpgBillsCalcData
+  OldCreateOrder = False
+  Left = 192
+  Top = 110
+  Height = 173
+  Width = 215
+  object sdpBillsCalc: TsdADOProvider
+    Left = 64
+    Top = 16
+  end
+  object sddBillsCalc: TsdDataSet
+    Active = False
+    Provider = sdpBillsCalc
+    Left = 64
+    Top = 64
+  end
+end

+ 162 - 0
Report/ProjGather/rpgBillsCalcDm.pas

@@ -0,0 +1,162 @@
+unit rpgBillsCalcDm;
+
+interface
+
+uses
+  SysUtils, Classes, sdDB, sdProvider, ADODB, ProjGatherTree, CalcData;
+
+type
+  TrpgBillsCalcData = class(TDataModule)
+    sdpBillsCalc: TsdADOProvider;
+    sddBillsCalc: TsdDataSet;
+  private
+    procedure SaveBillsNodeCalc(ANode: TProjGatherTreeNode; AProjCalc: TProjCalc; AProjIndex: Integer);
+    procedure SaveBillsCalc(ATree: TProjGatherTree; AProjIndex: Integer);
+    procedure SaveBillsGather(ATree: TProjGatherTree);
+  public
+    constructor Create(AConnection: TADOConnection);
+
+    procedure SaveProjDataTo(ATree: TProjGatherTree; AProjIndex: Integer; const ATableName: string);
+    procedure SaveGatherDataTo(ATree: TProjGatherTree; const ATableName: string);
+  end;
+
+implementation
+
+uses CacheTree;
+
+{$R *.dfm}
+
+{ TrpgBillsCalcData }
+
+constructor TrpgBillsCalcData.Create(AConnection: TADOConnection);
+begin
+  inherited Create(nil);
+  sdpBillsCalc.Connection := AConnection;
+end;
+
+procedure TrpgBillsCalcData.SaveBillsCalc(ATree: TProjGatherTree;
+  AProjIndex: Integer);
+var
+  iNode: Integer;
+  vNode: TProjGatherTreeNode;
+begin
+  for iNode := 0 to ATree.CacheNodes.Count - 1 do
+  begin
+    vNode := TProjGatherTreeNode(ATree.CacheNodes.Items[iNode]);
+    SaveBillsNodeCalc(vNode, vNode.Proj[AProjIndex], AProjIndex);
+  end;
+end;
+
+procedure TrpgBillsCalcData.SaveBillsGather(ATree: TProjGatherTree);
+var
+  iNode: Integer;
+  vNode: TProjGatherTreeNode;
+begin
+  for iNode := 0 to ATree.CacheNodes.Count - 1 do
+  begin
+    vNode := TProjGatherTreeNode(ATree.CacheNodes.Items[iNode]);
+    SaveBillsNodeCalc(vNode, vNode.GatherCalc, -2);
+  end;
+end;
+
+procedure TrpgBillsCalcData.SaveBillsNodeCalc(ANode: TProjGatherTreeNode;
+  AProjCalc: TProjCalc; AProjIndex: Integer);
+var
+  Rec: TsdDataRecord;
+begin
+  Rec := sddBillsCalc.Add;
+  Rec.ValueByName('ID').AsInteger := ANode.ID;
+  Rec.ValueByName('ProjID').AsInteger := AProjIndex;
+
+  Rec.ValueByName('OrgQuantity').AsFloat := AProjCalc.Compile.Org.Quantity;
+  Rec.ValueByName('OrgTotalPrice').AsFloat := AProjCalc.Compile.Org.TotalPrice;
+  Rec.ValueByName('OrgTotalPrice_Rc').AsFloat := AProjCalc.Compile.Org.TotalPrice_Rc;
+  Rec.ValueByName('MisQuantity').AsFloat := AProjCalc.Compile.Mis.Quantity;
+  Rec.ValueByName('MisTotalPrice').AsFloat := AProjCalc.Compile.Mis.TotalPrice;
+  Rec.ValueByName('MisTotalPrice_Rc').AsFloat := AProjCalc.Compile.Mis.TotalPrice_Rc;
+  Rec.ValueByName('OthQuantity').AsFloat := AProjCalc.Compile.Oth.Quantity;
+  Rec.ValueByName('OthTotalPrice').AsFloat := AProjCalc.Compile.Oth.TotalPrice;
+  Rec.ValueByName('OthTotalPrice_Rc').AsFloat := AProjCalc.Compile.Oth.TotalPrice_Rc;
+  Rec.ValueByName('Quantity').AsFloat := AProjCalc.Compile.SubTotal.Quantity;
+  Rec.ValueByName('TotalPrice').AsFloat := AProjCalc.Compile.SubTotal.TotalPrice;
+  Rec.ValueByName('TotalPrice_Rc').AsFloat := AProjCalc.Compile.SubTotal.TotalPrice_Rc;
+
+  Rec.ValueByName('AddDealQuantity').AsFloat := AProjCalc.AddMeasure.Deal.Quantity;
+  Rec.ValueByName('AddDealTotalPrice').AsFloat := AProjCalc.AddMeasure.Deal.TotalPrice;
+  Rec.ValueByName('AddDealTotalPrice_Rc').AsFloat := AProjCalc.AddMeasure.Deal.TotalPrice_Rc;
+  Rec.ValueByName('AddQcQuantity').AsFloat := AProjCalc.AddMeasure.Qc.Quantity;
+  Rec.ValueByName('AddQcTotalPrice').AsFloat := AProjCalc.AddMeasure.Qc.TotalPrice;
+  Rec.ValueByName('AddQcTotalPrice_Rc').AsFloat := AProjCalc.AddMeasure.Qc.TotalPrice_Rc;
+  Rec.ValueByName('AddGatherQuantity').AsFloat := AProjCalc.AddMeasure.Gather.Quantity;
+  Rec.ValueByName('AddGatherTotalPrice').AsFloat := AProjCalc.AddMeasure.Gather.TotalPrice;
+  Rec.ValueByName('AddGatherTotalPrice_Rc').AsFloat := AProjCalc.AddMeasure.Gather.TotalPrice_Rc;
+
+  Rec.ValueByName('CurDealQuantity').AsFloat := AProjCalc.CurMeasure.Deal.Quantity;
+  Rec.ValueByName('CurDealTotalPrice').AsFloat := AProjCalc.CurMeasure.Deal.TotalPrice;
+  Rec.ValueByName('CurDealTotalPrice_Rc').AsFloat := AProjCalc.CurMeasure.Deal.TotalPrice_Rc;
+  Rec.ValueByName('CurQcQuantity').AsFloat := AProjCalc.CurMeasure.Qc.Quantity;
+  Rec.ValueByName('CurQcTotalPrice').AsFloat := AProjCalc.CurMeasure.Qc.TotalPrice;
+  Rec.ValueByName('CurQcTotalPrice_Rc').AsFloat := AProjCalc.CurMeasure.Qc.TotalPrice_Rc;
+  Rec.ValueByName('CurGatherQuantity').AsFloat := AProjCalc.CurMeasure.Gather.Quantity;
+  Rec.ValueByName('CurGatherTotalPrice').AsFloat := AProjCalc.CurMeasure.Gather.TotalPrice;
+  Rec.ValueByName('CurGatherTotalPrice_Rc').AsFloat := AProjCalc.CurMeasure.Gather.TotalPrice_Rc;
+
+  Rec.ValueByName('PreDealQuantity').AsFloat := AProjCalc.PreMeasure.Deal.Quantity;
+  Rec.ValueByName('PreDealTotalPrice').AsFloat := AProjCalc.PreMeasure.Deal.TotalPrice;
+  Rec.ValueByName('PreDealTotalPrice_Rc').AsFloat := AProjCalc.PreMeasure.Deal.TotalPrice_Rc;
+  Rec.ValueByName('PreQcQuantity').AsFloat := AProjCalc.PreMeasure.Qc.Quantity;
+  Rec.ValueByName('PreQcTotalPrice').AsFloat := AProjCalc.PreMeasure.Qc.TotalPrice;
+  Rec.ValueByName('PreQcTotalPrice_Rc').AsFloat := AProjCalc.PreMeasure.Qc.TotalPrice_Rc;
+  Rec.ValueByName('PreGatherQuantity').AsFloat := AProjCalc.PreMeasure.Gather.Quantity;
+  Rec.ValueByName('PreGatherTotalPrice').AsFloat := AProjCalc.PreMeasure.Gather.TotalPrice;
+  Rec.ValueByName('PreGatherTotalPrice_Rc').AsFloat := AProjCalc.PreMeasure.Gather.TotalPrice_Rc;
+
+  Rec.ValueByName('EndDealQuantity').AsFloat := AProjCalc.EndMeasure.Deal.Quantity;
+  Rec.ValueByName('EndDealTotalPrice').AsFloat := AProjCalc.EndMeasure.Deal.TotalPrice;
+  Rec.ValueByName('EndDealTotalPrice_Rc').AsFloat := AProjCalc.EndMeasure.Deal.TotalPrice_Rc;
+  Rec.ValueByName('EndQcQuantity').AsFloat := AProjCalc.EndMeasure.Qc.Quantity;
+  Rec.ValueByName('EndQcTotalPrice').AsFloat := AProjCalc.EndMeasure.Qc.TotalPrice;
+  Rec.ValueByName('EndQcTotalPrice_Rc').AsFloat := AProjCalc.EndMeasure.Qc.TotalPrice_Rc;
+  Rec.ValueByName('EndGatherQuantity').AsFloat := AProjCalc.EndMeasure.Gather.Quantity;
+  Rec.ValueByName('EndGatherTotalPrice').AsFloat := AProjCalc.EndMeasure.Gather.TotalPrice;
+  Rec.ValueByName('EndGatherTotalPrice_Rc').AsFloat := AProjCalc.EndMeasure.Gather.TotalPrice_Rc;
+
+  Rec.ValueByName('DgnQuantity1').AsFloat := AProjCalc.DgnQuantity1;
+  Rec.ValueByName('DgnQuantity2').AsFloat := AProjCalc.DgnQuantity2;
+  Rec.ValueByName('DealDgnQuantity1').AsFloat := AProjCalc.DealDgnQuantity1;
+  Rec.ValueByName('DealDgnQuantity2').AsFloat := AProjCalc.DealDgnQuantity2;
+  Rec.ValueByName('CDgnQuantity1').AsFloat := AProjCalc.CDgnQuantity1;
+  Rec.ValueByName('CDgnQuantity2').AsFloat := AProjCalc.CDgnQuantity2;
+end;
+
+procedure TrpgBillsCalcData.SaveGatherDataTo(ATree: TProjGatherTree;
+  const ATableName: string);
+begin
+  sdpBillsCalc.TableName := ATableName;
+  sddBillsCalc.Open;
+  sddBillsCalc.BeginUpdate;
+  try
+    SaveBillsGather(ATree);
+    SaveBillsNodeCalc(ATree.GatherNode, ATree.GatherNode.GatherCalc, -2);
+  finally
+    sddBillsCalc.EndUpdate;
+    sddBillsCalc.Save;
+  end;
+end;
+
+procedure TrpgBillsCalcData.SaveProjDataTo(ATree: TProjGatherTree; AProjIndex: Integer;
+  const ATableName: string);
+begin
+  sdpBillsCalc.TableName := ATableName;
+  sddBillsCalc.Open;
+  sddBillsCalc.BeginUpdate;
+  try
+    SaveBillsCalc(ATree, AProjIndex);
+    SaveBillsNodeCalc(ATree.GatherNode, ATree.GatherNode.Proj[AProjIndex], AProjIndex);
+  finally
+    sddBillsCalc.EndUpdate;
+    sddBillsCalc.Save;
+  end;
+end;
+
+end.

+ 59 - 0
Report/ProjGather/rpgBillsDm.dfm

@@ -0,0 +1,59 @@
+object rpgBillsData: TrpgBillsData
+  OldCreateOrder = False
+  Left = 530
+  Top = 351
+  Height = 200
+  Width = 148
+  object sdpBills: TsdADOProvider
+    Left = 48
+    Top = 16
+  end
+  object sddBills: TsdDataSet
+    Active = False
+    Provider = sdpBills
+    Left = 48
+    Top = 80
+    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
+      0844617461547970650218084461746153697A65020A0549734B6579080F4E65
+      656450726F636573734E616D65090001044E616D6506064D75436F6465094669
+      656C644E616D6506064D75436F64650844617461547970650218084461746153
+      697A65020A0549734B6579080F4E65656450726F636573734E616D6509000104
+      4E616D6506074A6965436F6465094669656C644E616D6506074A6965436F6465
+      0844617461547970650218084461746153697A65020A0549734B6579080F4E65
+      656450726F636573734E616D65090001044E616D65060858696D75436F646509
+      4669656C644E616D65060858696D75436F646508446174615479706502180844
+      61746153697A65021E0549734B6579080F4E65656450726F636573734E616D65
+      090001044E616D650609496E646578436F6465094669656C644E616D65060949
+      6E646578436F64650844617461547970650218084461746153697A6502320549
+      734B6579080F4E65656450726F636573734E616D65090001044E616D65060F43
+      686170746572506172656E744944094669656C644E616D65060F436861707465
+      72506172656E7449440844617461547970650203084461746153697A65020405
+      49734B6579080F4E65656450726F636573734E616D65090000}
+  end
+end

+ 80 - 0
Report/ProjGather/rpgBillsDm.pas

@@ -0,0 +1,80 @@
+unit rpgBillsDm;
+
+interface
+
+uses
+  SysUtils, Classes, sdDB, sdProvider, ADODB, ProjGatherTree;
+
+type
+  TrpgBillsData = class(TDataModule)
+    sdpBills: TsdADOProvider;
+    sddBills: TsdDataSet;
+  private
+    procedure SaveBillsTreeNode(ANode: TProjGatherTreeNode);
+    procedure SaveBillsTree(ATree: TProjGatherTree);
+  public
+    constructor Create(AConnection: TADOConnection);
+
+    procedure SaveDataTo(ATree: TProjGatherTree; const ATableName: string);
+  end;
+
+implementation
+
+uses CacheTree;
+
+{$R *.dfm}
+
+{ TrpgBillsData }
+
+constructor TrpgBillsData.Create(AConnection: TADOConnection);
+begin
+  inherited Create(nil);
+  sdpBills.Connection := AConnection;
+end;
+
+procedure TrpgBillsData.SaveBillsTree(ATree: TProjGatherTree);
+var
+  iNode: Integer;
+begin
+  for iNode := 0 to ATree.CacheNodes.Count - 1 do
+    SaveBillsTreeNode(TProjGatherTreeNode(ATree.CacheNodes.Items[iNode]));
+end;
+
+procedure TrpgBillsData.SaveBillsTreeNode(ANode: TProjGatherTreeNode);
+var
+  Rec: TsdDataRecord;
+begin
+  Rec := sddBills.Add;
+  Rec.ValueByName('ID').AsInteger := ANode.ID;
+  Rec.ValueByName('ParentID').AsInteger := ANode.ParentID;
+  Rec.ValueByName('NextSiblingID').AsInteger := ANode.NextSiblingID;
+  Rec.ValueByName('Code').AsString := ANode.Code;
+  Rec.ValueByName('B_Code').AsString := ANode.B_Code;
+  Rec.ValueByName('Name').AsString := ANode.Name;
+  Rec.ValueByName('Units').AsString := ANode.Units;
+  Rec.ValueByName('Price').AsFloat := ANode.Price;
+
+  Rec.ValueByName('SerialNo').AsInteger := ANode.SerialNo;
+  Rec.ValueByName('IsLeaf').AsBoolean := ANode.Children.Count = 0;
+  Rec.ValueByName('XiangCode').AsString := ANode.XiangCode;
+  Rec.ValueByName('MuCode').AsString := ANode.MuCode;
+  Rec.ValueByName('JieCode').AsString := ANode.JieCode;
+  Rec.ValueByName('XimuCode').AsString := ANode.XimuCode;
+  Rec.ValueByName('IndexCode').AsString := ANode.IndexCode;
+  Rec.ValueByName('ChapterParentID').AsInteger := ANode.ChapterParentID;
+end;
+
+procedure TrpgBillsData.SaveDataTo(ATree: TProjGatherTree; const ATableName: string);
+begin
+  sdpBills.TableName := ATableName;
+  sddBills.Open;
+  sddBills.BeginUpdate;
+  try
+    SaveBillsTree(ATree);
+  finally
+    sddBills.EndUpdate;
+    sddBills.Save;
+  end;
+end;
+
+end.

+ 122 - 0
Report/ProjGather/rpgGatherControl.pas

@@ -0,0 +1,122 @@
+unit rpgGatherControl;
+
+interface
+
+uses
+  Classes, rpgGatherData, ADODB;
+
+type
+  TrpgGatherControl = class
+  private
+    // 当前打开项目,根据其筛选项目
+    FProjectID: Integer;
+    FHistroyProjs: TList;
+    // 选择的汇总项目
+    FSelectProjs: TList;
+    // 汇总数据
+    FGatherData: TrpgGatherData;
+
+    function SelectProject: Boolean;
+    function SameSelect: Boolean;
+
+    procedure RefreshGather;
+  public
+    constructor Create(AProjectID: Integer);
+    destructor Destroy; override;
+
+    function RefreshConnection: TADOConnection;
+  end;
+
+implementation
+
+uses
+  ZhAPI, GatherProjInfo, ProjGather, ProjGatherSelectFrm, Globals;
+
+{ TrpgGatherControl }
+
+constructor TrpgGatherControl.Create(AProjectID: Integer);
+begin
+  FProjectID := AProjectID;
+  FHistroyProjs := TList.Create;
+  FSelectProjs := TList.Create;
+  FGatherData := TrpgGatherData.Create;
+end;
+
+destructor TrpgGatherControl.Destroy;
+begin
+  FGatherData.Free;
+  ClearObjects(FSelectProjs);
+  FSelectProjs.Free;
+  ClearObjects(FHistroyProjs);
+  FHistroyProjs.Free;
+  inherited;
+end;
+
+function TrpgGatherControl.RefreshConnection: TADOConnection;
+begin
+  if SelectProject and not SameSelect then
+    RefreshGather;
+  Result := FGatherData.Connection;
+end;
+
+procedure TrpgGatherControl.RefreshGather;
+var
+  Gather: TProjGather;
+begin
+  Gather := TProjGather.Create(FGatherData.WriteGatherData,
+    ReportConfig.XmjCompare, ReportConfig.GclCompare);
+  try
+    Gather.Gather(FSelectProjs);
+    FGatherData.LoadRelaData(FProjectID);
+    ClearObjects(FHistroyProjs);
+    FHistroyProjs.Assign(FSelectProjs);
+  finally
+    Gather.Free;
+  end;
+end;
+
+function TrpgGatherControl.SameSelect: Boolean;
+
+  function IncludeProj(AList: TList; AProj: TGatherProjInfo): Boolean;
+  var
+    i: Integer;
+  begin
+    Result := False;
+    for i := 0 to AList.Count - 1 do
+    begin
+      if AProj.ProjectID = TGatherProjInfo(AList.Items[i]).ProjectID then
+      begin
+        Result := True;
+        Break;
+      end;
+    end;
+  end;
+
+  function IncludeList(ALarge, ASmall: TList): Boolean;
+  var
+    iSmall: Integer;
+  begin
+    Result := True;
+    for iSmall := 0 to ASmall.Count - 1 do
+    begin
+      if IncludeProj(ALarge, TGatherProjInfo(ASmall.Items[iSmall])) then
+      begin
+        Result := False;
+        Break;
+      end;
+    end;
+  end;
+
+begin
+  if FHistroyProjs.Count = FSelectProjs.Count then
+    Result := IncludeList(FHistroyProjs, FSelectProjs) and IncludeList(FSelectProjs, FHistroyProjs)
+  else
+    Result := False;
+end;
+
+function TrpgGatherControl.SelectProject: Boolean;
+begin
+  Result := SelectGatherProject(FProjectID, FHistroyProjs, FSelectProjs);
+end;
+
+end.

+ 277 - 0
Report/ProjGather/rpgGatherData.pas

@@ -0,0 +1,277 @@
+unit rpgGatherData;
+
+interface
+
+uses
+  ADODB, ProjGather, rpgGatherProjDm, rpgBillsDm, rpgBillsCalcDm, Classes,
+  ScAutoUpdateUnit, ProjGatherTree;
+
+type
+  TrpgGatherData = class
+  private
+    FGatherFile: string;
+    FConnection: TADOConnection;
+    FQuery: TADOQuery;
+
+    procedure ExecuteSql(const ASql: string);
+
+    procedure ClearHistoryData;
+
+    procedure CreateDataTables(AProjCount: Integer);
+
+    procedure SaveGatherProjInfo(AProjs: TList);
+    procedure SaveBills(ATree: TProjGatherTree);
+    procedure SaveBillsGatherCalc(ATree: TProjGatherTree);
+    procedure SaveBillsProjCalc(ATree: TProjGatherTree; AProjIndex: Integer);
+    procedure SaveGatherData(AGather: TProjGather);
+
+    procedure CalcDgnData(const ATableName: string);
+    procedure CalcOtherData(AProjCount: Integer);
+
+    procedure TransposeProjCalc(AProjCount: Integer);
+  protected
+    procedure AddTables(AProjCount: Integer; AUpdater: TScUpdater); virtual;
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    procedure WriteGatherData(AGather: TProjGather);
+
+    procedure LoadRelaData(AProjectID: Integer);
+
+    property GatherFile: string read FGatherFile;
+    property Connection: TADOConnection read FConnection;
+  end;
+
+implementation
+
+uses
+  UtilMethods, SysUtils, Connections, ZhAPI, rProjGatherTables,
+  ConditionalDefines, ProjectData, Globals;
+
+{ TrpgGatherData }
+
+procedure TrpgGatherData.AddTables(AProjCount: Integer;
+  AUpdater: TScUpdater);
+var
+  iProj: Integer;
+begin
+  AUpdater.AddTableDef(SGatherProj, @tdGatherProj, Length(tdGatherProj), False, False);
+  AUpdater.AddTableDef(SBills, @tdBills, Length(tdBills), False, False);
+  AUpdater.AddTableDef(SBills_Gather, @tdBills_Calc, Length(tdBills_Calc), False, False);
+  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);
+end;
+
+procedure TrpgGatherData.CalcDgnData(const ATableName: string);
+const
+  sFinalDgn = 'Update %s Set'+
+              '    FinalDgnQuantity1 = DealDgnQuantity1 + CDgnQuantity1,'+
+              '    FinalDgnQuantity2 = DealDgnQuantity2 + CDgnQuantity2';
+  sDgnPrice1_2 = 'Update %s Set'+
+                 '    DgnPrice1 = iif(DgnQuantity1 <> 0, TotalPrice/DgnQuantity1, 0),'+
+                 '    DgnPrice1_Rc = iif(DgnQuantity1 <> 0, TotalPrice_Rc/DgnQuantity1, 0),'+
+                 '    DgnPrice2 = iif(DgnQuantity2 <> 0, TotalPrice/DgnQuantity2, 0),'+
+                 '    DgnPrice2_Rc = iif(DgnQuantity2 <> 0, TotalPrice_Rc/DgnQuantity2, 0),'+
+                 '    FinalDgnPrice1 = iif(FinalDgnQuantity1 <> 0, AddGatherTotalPrice/FinalDgnQuantity1, 0),'+
+                 '    FinalDgnPrice1_Rc = iif(FinalDgnQuantity1 <> 0, AddGatherTotalPrice_Rc/FinalDgnQuantity1, 0),'+
+                 '    FinalDgnPrice2 = iif(FinalDgnQuantity2 <> 0, AddGatherTotalPrice/FinalDgnQuantity2, 0),'+
+                 '    FinalDgnPrice2_Rc = iif(FinalDgnQuantity2 <> 0, AddGatherTotalPrice_Rc/FinalDgnQuantity2, 0)';
+  sDgn = 'Update %s Set'+
+         '  DgnQuantity = iif(DgnQuantity1 <> 0, iif(DgnQuantity2 <> 0, DgnQuantity1&''/''&DgnQuantity2, DgnQuantity1), ''''),'+
+         '  DgnPrice = iif(DgnPrice1 <> 0, iif(DgnPrice2 <> 0, DgnPrice1&''/''&DgnPrice2, DgnPrice1), ''''),'+
+         '  DgnPrice_Rc = iif(DgnPrice1_Rc <> 0, iif(DgnPrice2_Rc <> 0, DgnPrice1_Rc&''/''&DgnPrice2_Rc, DgnPrice1_Rc), ''''),'+
+         '  DealDgnQuantity = iif(DealDgnQuantity1 <> 0, iif(DealDgnQuantity2 <> 0, DealDgnQuantity1&''/''&DealDgnQuantity2, DealDgnQuantity1), ''''),'+
+         '  CDgnQuantity = iif(CDgnQuantity1 <> 0, iif(CDgnQuantity2 <> 0, CDgnQuantity1&''/''&CDgnQuantity2, CDgnQuantity1), ''''),'+
+         '  FinalDgnQuantity = iif(FinalDgnQuantity1 <> 0, iif(FinalDgnQuantity2 <> 0, FinalDgnQuantity1&''/''&FinalDgnQuantity2, FinalDgnQuantity1), ''''),'+
+         '  FinalDgnPrice = iif(FinalDgnPrice1 <> 0, iif(FinalDgnPrice2 <> 0, FinalDgnPrice1&''/''&FinalDgnPrice2, FinalDgnPrice1), ''''),'+
+         '  FinalDgnPrice_Rc = iif(FinalDgnPrice1_Rc <> 0, iif(FinalDgnPrice2_Rc <> 0, FinalDgnPrice1_Rc&''/''&FinalDgnPrice2_Rc, FinalDgnPrice1_Rc), '''')';
+begin
+  ExecuteSql(Format(sFinalDgn, [ATableName]));
+  ExecuteSql(Format(sDgnPrice1_2, [ATableName]));
+  ExecuteSql(Format(sDgn, [ATableName]));
+end;
+
+procedure TrpgGatherData.CalcOtherData(AProjCount: Integer);
+var
+  iProj: Integer;
+begin
+  CalcDgnData(SBills_Gather);
+  for iProj := 0 to AProjCount - 1 do
+    CalcDgnData(SBills_Proj+IntToStr(iProj+1)); 
+end;
+
+procedure TrpgGatherData.ClearHistoryData;
+var
+  FTableList: TStringList;
+  iIndex: Integer;
+  sDeleteTableSql: String;
+begin
+  FTableList := TStringList.Create;
+  try
+    FConnection.GetTableNames(FTableList);
+    iIndex := 0;
+    while iIndex < FTableList.Count do
+    begin
+      if Pos('r_', FTableList.Strings[iIndex]) = 1 then
+      begin
+        sDeleteTableSql := Format('Drop Table %s', [FTableList.Strings[iIndex]]);
+        ExecuteSql(sDeleteTableSql);
+      end;
+      Inc(iIndex);
+    end;
+  finally
+    FTableList.Free;
+  end;
+end;
+
+constructor TrpgGatherData.Create;
+begin
+  FGatherFile := GetTempFileName;
+  CopyFileOrFolder(GetEmptyDataBaseFileName, FGatherFile);
+
+  FConnection := TADOConnection.Create(nil);
+  FConnection.LoginPrompt := False;
+  FConnection.ConnectionString := Format(SAdoConnectStr, [FGatherFile]);
+  FConnection.Open;
+
+  FQuery := TADOQuery.Create(nil);
+  FQuery.Connection := FConnection;
+end;
+
+procedure TrpgGatherData.CreateDataTables(AProjCount: Integer);
+var
+  Updater: TScUpdater;
+begin
+  Updater := TScUpdater.Create;
+  try
+    Updater.ForceUpdate := True;
+    Updater.Open('', FConnection, '', '');
+    AddTables(AProjCount, Updater);
+    Updater.ExcuteUpdate;
+  finally
+    Updater.Free;
+  end;
+end;
+
+destructor TrpgGatherData.Destroy;
+begin
+  FQuery.Free;
+  FConnection.Free;
+  if FileExists(FGatherFile) then
+    DeleteFile(FGatherFile);
+  inherited;
+end;
+
+procedure TrpgGatherData.ExecuteSql(const ASql: string);
+begin
+  FQuery.SQL.Clear;
+  FQuery.SQL.Add(ASql);
+  FQuery.ExecSQL;
+end;
+
+procedure TrpgGatherData.LoadRelaData(AProjectID: Integer);
+const
+  sCopyProperty = 'Select * Into r_ProjProperties'+
+                  '  From ProjProperties In ''%s''';
+var
+  sFileName: string;
+  vProjectData: TProjectData;
+begin
+  vProjectData := OpenProjectManager.FindProjectData(AProjectID);
+  if Assigned(vProjectData) then Exit;
+
+  try
+    sFileName := GetTempFileName;
+    vProjectData.SaveTempDataBaseFile(sFileName);
+
+    ExecuteSql(Format(sCopyProperty, [sFileName]));
+  finally
+    if FileExists(sFileName) then
+      DeleteFile(sFileName);
+  end;
+end;
+
+procedure TrpgGatherData.SaveBills(ATree: TProjGatherTree);
+var
+  vBillsData: TrpgBillsData;
+begin
+  vBillsData := TrpgBillsData.Create(FConnection);
+  try
+    vBillsData.SaveDataTo(ATree, SBills);
+  finally
+    vBillsData.Free;
+  end;
+end;
+
+procedure TrpgGatherData.SaveBillsGatherCalc(ATree: TProjGatherTree);
+var
+  vBillsCalcData: TrpgBillsCalcData;
+begin
+  vBillsCalcData := TrpgBillsCalcData.Create(FConnection);
+  try
+    vBillsCalcData.SaveGatherDataTo(ATree, SBills_Gather);
+  finally
+    vBillsCalcData.Free;
+  end;
+end;
+
+procedure TrpgGatherData.SaveBillsProjCalc(ATree: TProjGatherTree;
+  AProjIndex: Integer);
+var
+  vBillsCalcData: TrpgBillsCalcData;
+begin
+  vBillsCalcData := TrpgBillsCalcData.Create(FConnection);
+  try
+    vBillsCalcData.SaveProjDataTo(ATree, AProjIndex, SBills_Proj+IntToStr(AProjIndex+1));
+  finally
+    vBillsCalcData.Free;
+  end;
+end;
+
+procedure TrpgGatherData.SaveGatherData(AGather: TProjGather);
+var
+  iProj: Integer;
+begin
+  SaveGatherProjInfo(AGather.Projs);
+  SaveBills(AGather.Tree);
+  SaveBillsGatherCalc(AGather.Tree);
+  for iProj := 0 to AGather.Projs.Count - 1 do
+    SaveBillsProjCalc(AGather.Tree, iProj);
+end;
+
+procedure TrpgGatherData.SaveGatherProjInfo(AProjs: TList);
+var
+  vGatherInfoData: TrpgGatherProjData;
+begin
+  vGatherInfoData := TrpgGatherProjData.Create(FConnection);
+  try
+    vGatherInfoData.SaveDataTo(AProjs, SGatherProj);
+  finally
+    vGatherInfoData.Free;
+  end;
+end;
+
+procedure TrpgGatherData.TransposeProjCalc(AProjCount: Integer);
+const
+  sInsert = 'Insert Into %s Select * From %s';
+var
+  iProj: Integer;
+begin
+  for iProj := 0 to  AProjCount - 1 do
+    ExecuteSql(Format(sInsert, [SBills_TransProj, SBills_Proj+IntToStr(iProj+1)]));
+end;
+
+procedure TrpgGatherData.WriteGatherData(AGather: TProjGather);
+begin
+  ClearHistoryData;
+  CreateDataTables(AGather.Projs.Count);
+  SaveGatherData(AGather);
+  CalcOtherData(AGather.Projs.Count);
+  TransposeProjCalc(AGather.Projs.Count);
+  if _IsDebugView then
+    CopyFileOrFolder(FGatherFile, GetAppFilePath+'CommonProjGather.dat');
+end;
+
+end.

+ 26 - 0
Report/ProjGather/rpgGatherProjDm.dfm

@@ -0,0 +1,26 @@
+object rpgGatherProjData: TrpgGatherProjData
+  OldCreateOrder = False
+  Left = 708
+  Top = 305
+  Height = 171
+  Width = 149
+  object sddGatherProj: TsdDataSet
+    Active = False
+    Provider = sdpGatherProj
+    Left = 56
+    Top = 80
+    FieldListData = {
+      0101044E616D6506024944094669656C644E616D650602494408446174615479
+      70650203084461746153697A6502040549734B6579080F4E65656450726F6365
+      73734E616D65090001044E616D65060950726F6A6563744944094669656C644E
+      616D65060950726F6A6563744944084461746154797065020308446174615369
+      7A6502040549734B6579080F4E65656450726F636573734E616D65090001044E
+      616D65060B50726F6A6563744E616D65094669656C644E616D65060B50726F6A
+      6563744E616D650844617461547970650218084461746153697A6503FF000549
+      734B6579080F4E65656450726F636573734E616D65090000}
+  end
+  object sdpGatherProj: TsdADOProvider
+    Left = 56
+    Top = 16
+  end
+end

+ 61 - 0
Report/ProjGather/rpgGatherProjDm.pas

@@ -0,0 +1,61 @@
+unit rpgGatherProjDm;
+
+interface
+
+uses
+  SysUtils, Classes, sdProvider, sdDB, GatherProjInfo, ADODB;
+
+type
+  TrpgGatherProjData = class(TDataModule)
+    sdpGatherProj: TsdADOProvider;
+    sddGatherProj: TsdDataSet;
+  private
+    procedure SaveGatherInfo(AProjs: TList);
+  public
+    constructor Create(AConnection: TADOConnection);
+
+    procedure SaveDataTo(AProjs: TList; const ATableName: string);
+  end;
+
+implementation
+
+{$R *.dfm}
+
+{ TrpgGatherProjData }
+
+constructor TrpgGatherProjData.Create(AConnection: TADOConnection);
+begin
+  inherited Create(nil);
+  sdpGatherProj.Connection := AConnection;
+end;
+
+procedure TrpgGatherProjData.SaveDataTo(AProjs: TList; const ATableName: string);
+begin
+  sdpGatherProj.TableName := ATableName;
+  sddGatherProj.Open;
+  sddGatherProj.BeginUpdate;
+  try
+    SaveGatherInfo(AProjs);
+  finally
+    sddGatherProj.EndUpdate;
+    sddGatherProj.Save;
+  end;
+end;
+
+procedure TrpgGatherProjData.SaveGatherInfo(AProjs: TList);
+var
+  i: Integer;
+  Rec: TsdDataRecord;
+  ProjInfo: TGatherProjInfo;
+begin
+  for i := 0 to AProjs.Count - 1 do
+  begin
+    ProjInfo := TGatherProjInfo(AProjs.Items[i]);
+    Rec := sddGatherProj.Add;
+    Rec.ValueByName('ID').AsInteger := i;
+    Rec.ValueByName('ProjectID').AsInteger := ProjInfo.ProjectID;
+    Rec.ValueByName('ProjectName').AsString := ProjInfo.ProjectName;
+  end;
+end;
+
+end.

+ 47 - 0
Report/ReportConnection.pas

@@ -0,0 +1,47 @@
+unit ReportConnection;
+
+interface
+
+uses
+  ADODB, ProjectData, ReportManager, rpgGatherControl;
+
+type
+  TReportConnection = class
+  private
+    FProjectData: TProjectData;
+    FConnection: TADOConnection;
+    FCommonGather: TrpgGatherControl;
+  public
+    constructor Create(AProjectData: TProjectData);
+    destructor Destroy; override;
+
+    procedure RefreshConnection(ATemplate: TTemplateNode);
+
+    property Connection: TADOConnection read FConnection;
+  end;
+
+implementation
+
+{ TReportConnection }
+
+constructor TReportConnection.Create(AProjectData: TProjectData);
+begin
+  FProjectData := AProjectData;
+  FCommonGather := TrpgGatherControl.Create(AProjectData.ProjectID);
+end;
+
+destructor TReportConnection.Destroy;
+begin
+  FCommonGather.Free;
+  inherited;
+end;
+
+procedure TReportConnection.RefreshConnection(ATemplate: TTemplateNode);
+begin
+  case ATemplate.DataBaseFlag of
+    0: FConnection := FProjectData.ADOConnection;
+    1: FConnection := FCommonGather.RefreshConnection;
+  end;
+end;
+
+end.

+ 3 - 3
Report/ReportPrepare.pas

@@ -25,7 +25,7 @@ implementation
 
 uses
   ScAutoUpdateUnit, rdpTables, ComObj, UtilMethods, ZhAPI, Classes,
-  ConstUnit;
+  ConditionalDefines;
 
 { TReportPrepare }
 
@@ -59,8 +59,8 @@ begin
     1: PrepareGclGatherData;
   end;
   // For Test
-  if G_IsTest then
-    FProjectData.SaveDebugFile(GetAppFilePath+'ReportDataPrepare.dat');
+  if _IsDebugView then
+    FProjectData.SaveDebugFile('ReportDataPrepare.dat');
 end;
 
 procedure TReportPrepare.PrepareGclGatherData;

+ 3 - 1
TenderPartition/tpSelectTendersFrm.dfm

@@ -218,15 +218,17 @@ object SelectTendersForm: TSelectTendersForm
         Font.Style = []
         FieldName = 'Name'
         Width = 225
-        ReadOnly = False
+        ReadOnly = True
       end>
     Grid = zgTenderSelect
     ExtendRowCount = 0
+    Options = [aoAllowEdit]
     AutoExpand = False
     TreeCellCol = 2
     KeyFieldName = 'ID'
     ParentFieldName = 'ParentID'
     NextSiblingFieldName = 'NextSiblingID'
+    TreeOptions = []
     TopLevelBold = True
     Left = 100
     Top = 177

+ 367 - 0
Units/CalcData.pas

@@ -0,0 +1,367 @@
+unit CalcData;
+
+interface
+
+type
+  TCalcData = class
+  private
+    FQuantity: Double;
+    FTotalPrice: Double;
+  public
+    constructor Create; virtual;
+
+    procedure AddQuantity(AValue: Double);
+    procedure AddTotalPrice(AValue: Double);
+
+    property Quantity: Double read FQuantity write FQuantity;
+    property TotalPrice: Double read FTotalPrice write FTotalPrice;
+  end;
+
+  TReCalcData = class(TCalcData)
+  private
+    FTotalPrice_Rc: Double;
+  public
+    constructor Create; override;
+
+    property TotalPrice_Rc: Double read FTotalPrice_Rc write FTotalPrice_Rc;
+  end;
+
+  TCompileCalc = class
+  private
+    FOrg: TReCalcData;
+    FMis: TReCalcData;
+    FOth: TReCalcData;
+    FSubTotal: TReCalcData;
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    procedure InitTotalPrice_Rc;
+    procedure UpdateTotalPrice_Rc(ACalc: TCompileCalc);
+    procedure CalcTotalPrice_Rc(APrice: Double);
+
+    procedure InitCalcData;
+    procedure AddCalcData(ACalc: TCompileCalc);
+    procedure MinusCalcData(ACalc: TCompileCalc);
+
+    property Org: TReCalcData read FOrg write FOrg;
+    property Mis: TReCalcData read FMis write FMis;
+    property Oth: TReCalcData read FOth write FOth;
+    property SubTotal: TReCalcData read FSubTotal write FSubTotal;
+  end;
+
+  TMeasureCalc = class
+  private
+    FDeal: TReCalcData;
+    FQc: TReCalcData;
+    FGather: TReCalcData;
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    procedure InitTotalPrice_Rc;
+    procedure UpdateTotalPrice_Rc(ACalc: TMeasureCalc);
+    procedure CalcTotalPrice_Rc(APrice: Double);
+
+    procedure InitCalcData;
+    procedure AddCalcData(ACalc: TMeasureCalc);
+    procedure MinusCalcData(ACalc: TMeasureCalc);
+
+    property Deal: TReCalcData read FDeal write FDeal;
+    property Qc: TReCalcData read FQc write FQc;
+    property Gather: TReCalcData read FGather write FGather;
+  end;
+
+  TProjCalc = class
+  private
+    FCompile: TCompileCalc;
+    FAddMeasure: TMeasureCalc;
+    FCurMeasure: TMeasureCalc;
+    FPreMeasure: TMeasureCalc;
+    FEndMeasure: TMeasureCalc;
+
+    FDgnQuantity1: Double;
+    FDgnQuantity2: Double;
+    FDealDgnQuantity1: Double;
+    FDealDgnQuantity2: Double;
+    FCDgnQuantity1: Double;
+    FCDgnQuantity2: Double;
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    procedure InitTotalPrice_Rc;
+    procedure UpdateTotalPrice_Rc(AProjCalc: TProjCalc);
+    procedure CalcTotalPrice_Rc(APrice: Double);
+
+    procedure InitCalcData;
+    procedure AddCalcData(AProjCalc: TProjCalc);
+    procedure MinusCalcData(AProjCalc: TProjCalc);
+
+    property Compile: TCompileCalc read FCompile;
+    property AddMeasure: TMeasureCalc read FAddMeasure;
+    property CurMeasure: TMeasureCalc read FCurMeasure;
+    property PreMeasure: TMeasureCalc read FPreMeasure;
+    property EndMeasure: TMeasureCalc read FEndMeasure;
+
+    property DgnQuantity1: Double read FDgnQuantity1 write FDgnQuantity1;
+    property DgnQuantity2: Double read FDgnQuantity2 write FDgnQuantity2;
+    property DealDgnQuantity1: Double read FDealDgnQuantity1 write FDealDgnQuantity1;
+    property DealDgnQuantity2: Double read FDealDgnQuantity2 write FDealDgnQuantity2;
+    property CDgnQuantity1: Double read FCDgnQuantity1 write FCDgnQuantity1;
+    property CDgnQuantity2: Double read FCDgnQuantity2 write FCDgnQuantity2;
+  end;
+
+implementation
+
+{ TCompileCalc }
+
+procedure TCompileCalc.AddCalcData(ACalc: TCompileCalc);
+begin
+  Org.TotalPrice := Org.TotalPrice + ACalc.Org.TotalPrice;
+  Mis.TotalPrice := Mis.TotalPrice + ACalc.Mis.TotalPrice;
+  Oth.TotalPrice := Oth.TotalPrice + ACalc.Oth.TotalPrice;
+  SubTotal.TotalPrice := SubTotal.TotalPrice + ACalc.SubTotal.TotalPrice;
+  Org.TotalPrice_Rc := Org.TotalPrice_Rc + ACalc.Org.TotalPrice_Rc;
+  Mis.TotalPrice_Rc := Mis.TotalPrice_Rc + ACalc.Mis.TotalPrice_Rc;
+  Oth.TotalPrice_Rc := Oth.TotalPrice_Rc + ACalc.Oth.TotalPrice_Rc;
+  SubTotal.TotalPrice_Rc := SubTotal.TotalPrice_Rc + ACalc.SubTotal.TotalPrice_Rc;
+end;
+
+procedure TCompileCalc.CalcTotalPrice_Rc(APrice: Double);
+begin
+  Org.TotalPrice_Rc := Org.Quantity * APrice;
+  Mis.TotalPrice_Rc := Mis.Quantity * APrice;
+  Oth.TotalPrice_Rc := Oth.Quantity * APrice;
+  SubTotal.TotalPrice_Rc := SubTotal.Quantity * APrice;
+end;
+
+constructor TCompileCalc.Create;
+begin
+  FOrg := TReCalcData.Create;
+  FMis := TReCalcData.Create;
+  FOth := TReCalcData.Create;
+  FSubTotal := TReCalcData.Create;
+end;
+
+destructor TCompileCalc.Destroy;
+begin
+  FOrg.Free;
+  FMis.Free;
+  FOth.Free;
+  FSubTotal.Free;
+  inherited;
+end;
+
+procedure TCompileCalc.InitCalcData;
+begin
+  Org.TotalPrice := 0;
+  Mis.TotalPrice := 0;
+  Oth.TotalPrice := 0;
+  SubTotal.TotalPrice := 0;
+  InitTotalPrice_Rc;
+end;
+
+procedure TCompileCalc.InitTotalPrice_Rc;
+begin
+  Org.TotalPrice_Rc := 0;
+  Mis.TotalPrice_Rc := 0;
+  Oth.TotalPrice_Rc := 0;
+  SubTotal.TotalPrice_Rc := 0;
+end;
+
+procedure TCompileCalc.MinusCalcData(ACalc: TCompileCalc);
+begin
+  Org.TotalPrice := Org.TotalPrice - ACalc.Org.TotalPrice;
+  Mis.TotalPrice := Mis.TotalPrice - ACalc.Mis.TotalPrice;
+  Oth.TotalPrice := Oth.TotalPrice - ACalc.Oth.TotalPrice;
+  SubTotal.TotalPrice := SubTotal.TotalPrice - ACalc.SubTotal.TotalPrice;
+  Org.TotalPrice_Rc := Org.TotalPrice_Rc - ACalc.Org.TotalPrice_Rc;
+  Mis.TotalPrice_Rc := Mis.TotalPrice_Rc - ACalc.Mis.TotalPrice_Rc;
+  Oth.TotalPrice_Rc := Oth.TotalPrice_Rc - ACalc.Oth.TotalPrice_Rc;
+  SubTotal.TotalPrice_Rc := SubTotal.TotalPrice_Rc - ACalc.SubTotal.TotalPrice_Rc;
+end;
+
+procedure TCompileCalc.UpdateTotalPrice_Rc(ACalc: TCompileCalc);
+begin
+  Org.TotalPrice_Rc := Org.TotalPrice_Rc + ACalc.Org.TotalPrice_Rc;
+  Mis.TotalPrice_Rc := Mis.TotalPrice_Rc + ACalc.Mis.TotalPrice_Rc;
+  Oth.TotalPrice_Rc := Oth.TotalPrice_Rc + ACalc.Oth.TotalPrice_Rc;
+  SubTotal.TotalPrice_Rc := SubTotal.TotalPrice_Rc + ACalc.SubTotal.TotalPrice_Rc;
+end;
+
+{ TMeasureCalc }
+
+procedure TMeasureCalc.AddCalcData(ACalc: TMeasureCalc);
+begin
+  Deal.TotalPrice := Deal.TotalPrice + ACalc.Deal.TotalPrice;
+  Qc.TotalPrice := Qc.TotalPrice + ACalc.Qc.TotalPrice;
+  Gather.TotalPrice := Gather.TotalPrice + ACalc.Gather.TotalPrice;
+  Deal.TotalPrice_Rc := Deal.TotalPrice_Rc + ACalc.Deal.TotalPrice_Rc;
+  Qc.TotalPrice_Rc := Qc.TotalPrice_Rc + ACalc.Qc.TotalPrice_Rc;
+  Gather.TotalPrice_Rc := Gather.TotalPrice_Rc + ACalc.Gather.TotalPrice_Rc;
+end;
+
+procedure TMeasureCalc.CalcTotalPrice_Rc(APrice: Double);
+begin
+  Deal.TotalPrice_Rc := Deal.Quantity * APrice;
+  Qc.TotalPrice_Rc := Qc.Quantity * APrice;
+  Gather.TotalPrice_Rc := Gather.Quantity * APrice;
+end;
+
+constructor TMeasureCalc.Create;
+begin
+  FDeal := TReCalcData.Create;
+  FQc := TReCalcData.Create;
+  FGather := TReCalcData.Create;
+end;
+
+destructor TMeasureCalc.Destroy;
+begin
+  FDeal.Free;
+  FQc.Free;
+  FGather.Free;
+  inherited;
+end;
+
+procedure TMeasureCalc.InitCalcData;
+begin
+  Deal.TotalPrice := 0;
+  Qc.TotalPrice := 0;
+  Gather.TotalPrice := 0;
+  InitTotalPrice_Rc;
+end;
+
+procedure TMeasureCalc.InitTotalPrice_Rc;
+begin
+  Deal.TotalPrice_Rc := 0;
+  Qc.TotalPrice_Rc := 0;
+  Gather.TotalPrice_Rc := 0;
+end;
+
+procedure TMeasureCalc.MinusCalcData(ACalc: TMeasureCalc);
+begin
+  Deal.TotalPrice := Deal.TotalPrice - ACalc.Deal.TotalPrice;
+  Qc.TotalPrice := Qc.TotalPrice - ACalc.Qc.TotalPrice;
+  Gather.TotalPrice := Gather.TotalPrice - ACalc.Gather.TotalPrice;
+  Deal.TotalPrice_Rc := Deal.TotalPrice_Rc - ACalc.Deal.TotalPrice_Rc;
+  Qc.TotalPrice_Rc := Qc.TotalPrice_Rc - ACalc.Qc.TotalPrice_Rc;
+  Gather.TotalPrice_Rc := Gather.TotalPrice_Rc - ACalc.Gather.TotalPrice_Rc;
+end;
+
+procedure TMeasureCalc.UpdateTotalPrice_Rc(ACalc: TMeasureCalc);
+begin
+  Deal.TotalPrice_Rc := Deal.TotalPrice_Rc + ACalc.Deal.TotalPrice_Rc;
+  Qc.TotalPrice_Rc := Qc.TotalPrice_Rc + ACalc.Qc.TotalPrice_Rc;
+  Gather.TotalPrice_Rc := Gather.TotalPrice_Rc + ACalc.Gather.TotalPrice_Rc;
+end;
+
+{ TProjCalc }
+
+procedure TProjCalc.AddCalcData(AProjCalc: TProjCalc);
+begin
+  Compile.AddCalcData(AProjCalc.Compile);
+  AddMeasure.AddCalcData(AProjCalc.AddMeasure);
+  CurMeasure.AddCalcData(AProjCalc.CurMeasure);
+  PreMeasure.AddCalcData(AProjCalc.PreMeasure);
+  EndMeasure.AddCalcData(AProjCalc.EndMeasure);
+end;
+
+procedure TProjCalc.CalcTotalPrice_Rc(APrice: Double);
+begin
+  Compile.CalcTotalPrice_Rc(APrice);
+  AddMeasure.CalcTotalPrice_Rc(APrice);
+  CurMeasure.CalcTotalPrice_Rc(APrice);
+  PreMeasure.CalcTotalPrice_Rc(APrice);
+  EndMeasure.CalcTotalPrice_Rc(APrice);
+end;
+
+constructor TProjCalc.Create;
+begin
+  FCompile := TCompileCalc.Create;
+  FAddMeasure := TMeasureCalc.Create;
+  FCurMeasure := TMeasureCalc.Create;
+  FPreMeasure := TMeasureCalc.Create;
+  FEndMeasure := TMeasureCalc.Create;
+
+  FDgnQuantity1 := 0;
+  FDgnQuantity2 := 0;
+  FDealDgnQuantity1 := 0;
+  FDealDgnQuantity2 := 0;
+  FCDgnQuantity1 := 0;
+  FCDgnQuantity2 := 0;
+end;
+
+destructor TProjCalc.Destroy;
+begin
+  FCompile.Free;
+  FAddMeasure.Free;
+  FCurMeasure.Free;
+  FPreMeasure.Free;
+  FEndMeasure.Free;
+  inherited;
+end;
+
+procedure TProjCalc.InitCalcData;
+begin
+  Compile.InitCalcData;
+  AddMeasure.InitCalcData;
+  CurMeasure.InitCalcData;
+  PreMeasure.InitCalcData;
+  EndMeasure.InitCalcData;
+end;
+
+procedure TProjCalc.InitTotalPrice_Rc;
+begin
+  Compile.InitTotalPrice_Rc;
+  AddMeasure.InitTotalPrice_Rc;
+  CurMeasure.InitTotalPrice_Rc;
+  PreMeasure.InitTotalPrice_Rc;
+  EndMeasure.InitTotalPrice_Rc;
+end;
+
+procedure TProjCalc.MinusCalcData(AProjCalc: TProjCalc);
+begin
+  Compile.MinusCalcData(AProjCalc.Compile);
+  AddMeasure.MinusCalcData(AProjCalc.AddMeasure);
+  CurMeasure.MinusCalcData(AProjCalc.CurMeasure);
+  PreMeasure.MinusCalcData(AProjCalc.PreMeasure);
+  EndMeasure.MinusCalcData(AProjCalc.EndMeasure);
+end;
+
+procedure TProjCalc.UpdateTotalPrice_Rc(AProjCalc: TProjCalc);
+begin
+  Compile.UpdateTotalPrice_Rc(AProjCalc.Compile);
+  AddMeasure.UpdateTotalPrice_Rc(AProjCalc.AddMeasure);
+  CurMeasure.UpdateTotalPrice_Rc(AProjCalc.CurMeasure);
+  PreMeasure.UpdateTotalPrice_Rc(AProjCalc.PreMeasure);
+  EndMeasure.UpdateTotalPrice_Rc(AProjCalc.EndMeasure);
+end;
+
+{ TCalcData }
+
+procedure TCalcData.AddQuantity(AValue: Double);
+begin
+  FQuantity := FQuantity + AValue;
+end;
+
+procedure TCalcData.AddTotalPrice(AValue: Double);
+begin
+  FTotalPrice := FTotalPrice + AValue;
+end;
+
+constructor TCalcData.Create;
+begin
+  FQuantity := 0;
+  FTotalPrice := 0;
+end;
+
+{ TReCalcData }
+
+constructor TReCalcData.Create;
+begin
+  inherited;
+  FTotalPrice_Rc := 0;
+end;
+
+end.

+ 6 - 0
Units/ConditionalDefines.pas

@@ -24,6 +24,12 @@ var
     _IsEncrypt: Boolean = False;
   {$ENDIF}
 
+  {$IFDEF _mDebugView}
+    _IsDebugView: Boolean = True;
+  {$ELSE}
+    _IsDebugView: Boolean = False;
+  {$ENDIF}
+
 implementation
 
 end.

+ 2 - 3
Units/Connections.pas

@@ -10,6 +10,8 @@ const
   EmptyFileVersion = '1.0.0.0';
   FileVersion = '1.0.1.2';
   EncryptVersion = 'Auto1.0';
+  SAdoConnectStr = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;' +
+                   'User ID=Admin;Password='''';Persist Security Info=True';
 
 type
   TConnection = class
@@ -93,9 +95,6 @@ uses
   CompactDB, TransFile, UtilMethods;
 
 const
-  SAdoConnectStr = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;' +
-                   'User ID=Admin;Password='''';Persist Security Info=True';
-
   MDBOrgHead: array [0..15] of Byte =
     ($00, $01, $00, $00, $53, $74, $61, $6E, $64, $61, $72, $64, $20, $4A, $65, $74);
 

+ 45 - 22
Units/ProjectData.pas

@@ -23,6 +23,7 @@ type
     FConnection: TEncryptConnection;
     FUpdator: TUpdateProjectDB;
     FIsNewFile: Boolean;
+    FDebugDir: string;
 
     FBillsData: TBillsData;
     FBillsCompileData: TBillsCompileData;
@@ -128,7 +129,9 @@ type
     {OpenForReport3: OpenForReport2的基础上打开最后一个审核人数据,打开BillsMeasureTree不打开BillsCompileTree,链接BillsMeasureTree跟StageData}
     procedure OpenForReport3(const AFileName: string);
     //-----------------------  End ---后台打开 ------------------------
+
     procedure SaveDebugFile(const AFileName: string);
+    procedure SaveTempDataBaseFile(const AFileName: string);
 
     procedure SaveLastestPhaseMainData;
 
@@ -235,7 +238,7 @@ implementation
 
 uses UtilMethods, Globals, ProjectCommands, sdIDTree, StageDm,
   ZJJLDm, PHPWebDm, XMLDoc, XMLIntf, ConstUnit, PasswordInputFrm,
-  mProgressProFrm, mDataRecord;
+  mProgressProFrm, mDataRecord, ConditionalDefines;
 
 { TProjectData }
 
@@ -302,27 +305,31 @@ end;
 
 destructor TProjectData.Destroy;
 begin
-  FCheckers.Free;
-  FPriceMarginBillsData.Free;
-  FDetailGLData.Free;
-  FProjectGLData.Free;
-  FMainListData.Free;
-  FSearchData.Free;
-  FStaffData.Free;
-  FBGLData.Free;
-  FDealPaymentData.Free;
-  FPhaseCompareData.Free;
-  FPhaseData.Free;
-  FProjProperties.Free;
-  FDealBillsData.Free;
-  FBillsBookmarkData.Free;
-  FBillsMeasureData.Free;
-  FBillsCompileData.Free;
-  FBillsData.Free;
-  FAttachmentData.Free;
-  FUpdator.Free;
-  FConnection.Free;
-  DeleteFileOrFolder(FTempFolder);
+  try
+    FCheckers.Free;
+    FPriceMarginBillsData.Free;
+    FDetailGLData.Free;
+    FProjectGLData.Free;
+    FMainListData.Free;
+    FSearchData.Free;
+    FStaffData.Free;
+    FBGLData.Free;
+    FDealPaymentData.Free;
+    FPhaseCompareData.Free;
+    FPhaseData.Free;
+    FProjProperties.Free;
+    FDealBillsData.Free;
+    FBillsBookmarkData.Free;
+    FBillsMeasureData.Free;
+    FBillsCompileData.Free;
+    FBillsData.Free;
+    FAttachmentData.Free;
+    FUpdator.Free;
+    FConnection.Free;
+  finally
+    DeleteFileOrFolder(FTempFolder);
+    DeleteFileOrFolder(FDebugDir);
+  end;
   inherited;
 end;
 
@@ -443,6 +450,12 @@ begin
   //FBillsGatherData.RefreshBills;
   FMainListData.Open(FConnection.Connection);
   UpdateSysProgress(200, '就绪');
+
+  if _IsDebugView then
+  begin
+    FDebugDir := GetAppFilePath + 'Debug\' + FProjectName;
+    CreateDirectoryInDeep(FDebugDir);
+  end;
 end;
 
 procedure TProjectData.OpenLastPhaseData;
@@ -1034,6 +1047,8 @@ begin
     CopyCurPhaseData;
   FDealPaymentData.UpdateLinkSerialNo;
   //CopyHistoryCompleteData;
+  if _IsDebugView then
+    SaveDebugFile('Report.dat');
 end;
 
 procedure TProjectData.ExecuteSql(const ASql: string);
@@ -1809,6 +1824,14 @@ begin
 end;
 
 procedure TProjectData.SaveDebugFile(const AFileName: string);
+var
+  sFileName: string;
+begin
+  sFileName := ExtractFileName(AFileName);
+  FConnection.SaveDebugFile(FDebugDir + '\' + sFileName);
+end;
+
+procedure TProjectData.SaveTempDataBaseFile(const AFileName: string);
 begin
   FConnection.SaveDebugFile(AFileName);
 end;