ProjGather: DealPayData & ProjProperties

ProjGather/ProjGather.pas

@@ -4,7 +4,7 @@ interface
 
 uses
   Classes, ProjGatherTree, GatherProjInfo, ProjectData, BillsTree, CalcData,
-  PhaseData;
+  PhaseData, ProjGatherDealPay, sdDB, ProjGatherProperties;
 
 type
   TProjGather = class;
@@ -17,6 +17,12 @@ type
     FGclCompare: Integer;
 
     FTree: TProjGatherTree;
+    FDealPay: TProjGatherDealPayList;
+    FProperties: TProjGatherProperties;
+
+    FDealCurField: string;
+    FDealPreField: string;
+    FDealEndField: string;
 
     FProjs: TList;
     FCommonProjs: TList;
@@ -29,15 +35,22 @@ type
     function FindBillsNode(ANode: TBillsIDTreeNode; AParent: TProjGatherTreeNode): TProjGatherTreeNode;
     function CreateBillsNode(ANode: TBillsIDTreeNode; AParent: TProjGatherTreeNode): TProjGatherTreeNode;
     procedure AddProjCalcData(AProjCalc: TProjCalc; ANode: TMeasureBillsIDTreeNode);
+    procedure AddProjDealPayCalcData(ADealPayCalc: TDealPayCalcData; ARec: TsdDataRecord);
 
     function GatherBillsNode(ANode: TMeasureBillsIDTreeNode; AParent: TProjGatherTreeNode;
       AProjIndex: Integer): TProjGatherTreeNode;
     procedure GatherBills(ANode: TMeasureBillsIDTreeNode; AParent: TProjGatherTreeNode; AProjIndex: Integer);
 
+    procedure GatherDealPays(AProjIndex: Integer);
+    procedure GatherProjProperties;
+
     function GatherSpecialBillsNode(ANode: TMeasureBillsIDTreeNode;
       AParent: TProjGatherTreeNode; AProjType: Integer): TProjGatherTreeNode;
     procedure GatherSpecialBills(ANode: TMeasureBillsIDTreeNode;
       AParent: TProjGatherTreeNode; AProjType: Integer);
+
+    procedure GatherSpecialDealPays(AProjType: Integer);
+
     procedure GatherSpecialProj(AProj: TGatherProjInfo);
 
     procedure FilterProjs;
@@ -45,9 +58,13 @@ type
     procedure OpenProjectData(AProj: TGatherProjInfo); virtual;
     procedure FreeProjectData; virtual;
 
+    procedure BeforeGather;
+    procedure AfterGather;
+
     procedure GatherProj(AProj: TGatherProjInfo; AProjIndex: Integer);
 
     procedure AddProjMeasureCalcData(AProjCalc: TProjCalc; ANode: TMeasureBillsIDTreeNode); virtual;
+    procedure AddProjDealPayPhaseCalcData(ADealPayCalc: TDealPayCalcData; ARec: TsdDataRecord); virtual;
   public
     constructor Create(AWriter: TWriteGatherData; AXmjCompare, AGclCompare: Integer);
     destructor Destroy; override;
@@ -55,7 +72,11 @@ type
     procedure Gather(AProjs: TList; ASpecialProjTypes: TStrings);
 
     property ProjectData: TProjectData read FProjectData;
+
     property Tree: TProjGatherTree read FTree;
+    property DealPay: TProjGatherDealPayList read FDealPay;
+    property Properties: TProjGatherProperties read FProperties;
+
     property Projs: TList read FProjs;
     property CommonProj: TList read FCommonProjs;
     property SpecialProj: TList read FSpecialProjs;
@@ -74,6 +95,7 @@ type
     procedure FreeProjectData; override;
 
     procedure AddProjMeasureCalcData(AProjCalc: TProjCalc; ANode: TMeasureBillsIDTreeNode); override;
+    procedure AddProjDealPayPhaseCalcData(ADealPayCalc: TDealPayCalcData; ARec: TsdDataRecord); override;
   public
     procedure Gather(AProjs: TList; ABeginPhaseIndex, AEndPhaseIndex: Integer); overload;
   end;
@@ -81,8 +103,8 @@ type
 implementation
 
 uses
-  Globals, UtilMethods, sdIDTree, sdDB, mDataRecord, BillsMeasureDm, SysUtils,
-  Math;
+  Globals, UtilMethods, sdIDTree, mDataRecord, BillsMeasureDm, SysUtils,
+  Math, DealPaymentDm;
 
 { TProjGather }
 
@@ -225,11 +247,8 @@ begin
   FProjs := AProjs;
   FilterProjs;
   FSpecialProjTypes := ASpecialProjTypes;
-  if Assigned(ASpecialProjTypes) then
-    FTree := TProjGatherTree.Create(FCommonProjs.Count, ASpecialProjTypes.Count)
-  else
-    FTree := TProjGatherTree.Create(FCommonProjs.Count, 0);
-  FTree.NewNodeID := 101;
+
+  BeforeGather;
   try
     for i := 0 to FCommonProjs.Count - 1 do
       GatherProj(TGatherProjInfo(FCommonProjs.Items[i]), i);
@@ -239,7 +258,7 @@ begin
     if Assigned(FWriter) then
       FWriter(Self);
   finally
-    FTree.Free;
+    AfterGather;
   end;
 end;
 
@@ -271,6 +290,8 @@ begin
   try
     with FProjectData.BillsMeasureData do
       GatherBills(TMeasureBillsIDTreeNode(BillsMeasureTree.FirstNode), nil, AProjIndex);
+    GatherDealPays(AProjIndex);
+    GatherProjProperties;
   finally
     FreeProjectData;
   end;
@@ -284,6 +305,7 @@ begin
     try
       with FProjectData.BillsMeasureData do
         GatherSpecialBills(TMeasureBillsIDTreeNode(BillsMeasureTree.FirstNode), nil, AProj.ProjType);
+      GatherSpecialDealPays(AProj.ProjType);
     finally
       FreeProjectData;
     end;
@@ -353,8 +375,149 @@ begin
   end;
 end;
 
+procedure TProjGather.GatherDealPays(AProjIndex: Integer);
+var
+  idxView: TsdIndex;
+  iRec: Integer;
+  vRec: TsdDataRecord;
+  vDealPay: TProjGatherDealPayNode;
+begin
+  with FProjectData.DealPaymentData do
+  begin
+    idxView := sddDealPayment.FindIndex('idxView');
+
+    if FProjectData.PhaseData.Active then
+    begin
+      FDealCurField := 'TotalPrice' + IntToStr(FProjectData.PhaseData.StageIndex);
+      FDealPreField := 'PreTotalPrice' + IntToStr(FProjectData.PhaseData.StageIndex);
+      FDealEndField := 'EndTotalPrice' + IntToStr(FProjectData.PhaseData.StageIndex);
+    end;
+
+    for iRec := 0 to idxView.RecordCount - 1 do
+    begin
+      vRec := idxView.Records[iRec];
+
+      vDealPay := FDealPay.GetDealPayNode(vRec);
+      AddProjDealPayCalcData(vDealPay.GatherCalc, vRec);
+      AddProjDealPayCalcData(vDealPay.Proj[AProjIndex], vRec);
+    end;
+  end;
+end;
+
+procedure TProjGather.GatherSpecialDealPays(AProjType: Integer);
+var
+  idxView: TsdIndex;
+  iRec: Integer;
+  vRec: TsdDataRecord;
+  vDealPay: TProjGatherDealPayNode;
+begin
+  with FProjectData.DealPaymentData do
+  begin
+    idxView := sddDealPayment.FindIndex('idxView');
+    for iRec := 0 to idxView.RecordCount - 1 do
+    begin
+      vRec := idxView.Records[iRec];
+
+      vDealPay := FDealPay.GetDealPayNode(vRec);
+      AddProjDealPayCalcData(vDealPay.SpecialProj[AProjType - 1], vRec);
+    end;
+  end;
+end;
+
+procedure TProjGather.AddProjDealPayCalcData(ADealPayCalc: TDealPayCalcData;
+  ARec: TsdDataRecord);
+begin
+  ADealPayCalc.AddTotalPrice := ADealPayCalc.AddTotalPrice + ARec.ValueByName('TotalPrice').AsFloat;
+  AddProjDealPayPhaseCalcData(ADealPayCalc, ARec);
+end;
+
+procedure TProjGather.BeforeGather;
+var
+  iSpecial: Integer;
+begin
+  if Assigned(FSpecialProjTypes) then
+    iSpecial := FSpecialProjTypes.Count
+  else
+    iSpecial := 0;
+  FTree := TProjGatherTree.Create(FCommonProjs.Count, iSpecial);
+  FTree.NewNodeID := 101;
+  FDealPay := TProjGatherDealPayList.Create(FCommonProjs.Count, iSpecial);
+  FProperties := TProjGatherProperties.Create;
+end;
+
+procedure TProjGather.AfterGather;
+begin
+  FProperties.Free;
+  FDealPay.Free;
+  FTree.Free;
+end;
+
+procedure TProjGather.GatherProjProperties;
+
+  procedure GatherFloatProjProperty(const AName: string);
+  var
+    fValue: Double;
+    vProperty: TProjGatherProperty;
+  begin
+    vProperty := FProperties.GetProjGatherProperty(AName);
+    fValue := FProjectData.ProjProperties.GetFloatPropertyDef(AName, 0);
+    fValue := fValue + StrToFloatDef(vProperty.Value, 0);
+    vProperty.Value := FloatToStr(fValue);
+  end;
+
+begin
+  GatherFloatProjProperty('ContractPrice');
+  GatherFloatProjProperty('MaterialSubsist');
+  GatherFloatProjProperty('StartedSubsist');
+end;
+
+procedure TProjGather.AddProjDealPayPhaseCalcData(
+  ADealPayCalc: TDealPayCalcData; ARec: TsdDataRecord);
+var
+  vPhaseRec: TsdDataRecord;
+begin
+  if FProjectData.PhaseData.Active then
+    vPhaseRec := FProjectData.PhaseData.PhasePayData.PayRecord(ARec.ValueByName('ID').AsInteger)
+  else
+    vPhaseRec := nil;
+  if Assigned(vPhaseRec) then
+  begin
+    ADealPayCalc.CurTotalPrice := ADealPayCalc.CurTotalPrice + vPhaseRec.ValueByName(FDealCurField).AsFloat;
+    ADealPayCalc.PreTotalPrice := ADealPayCalc.PreTotalPrice + vPhaseRec.ValueByName(FDealPreField).AsFloat;
+    ADealPayCalc.EndTotalPrice := ADealPayCalc.EndTotalPrice + vPhaseRec.ValueByName(FDealEndField).AsFloat;
+  end;
+end;
+
 { TZoneProjGather }
 
+procedure TZoneProjGather.AddProjDealPayPhaseCalcData(
+  ADealPayCalc: TDealPayCalcData; ARec: TsdDataRecord);
+var
+  vPhaseRec: TsdDataRecord;
+begin
+  if Assigned(FEndPhaseData) then
+    vPhaseRec := FEndPhaseData.PhasePayData.PayRecord(ARec.ValueByName('ID').AsInteger)
+  else
+    vPhaseRec := nil;
+  if Assigned(vPhaseRec) then
+  begin
+    ADealPayCalc.CurTotalPrice := ADealPayCalc.CurTotalPrice + vPhaseRec.ValueByName(FDealCurField).AsFloat;
+    ADealPayCalc.PreTotalPrice := ADealPayCalc.PreTotalPrice + vPhaseRec.ValueByName(FDealPreField).AsFloat;
+    ADealPayCalc.EndTotalPrice := ADealPayCalc.EndTotalPrice + vPhaseRec.ValueByName(FDealEndField).AsFloat;
+
+    ADealPayCalc.ZoneTotalPrice := ADealPayCalc.ZoneTotalPrice + vPhaseRec.ValueByName(FDealEndField).AsFloat;
+  end;
+
+  if Assigned(FBeginPhaseData) then
+    vPhaseRec := FBeginPhaseData.PhasePayData.PayRecord(ARec.ValueByName('ID').AsInteger)
+  else
+    vPhaseRec := nil;
+  if Assigned(vPhaseRec) then
+  begin
+    ADealPayCalc.ZoneTotalPrice := ADealPayCalc.ZoneTotalPrice - vPhaseRec.ValueByName(FDealEndField).AsFloat;
+  end;
+end;
+
 procedure TZoneProjGather.AddProjMeasureCalcData(AProjCalc: TProjCalc;
   ANode: TMeasureBillsIDTreeNode);
 var

ProjGather/ProjGatherDealPay.pas

@@ -0,0 +1,252 @@
+unit ProjGatherDealPay;
+
+interface
+
+uses
+  Classes, sdDB;
+
+type
+  TDealPayCalcData = class
+  private
+    FCurTotalPrice: Double;
+    FPreTotalPrice: Double;
+    FEndTotalPrice: Double;
+    FAddTotalPrice: Double;
+
+    FZoneTotalPrice: Double;
+  public
+    property CurTotalPrice: Double read FCurTotalPrice write FCurTotalPrice;
+    property PreTotalPrice: Double read FPreTotalPrice write FPreTotalPrice;
+    property EndTotalPrice: Double read FEndTotalPrice write FEndTotalPrice;
+    property AddTotalPrice: Double read FAddTotalPrice write FAddTotalPrice;
+
+    property ZoneTotalPrice: Double read FZoneTotalPrice write FZoneTotalPrice;
+  end;
+
+  TProjGatherDealPayNode = class
+  private
+    FID: Integer;
+    FName: string;
+    FCalcType: Integer;
+    FIsMinus: Boolean;
+
+    FSerialNo: Integer;
+    FLinkSerialNo: Integer;
+
+    FGatherCalc: TDealPayCalcData;
+    FProjs: TList;
+    FSpecialProjs: TList;
+    function GetProj(AIndex: Integer): TDealPayCalcData;
+    function GetProjCount: Integer;
+    function GetSpecialProjCount: Integer;
+    function GetSpecialProj(AIndex: Integer): TDealPayCalcData;
+  public
+    constructor Create(AID: Integer; AProjCount, ASpeicalProjCount: Integer);
+    destructor Destroy; override;
+
+    property ID: Integer read FID;
+    property Name: string read FName;
+    property CalcType: Integer read FCalcType;
+    property IsMinus: Boolean read FIsMinus;
+
+    property SerialNo: Integer read FSerialNo;
+    property LinkSerialNo: Integer read FLinkSerialNo;
+
+    property GatherCalc: TDealPayCalcData read FGatherCalc;
+
+    property ProjCount: Integer read GetProjCount;
+    property Proj[AIndex: Integer]: TDealPayCalcData read GetProj;
+
+    property SpecialProjCount: Integer read GetSpecialProjCount;
+    property SpecialProj[AIndex: Integer]: TDealPayCalcData read GetSpecialProj;
+  end;
+
+  TProjGatherDealPayList = class
+  private
+    FProjCount: Integer;
+    FSpecialProjCount: Integer;
+
+    FNewID: Integer;
+
+    FList: TList;
+
+    function FindDealPayNode(ARec: TsdDataRecord): TProjGatherDealPayNode;
+    function CreateDealPayNode(ARec: TsdDataRecord): TProjGatherDealPayNode;
+
+    function GetCount: Integer;
+    function GetDealPay(AIndex: Integer): TProjGatherDealPayNode;
+  public
+    constructor Create(AProjCount, ASpeicalProjCount: Integer);
+    destructor Destroy; override;
+
+    function GetDealPayNode(ARec: TsdDataRecord): TProjGatherDealPayNode;
+
+    procedure UpdateLinkSerialNo;
+
+    property DealPay[AIndex: Integer]: TProjGatherDealPayNode read GetDealPay;
+    property Count: Integer read GetCount;
+  end;
+
+implementation
+
+uses
+  ZhAPI, SysUtils;
+
+{ TProjGatherDealPayNode }
+
+constructor TProjGatherDealPayNode.Create(AID: Integer; AProjCount,
+  ASpeicalProjCount: Integer);
+var
+  i: Integer;
+  DealPayCalc: TDealPayCalcData;
+begin
+  FID := AID;
+
+  FGatherCalc :=  TDealPayCalcData.Create;
+  FProjs := TList.Create;
+  for i := 0 to AProjCount - 1 do
+  begin
+    DealPayCalc := TDealPayCalcData.Create;
+    FProjs.Add(DealPayCalc);
+  end;
+  FSpecialProjs := TList.Create;
+  for i := 0 to ASpeicalProjCount - 1 do
+  begin
+    DealPayCalc := TDealPayCalcData.Create;
+    FSpecialProjs.Add(DealPayCalc);
+  end;
+end;
+
+destructor TProjGatherDealPayNode.Destroy;
+begin
+  FGatherCalc.Free;
+  ClearObjects(FSpecialProjs);
+  FSpecialProjs.Free;
+  ClearObjects(FProjs);
+  FProjs.Free;
+  inherited;
+end;
+
+function TProjGatherDealPayNode.GetProj(AIndex: Integer): TDealPayCalcData;
+begin
+  Result := TDealPayCalcData(FProjs.Items[AIndex]);
+end;
+
+function TProjGatherDealPayNode.GetProjCount: Integer;
+begin
+  Result := FProjs.Count;
+end;
+
+function TProjGatherDealPayNode.GetSpecialProj(
+  AIndex: Integer): TDealPayCalcData;
+begin
+  Result := TDealPayCalcData(FProjs.Items[AIndex]);
+end;
+
+function TProjGatherDealPayNode.GetSpecialProjCount: Integer;
+begin
+  Result := FSpecialProjs.Count;
+end;
+
+{ TProjGatherDealPayList }
+
+constructor TProjGatherDealPayList.Create(AProjCount,
+  ASpeicalProjCount: Integer);
+begin
+  FProjCount := AProjCount;
+  FSpecialProjCount := ASpeicalProjCount;
+  FList := TList.Create;
+  FNewID := 1;
+end;
+
+function TProjGatherDealPayList.CreateDealPayNode(ARec: TsdDataRecord): TProjGatherDealPayNode;
+begin
+  Result := TProjGatherDealPayNode.Create(FNewID, FProjCount, FSpecialProjCount);
+  Inc(FNewID);
+  Result.FName := ARec.ValueByName('Name').AsString;
+  Result.FCalcType := ARec.ValueByName('CalcType').AsInteger;
+  Result.FIsMinus := ARec.ValueByName('IsMinus').AsBoolean;
+  Result.FSerialNo := Result.ID;
+  FList.Add(Result); 
+end;
+
+destructor TProjGatherDealPayList.Destroy;
+begin
+  ClearObjects(FList);
+  FList.Free;
+  inherited;
+end;
+
+function TProjGatherDealPayList.FindDealPayNode(ARec: TsdDataRecord): TProjGatherDealPayNode;
+var
+  iDeal: Integer;
+  vDeal: TProjGatherDealPayNode;
+begin
+  Result := nil;
+  for iDeal := 0 to FList.Count - 1 do
+  begin
+    vDeal := DealPay[iDeal];
+    if ARec.ValueByName('CalcType').AsInteger = 0 then
+    begin
+      if SameText(vDeal.Name, ARec.ValueByName('Name').AsString) and
+         (vDeal.IsMinus = ARec.ValueByName('IsMinus').AsBoolean) then
+      begin
+        Result := vDeal;
+        Break;
+      end;
+    end
+    else
+    begin
+      if vDeal.CalcType = ARec.ValueByName('CalcType').AsInteger then
+      begin
+        Result := vDeal;
+        Break;
+      end;
+    end;
+  end;
+end;
+
+function TProjGatherDealPayList.GetCount: Integer;
+begin
+  Result := FList.Count;
+end;
+
+function TProjGatherDealPayList.GetDealPay(AIndex: Integer): TProjGatherDealPayNode;
+begin
+  Result := TProjGatherDealPayNode(FList.Items[AIndex]);
+end;
+
+function TProjGatherDealPayList.GetDealPayNode(ARec: TsdDataRecord): TProjGatherDealPayNode;
+begin
+  Result := FindDealPayNode(ARec);
+  if not Assigned(Result) then
+    Result := CreateDealPayNode(ARec);
+end;
+
+procedure TProjGatherDealPayList.UpdateLinkSerialNo;
+var
+  iPay, iCut, iIndex: Integer;
+  vDealPay: TProjGatherDealPayNode;
+begin
+  iPay := 1;
+  iCut := 1;
+  for iIndex := 0 to Count - 1 do
+  begin
+    vDealPay := DealPay[iIndex];
+    if vDealPay.CalcType = 0 then
+    begin
+      if vDealPay.IsMinus then
+      begin
+        vDealPay.FLinkSerialNo := iCut;
+        Inc(iCut);
+      end
+      else
+      begin
+        vDealPay.FLinkSerialNo := iPay;
+        Inc(iPay);
+      end;
+    end;
+  end;
+end;
+
+end.

ProjGather/ProjGatherProperties.pas

@@ -0,0 +1,114 @@
+unit ProjGatherProperties;
+
+interface
+
+uses
+  Classes, ZhAPI;
+
+type
+  TProjGatherProperty = class
+  private
+    FName: string;
+    FValue: string;
+  public
+    constructor Create(const AName: string);
+    destructor Destroy; override;
+
+    property Name: string read FName write FName;
+    property Value: string read FValue write FValue;
+  end;
+
+  TProjGatherProperties = class
+  private
+    FList: TList;
+
+    function FindProjGatherProperty(const AName: string): TProjGatherProperty;
+    function AddProjGatherProperty(const AName: string): TProjGatherProperty;
+
+    function GetCount: Integer;
+    function GetPgPropperty(AIndex: Integer): TProjGatherProperty;
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    function GetProjGatherProperty(const AName: string): TProjGatherProperty;
+
+    property Count: Integer read GetCount;
+    property PgProperty[AIndex: Integer]: TProjGatherProperty read GetPgPropperty;
+  end;
+
+implementation
+
+uses SysUtils;
+
+{ TProjGatherProperty }
+
+constructor TProjGatherProperty.Create(const AName: string);
+begin
+  FName := AName;
+end;
+
+destructor TProjGatherProperty.Destroy;
+begin
+  inherited;
+end;
+
+{ TProjGatherProperties }
+
+function TProjGatherProperties.AddProjGatherProperty(
+  const AName: string): TProjGatherProperty;
+begin
+  Result := TProjGatherProperty.Create(AName);
+  FList.Add(Result);
+end;
+
+constructor TProjGatherProperties.Create;
+begin
+  FList := TList.Create;
+end;
+
+destructor TProjGatherProperties.Destroy;
+begin
+  ClearObjects(FList);
+  FList.Free;
+  inherited;
+end;
+
+function TProjGatherProperties.FindProjGatherProperty(
+  const AName: string): TProjGatherProperty;
+var
+  i: Integer;
+  vProperty: TProjGatherProperty;
+begin
+  Result := nil;
+  for i := 0 to Count - 1 do
+  begin
+    vProperty := PgProperty[i];
+    if vProperty.Name = AName then
+    begin
+      Result := vProperty;
+      Break;
+    end;
+  end;
+end;
+
+function TProjGatherProperties.GetCount: Integer;
+begin
+  Result := FList.Count;
+end;
+
+function TProjGatherProperties.GetPgPropperty(
+  AIndex: Integer): TProjGatherProperty;
+begin
+  Result := TProjGatherProperty(FList.Items[AIndex]);
+end;
+
+function TProjGatherProperties.GetProjGatherProperty(
+  const AName: string): TProjGatherProperty;
+begin
+  Result := FindProjGatherProperty(AName);
+  if not Assigned(Result) then
+    Result := AddProjGatherProperty(AName);
+end;
+
+end.

Report/ProjGather/rProjGatherTables.pas

@@ -298,6 +298,64 @@ const
     (FieldName: 'BGLType'; FieldType: ftString; Size: 10; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False)
   );
 
+  SDealPay_Gather = 'r_DealPay_Gather'; // 合计, 默认ProjID为 -2
+  SDealPay_Proj = 'r_DealPay_Proj'; // 存在N个项目则，有r_DealPay_Proj1 ... r_DealPay_ProjN，分别存储个项目数据
+  SDealPay_TransProj = 'r_DealPay_TransProj'; // 合并所有的r_DealPay_Proj
+
+  // 此部分数据不汇总至r_DealPay_Gather
+  SDealPay_SProj = 'r_DealPay_SProj';
+
+  tdDealPay_Calc: array [0..12] of TScFieldDef =(
+    (FieldName: 'ID'; FieldType: ftInteger; Size: 0; Precision: 0; NotNull: True; PrimaryKey: True; ForceUpdate: False),
+    // 对应于r_GatherProj中的ID字段
+    (FieldName: 'ProjID'; FieldType: ftInteger; Size: 0; Precision: 0; NotNull: True; PrimaryKey: True; ForceUpdate: False),
+    // 项目类型（r_DealPay_SProj使用，用于标记非正常汇总项目）
+    (FieldName: 'ProjType'; FieldType: ftInteger; Size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+
+    // 名称
+    (FieldName: 'Name'; FieldType: ftString; Size: 50; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 计算类型
+    // 0: 一般项
+    // 1: 本期应付 -- 汇总所有的一般项
+    // 2: 本期实付 -- 输入项
+    (FieldName: 'CalcType'; FieldType: ftInteger; Size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 是否扣减项
+    (FieldName: 'IsMinus'; FieldType: ftBoolean; Size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+
+    // 排序
+    (FieldName: 'SerialNo'; FieldType: ftInteger; Size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 按是否扣减分类，排序
+    (FieldName: 'LinkSerialNo'; FieldType: ftInteger; Size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+
+    // 累计完成 -- 金额
+    (FieldName: 'AddTotalPrice'; FieldType: ftDouble; Size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+
+    // 本期完成 -- 金额
+    (FieldName: 'CurTotalPrice'; FieldType: ftDouble; Size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 截止上期完成 -- 金额
+    (FieldName: 'PreTotalPrice'; FieldType: ftDouble; Size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 截止本期完成 -- 金额
+    (FieldName: 'EndTotalPrice'; FieldType: ftDouble; Size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+
+    // 区间 -- 金额
+    (FieldName: 'ZoneTotalPrice'; FieldType: ftDouble; Size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False)
+  );
+
+  SProjPropertied_Gather = 'r_Projproperties_Gather';
+  SProjProperties_TransProj = 'r_ProjProperties_TransProj';
+  tdProjProperties_TransProj: array [0..4] of TScFieldDef =(
+    (FieldName: 'ID'; FieldType: ftInteger; Size: 0; Precision: 0; NotNull: True; PrimaryKey: True; ForceUpdate: False),
+    // 对应于r_GatherProj中的ID字段
+    (FieldName: 'ProjID'; FieldType: ftInteger; Size: 0; Precision: 0; NotNull: True; PrimaryKey: True; ForceUpdate: False),
+    // 项目类型（r_Bills_SProj使用，用于标记非正常汇总项目）
+    (FieldName: 'ProjType'; FieldType: ftInteger; Size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+
+    // 名称
+    (FieldName: 'Name'; FieldType: ftString; Size: 50; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 值
+    (FieldName: 'PropValue'; FieldType: ftString; Size: 50; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False)
+  );
+
 implementation
 
 end.

Report/ProjGather/rpgDealPayDm.dfm

@@ -0,0 +1,17 @@
+object rgpDealPayData: TrgpDealPayData
+  OldCreateOrder = False
+  Left = 192
+  Top = 123
+  Height = 188
+  Width = 177
+  object sdpDealPay: TsdADOProvider
+    Left = 66
+    Top = 16
+  end
+  object sddDealPay: TsdDataSet
+    Active = False
+    Provider = sdpDealPay
+    Left = 66
+    Top = 88
+  end
+end

Report/ProjGather/rpgDealPayDm.pas

@@ -0,0 +1,145 @@
+unit rpgDealPayDm;
+
+interface
+
+uses
+  SysUtils, Classes, sdProvider, sdDB, ProjGatherDealPay, ADODB;
+
+type
+  TrgpDealPayData = class(TDataModule)
+    sdpDealPay: TsdADOProvider;
+    sddDealPay: TsdDataSet;
+  private
+    FProjIndex: Integer;
+    FProjType: Integer;
+
+    procedure SaveDealPayNodeCalc(ADealPay: TProjGatherDealPayNode; ACalc: TDealPayCalcData);
+    procedure SaveDealPayCalc(ADealPays: TProjGatherDealPayList);
+    procedure SaveDealPayGather(ADealPays: TProjGatherDealPayList);
+  public
+    constructor Create(AConnection: TADOConnection);
+
+    procedure SaveSpecialProjDataTo(ADealPays: TProjGatherDealPayList; AProjType: Integer; const ATableName: string);
+    procedure SaveProjDataTo(ADealPays: TProjGatherDealPayList; AProjIndex: Integer; const ATableName: string);
+    procedure SaveGatherDataTo(ADealPays: TProjGatherDealPayList; const ATableName: string);
+  end;
+
+implementation
+
+{$R *.dfm}
+
+{ TrgpDealPayData }
+
+constructor TrgpDealPayData.Create(AConnection: TADOConnection);
+begin
+  inherited Create(nil);
+  sdpDealPay.Connection := AConnection;
+end;
+
+procedure TrgpDealPayData.SaveDealPayCalc(
+  ADealPays: TProjGatherDealPayList);
+var
+  iDeal: Integer;
+  vDealPay: TProjGatherDealPayNode;
+begin
+  for iDeal := 0 to ADealPays.Count - 1 do
+  begin
+    vDealPay := ADealPays.DealPay[iDeal];
+    if FProjType = 0 then
+      SaveDealPayNodeCalc(vDealPay, vDealPay.Proj[FProjIndex])
+    else if FProjType > 0 then
+      SaveDealPayNodeCalc(vDealPay, vDealPay.SpecialProj[FProjType-1]);
+  end;
+end;
+
+procedure TrgpDealPayData.SaveDealPayGather(
+  ADealPays: TProjGatherDealPayList);
+var
+  iDeal: Integer;
+  vDealPay: TProjGatherDealPayNode;
+begin
+  for iDeal := 0 to ADealPays.Count - 1 do
+  begin
+    vDealPay := ADealPays.DealPay[iDeal];
+    SaveDealPayNodeCalc(vDealPay, vDealPay.GatherCalc);
+  end;
+end;
+
+procedure TrgpDealPayData.SaveDealPayNodeCalc(
+  ADealPay: TProjGatherDealPayNode; ACalc: TDealPayCalcData);
+var
+  Rec: TsdDataRecord;
+begin
+  Rec := sddDealPay.Add;
+  Rec.ValueByName('ID').AsInteger := ADealPay.ID;
+  Rec.ValueByName('ProjID').AsInteger := FProjIndex;
+  Rec.ValueByName('ProjType').AsInteger := FProjType;
+
+  Rec.ValueByName('Name').AsString := ADealPay.Name;
+  Rec.ValueByName('CalcType').AsInteger := ADealPay.CalcType;
+  Rec.ValueByName('IsMinus').AsBoolean := ADealPay.IsMinus;
+
+  Rec.ValueByName('SerialNo').AsInteger := ADealPay.SerialNo;
+  Rec.ValueByName('LinkSerialNo').AsInteger := ADealPay.LinkSerialNo;
+
+  Rec.ValueByName('CurTotalPrice').AsFloat := ACalc.CurTotalPrice;
+  Rec.ValueByName('PreTotalPrice').AsFloat := ACalc.PreTotalPrice;
+  Rec.ValueByName('EndTotalPrice').AsFloat := ACalc.EndTotalPrice;
+  Rec.ValueByName('AddTotalPrice').AsFloat := ACalc.AddTotalPrice;
+
+  Rec.ValueByName('ZoneTotalPrice').AsFloat := ACalc.ZoneTotalPrice;
+end;
+
+procedure TrgpDealPayData.SaveGatherDataTo(
+  ADealPays: TProjGatherDealPayList; const ATableName: string);
+begin
+  FProjIndex := -2;
+  FProjType := 0;
+
+  sdpDealPay.TableName := ATableName;
+  sddDealPay.Open;
+  sddDealPay.BeginUpdate;
+  try
+    SaveDealPayGather(ADealPays);
+  finally
+    sddDealPay.EndUpdate;
+    sddDealPay.Save;
+  end;
+end;
+
+procedure TrgpDealPayData.SaveProjDataTo(ADealPays: TProjGatherDealPayList;
+  AProjIndex: Integer; const ATableName: string);
+begin
+  FProjIndex := AProjIndex;
+  FProjType := 0;
+  
+  sdpDealPay.TableName := ATableName;
+  sddDealPay.Open;
+  sddDealPay.BeginUpdate;
+  try
+    SaveDealPayCalc(ADealPays);
+  finally
+    sddDealPay.EndUpdate;
+    sddDealPay.Save;
+  end;
+end;
+
+procedure TrgpDealPayData.SaveSpecialProjDataTo(
+  ADealPays: TProjGatherDealPayList; AProjType: Integer;
+  const ATableName: string);
+begin
+  FProjIndex := -3;
+  FProjType := AProjType;
+
+  sdpDealPay.TableName := ATableName;
+  sddDealPay.Open;
+  sddDealPay.BeginUpdate;
+  try
+    SaveDealPayCalc(ADealPays);
+  finally
+    sddDealPay.EndUpdate;
+    sddDealPay.Save;
+  end;
+end;
+
+end.

Report/ProjGather/rpgGatherControl.pas

@@ -14,6 +14,8 @@ type
     FTemplate: TTemplateNode;
     // »ã×ÜÊý¾Ý
     FGatherData: TrpgGatherData;
+    // GatherProjectRelaData
+    FTempFile: string;
 
     procedure CopyTables(const AFileName, ATableName: string);
     procedure CopyRelaData;

Report/ProjGather/rpgGatherData.pas

@@ -3,8 +3,9 @@ unit rpgGatherData;
 interface
 
 uses
-  ADODB, ProjGather, rpgGatherProjDm, rpgBillsDm, rpgBillsCalcDm, Classes,
-  ScAutoUpdateUnit, ProjGatherTree, GatherProjInfo;
+  ADODB, Classes, ProjGather, ScAutoUpdateUnit,
+  ProjGatherTree, GatherProjInfo, ProjGatherDealPay, ProjGatherProperties,
+  rpgGatherProjDm, rpgBillsDm, rpgBillsCalcDm, rpgDealPayDm;
 
 type
   TrpgGatherData = class
@@ -22,6 +23,12 @@ type
     procedure SaveBillsProjCalc(ATree: TProjGatherTree; AProjIndex: Integer);
     procedure SaveBillsSpecialProjCalc(ATree: TProjGatherTree; AProjType: Integer);
 
+    procedure SaveDealPayGatherData(ADealPay: TProjGatherDealPayList);
+    procedure SaveDealPayProjData(ADealPay: TProjGatherDealPayList; AProjIndex: Integer);
+    procedure SaveDealPaySpecialProjData(ADealPay: TProjGatherDealPayList; AProjType: Integer);
+
+    procedure SaveGatherProjProperties(AProperties: TProjGatherProperties);
+
     procedure CalcDgnData(const ATableName: string);
     procedure CalcOtherData(AProjCount, ASProjCount: Integer);
 
@@ -29,6 +36,7 @@ type
 
     function GetCacheProjFile(AProj: TGatherProjInfo): string;
     procedure CopyBGLData(const AFileName: string; AProjIndex, AProjType: Integer);
+    procedure CopyProjProperty(const AFileName: string; AProjIndex, AProjType: Integer);
     procedure CopyProjRelaGatherData(AProj: TGatherProjInfo; AProjIndex: Integer);
 
     function GetCurSpecialProjCount: Integer;
@@ -63,14 +71,27 @@ 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);
   for iProj := 0 to ASProjCount - 1 do
     AUpdater.AddTableDef(SBills_SProj+IntToStr(iProj+1), @tdBills_Calc, Length(tdBills_Calc), False, False);
+
   AUpdater.AddTableDef(SBGL_TransProj, @tdBGL_TransProj, Length(tdBGL_TransProj), False, False);
+
+  AUpdater.AddTableDef(SDealPay_Gather, @tdDealPay_Calc, Length(tdDealPay_Calc), False, False);
+  for iProj := 0 to AProjCount - 1 do
+    AUpdater.AddTableDef(SDealPay_Proj+IntToStr(iProj+1), @tdDealPay_Calc, Length(tdDealPay_Calc), False, False);
+  AUpdater.AddTableDef(SDealPay_TransProj, @tdDealPay_Calc, Length(tdDealPay_Calc), False, False);
+  for iProj := 0 to ASProjCount - 1 do
+    AUpdater.AddTableDef(SDealPay_SProj+IntToStr(iProj+1), @tdDealPay_Calc, Length(tdDealPay_Calc), False, False);
+
+  AUpdater.AddTableDef(SProjProperties_TransProj, @tdProjProperties_TransProj, Length(tdProjProperties_TransProj), False, False);
+  AUpdater.AddTableDef(SProjPropertied_Gather, @tdProjProperties_TransProj, Length(tdProjProperties_TransProj), False, False);
 end;
 
 procedure TrpgGatherData.CalcDgnData(const ATableName: string);
@@ -146,6 +167,7 @@ begin
   try
     sTempFile := GetCacheProjFile(AProj);
     CopyBGLData(sTempFile, AProjIndex, AProj.ProjType);
+    CopyProjProperty(sTempFile, AProjIndex, AProj.ProjType);
   finally
     if FileExists(sTempFile) then
       DeleteFile(sTempFile);
@@ -295,17 +317,28 @@ var
 begin
   SaveGatherProjInfo(AGather.CommonProj, AGather.SpecialProj);
   SaveBills(AGather.Tree);
+
   SaveBillsGatherCalc(AGather.Tree);
+  SaveDealPayGatherData(AGather.DealPay);
+  SaveGatherProjProperties(AGather.Properties);
+
   for iProj := 0 to AGather.CommonProj.Count - 1 do
   begin
     SaveBillsProjCalc(AGather.Tree, iProj);
     ExecuteSql(FConnection, Format(sInsert, [SBills_TransProj, SBills_Proj+IntToStr(iProj+1)]));
     CopyProjRelaGatherData(TGatherProjInfo(AGather.CommonProj.Items[iProj]), iProj);
+
+    SaveDealPayProjData(AGather.DealPay, iProj);
+    ExecuteSql(FConnection, Format(sInsert, [SDealPay_TransProj, SDealPay_Proj+IntToStr(iProj+1)]));
   end;
+
   for iProj := 0 to AGather.Tree.SpecialProjCount - 1 do
-    SaveBillsSpecialProjCalc(AGather.Tree, iProj+1);
-  for iProj := 0 to AGather.SpecialProj.Count - 1 do
+  begin
+    SaveBillsSpecialProjCalc(AGather.Tree, iProj+1);     
     CopyProjRelaGatherData(TGatherProjInfo(AGather.SpecialProj.Items[iProj]), -3);
+
+    SaveDealPaySpecialProjData(AGather.DealPay, iProj+1);
+  end;
 end;
 
 procedure TrpgGatherData.SaveGatherProjInfo(AProjs, ASProjs: TList);
@@ -327,7 +360,10 @@ var
   iProj: Integer;
 begin
   for iProj := 0 to AProjCount - 1 do
+  begin
     ExecuteSql(FConnection, Format(sInsert, [SBills_TransProj, SBills_Proj+IntToStr(iProj+1)]));
+    ExecuteSql(FConnection, Format(sInsert, [SDealPay_TransProj, SDealPay_Proj+IntToStr(iProj+1)]));
+  end;
 end;
 
 procedure TrpgGatherData.UpdateDataBase(ASpecialProjTypes: TStrings);
@@ -425,6 +461,7 @@ var
 begin
   for iProj := 0 to AGather.CommonProj.Count - 1 do
     CopyProjRelaGatherData(TGatherProjInfo(AGather.CommonProj.Items[iProj]), iProj);
+
   for iProj := 0 to AGather.SpecialProj.Count - 1 do
     CopyProjRelaGatherData(TGatherProjInfo(AGather.SpecialProj.Items[iProj]), -3);
 end;
@@ -446,4 +483,72 @@ begin
     vProjData.SaveTempDataBaseFile(Result);
 end;
 
+procedure TrpgGatherData.SaveDealPayGatherData(
+  ADealPay: TProjGatherDealPayList);
+var
+  vDealPayData: TrgpDealPayData;
+begin
+  vDealPayData := TrgpDealPayData.Create(FConnection);
+  try
+    vDealPayData.SaveGatherDataTo(ADealPay, SDealPay_Gather);
+  finally
+    vDealPayData.Free;
+  end;
+end;
+
+procedure TrpgGatherData.SaveDealPayProjData(
+  ADealPay: TProjGatherDealPayList; AProjIndex: Integer);
+var
+  vDealPayData: TrgpDealPayData;
+begin
+  vDealPayData := TrgpDealPayData.Create(FConnection);
+  try
+    vDealPayData.SaveProjDataTo(ADealPay, AProjIndex, SDealPay_Proj+IntToStr(AProjIndex+1));
+  finally
+    vDealPayData.Free;
+  end;
+end;
+
+procedure TrpgGatherData.SaveDealPaySpecialProjData(
+  ADealPay: TProjGatherDealPayList; AProjType: Integer);
+var
+  vDealPayData: TrgpDealPayData;
+begin
+  vDealPayData := TrgpDealPayData.Create(FConnection);
+  try
+    vDealPayData.SaveSpecialProjDataTo(ADealPay, AProjType, SDealPay_SProj+IntToStr(AProjType));
+  finally
+    vDealPayData.Free;
+  end;
+end;
+
+procedure TrpgGatherData.CopyProjProperty(const AFileName: string;
+  AProjIndex, AProjType: Integer);
+const
+  sCopy = 'Insert Into r_ProjProperties_TransProj' +
+          '  Select ID, %d As ProjID, %d As ProjType,' +
+          '    Name, PropValue' +
+          '  From ProjProperties In ''%s''';
+begin
+  ExecuteSql(FConnection, Format(sCopy, [AProjIndex, AProjType, AFileName]));
+end;
+
+procedure TrpgGatherData.SaveGatherProjProperties(
+  AProperties: TProjGatherProperties);
+
+  procedure SaveProperty(ID: Integer; AProperty: TProjGatherProperty);
+  const
+    sInsertSql = 'Insert Into r_ProjProperties_Gather (ID, ProjID, ProjType, Name, PropValue) ' +
+                 '  Values (%d, -2, 0, ''%s'', ''%s'')';
+  begin
+    ExecuteSql(FConnection, Format(sInsertSql, [ID, UpperCase(AProperty.Name), AProperty.Value]));
+  end;
+
+var
+  i: Integer;
+begin
+  for i := 0 to AProperties.Count - 1 do
+    SaveProperty(i, AProperties.PgProperty[i]);
+end;
+
 end.

Units/ProjectProperty.pas

@@ -85,11 +85,6 @@ type
     FReportShowStateText: string;
     FDealPhase: string;
 
-    function GetBoolPropertyDef(const AName: string; ADef: Boolean): Boolean;
-    function GetIntPropertyDef(const AName: string; ADef: Integer): Integer;
-    function GetStrPropertyDef(const AName, ADef: string): string;
-    function GetFloatPropertyDef(const AName: string; ADef: Double): Double;
-
     function GetDisplayFormat(ADigit: Integer): string;
 
     procedure LoadBaseProperties;
@@ -141,6 +136,11 @@ type
     procedure Save;
     procedure Reload;
 
+    function GetBoolPropertyDef(const AName: string; ADef: Boolean): Boolean;
+    function GetIntPropertyDef(const AName: string; ADef: Integer): Integer;
+    function GetStrPropertyDef(const AName, ADef: string): string;
+    function GetFloatPropertyDef(const AName: string; ADef: Double): Double;
+
     {Submit-Audit-Reply}
     // ¹²¼ÆÖÕÉó¼ÆÁ¿ÆÚÊý
     property FinalAuditCount: Integer read GetFinalAuditCount write SetFinalAuditCount;