汇总，汇总M-N期区间数据（M期截止本期-N期截止上期）

DataModules/OtherMeasurePhaseDm.pas

@@ -173,7 +173,7 @@ const
   sDeleteSql = 'Delete From OMPhaseDetail where (PhaseID = %d) and (StageID = %d)';
   sInsertSql = 'Insert Into OMPhaseDetail' +
                '  Select ID, %d As PhaseID, %d As StageID, PreTotalPrice, CurTotalPrice, EndTotalPrice' +
-               '    From OtherMeasurePhase';
+               '    From OtherMeasurePhase Where not Deleted';
 var
   iPhase, iStage: Integer;
   vQuery: TADOQuery;
@@ -181,7 +181,7 @@ begin
   if TProjectData(FProjectData).StageDataReadOnly then Exit;
 
   // 被删除的数据，也不应保留明细
-  //ExecuteSql(sdpPhase.Connection, sClearSql);
+  ExecuteSql(sdpPhase.Connection, sClearSql);
 
   iPhase := TProjectData(FProjectData).PhaseIndex;
   iStage := TProjectData(FProjectData).StageIndex;

ProjGather/ProjGather.pas

@@ -3,7 +3,8 @@ unit ProjGather;
 interface
 
 uses
-  Classes, ProjGatherTree, GatherProjInfo, ProjectData, BillsTree, CalcData;
+  Classes, ProjGatherTree, GatherProjInfo, ProjectData, BillsTree, CalcData,
+  PhaseData;
 
 type
   TProjGather = class;
@@ -25,9 +26,6 @@ type
 
     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: TMeasureBillsIDTreeNode);
@@ -35,7 +33,6 @@ type
     function GatherBillsNode(ANode: TMeasureBillsIDTreeNode; AParent: TProjGatherTreeNode;
       AProjIndex: Integer): TProjGatherTreeNode;
     procedure GatherBills(ANode: TMeasureBillsIDTreeNode; AParent: TProjGatherTreeNode; AProjIndex: Integer);
-    procedure GatherProj(AProj: TGatherProjInfo; AProjIndex: Integer);
 
     function GatherSpecialBillsNode(ANode: TMeasureBillsIDTreeNode;
       AParent: TProjGatherTreeNode; AProjType: Integer): TProjGatherTreeNode;
@@ -44,12 +41,20 @@ type
     procedure GatherSpecialProj(AProj: TGatherProjInfo);
 
     procedure FilterProjs;
+  protected
+    procedure OpenProjectData(AProj: TGatherProjInfo); virtual;
+    procedure FreeProjectData; virtual;
+
+    procedure GatherProj(AProj: TGatherProjInfo; AProjIndex: Integer);
+
+    procedure AddProjMeasureCalcData(AProjCalc: TProjCalc; ANode: TMeasureBillsIDTreeNode); virtual;
   public
     constructor Create(AWriter: TWriteGatherData; AXmjCompare, AGclCompare: Integer);
     destructor Destroy; override;
 
     procedure Gather(AProjs: TList; ASpecialProjTypes: TStrings);
-                                      
+
+    property ProjectData: TProjectData read FProjectData;
     property Tree: TProjGatherTree read FTree;
     property Projs: TList read FProjs;
     property CommonProj: TList read FCommonProjs;
@@ -57,17 +62,32 @@ type
     property SpecialProjTypes: TStrings read FSpecialProjTypes;
   end;
 
+  TZoneProjGather = class(TProjGather)
+  private
+    FBeginPhaseIndex: Integer;
+    FEndPhaseIndex: Integer;
+
+    FBeginPhaseData: TPhaseData;
+    FEndPhaseData: TPhaseData;
+  protected
+    procedure OpenProjectData(AProj: TGatherProjInfo); override;
+    procedure FreeProjectData; override;
+
+    procedure AddProjMeasureCalcData(AProjCalc: TProjCalc; ANode: TMeasureBillsIDTreeNode); override;
+  public
+    procedure Gather(AProjs: TList; ABeginPhaseIndex, AEndPhaseIndex: Integer); overload;
+  end;
+
 implementation
 
 uses
-  Globals, UtilMethods, sdIDTree, sdDB, mDataRecord, BillsMeasureDm;
+  Globals, UtilMethods, sdIDTree, sdDB, mDataRecord, BillsMeasureDm, SysUtils,
+  Math;
 
 { TProjGather }
 
 procedure TProjGather.AddProjCalcData(AProjCalc: TProjCalc;
   ANode: TMeasureBillsIDTreeNode);
-var
-  StageRec: TStageRecord;
 begin
   AProjCalc.Compile.Org.AddQuantity(ANode.Rec.OrgQuantity.AsFloat);
   AProjCalc.Compile.Org.AddTotalPrice(ANode.Rec.OrgTotalPrice.AsFloat);
@@ -91,31 +111,8 @@ begin
   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;
+  
+  AddProjMeasureCalcData(AProjCalc, ANode);
 end;
 
 constructor TProjGather.Create(AWriter: TWriteGatherData;
@@ -325,4 +322,156 @@ begin
   AddProjCalcData(Result.SpecialProj[AProjType - 1], ANode);
 end;
 
+procedure TProjGather.AddProjMeasureCalcData(AProjCalc: TProjCalc;
+  ANode: TMeasureBillsIDTreeNode);
+var
+  StageRec: TStageRecord;
+begin
+  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;
+
+{ TZoneProjGather }
+
+procedure TZoneProjGather.AddProjMeasureCalcData(AProjCalc: TProjCalc;
+  ANode: TMeasureBillsIDTreeNode);
+var
+  StageRec: TStageRecord;
+begin
+  if Assigned(FEndPhaseData) then
+    StageRec := FEndPhaseData.StageData.StageRecord(ANode.ID)
+  else
+    StageRec := nil;
+  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);
+
+    AProjCalc.ZoneMeasure.Deal.AddQuantity(StageRec.EndDealQuantity.AsFloat);
+    AProjCalc.ZoneMeasure.Deal.AddTotalPrice(StageRec.EndDealTotalPrice.AsFloat);
+    AProjCalc.ZoneMeasure.Qc.AddQuantity(StageRec.EndQcQuantity.AsFloat);
+    AProjCalc.ZoneMeasure.Qc.AddTotalPrice(StageRec.EndQcTotalPrice.AsFloat);
+    AProjCalc.ZoneMeasure.Gather.AddQuantity(StageRec.EndGatherQuantity.AsFloat);
+    AProjCalc.ZoneMeasure.Gather.AddTotalPrice(StageRec.EndGatherTotalPrice.AsFloat);
+  end;
+
+  if Assigned(FBeginPhaseData) then
+    StageRec := FBeginPhaseData.StageData.StageRecord(ANode.ID)
+  else
+    StageRec := nil;
+  if Assigned(StageRec) then
+  begin
+    AProjCalc.ZoneMeasure.Deal.AddQuantity(-StageRec.PreDealQuantity.AsFloat);
+    AProjCalc.ZoneMeasure.Deal.AddTotalPrice(-StageRec.PreDealTotalPrice.AsFloat);
+    AProjCalc.ZoneMeasure.Qc.AddQuantity(-StageRec.PreQcQuantity.AsFloat);
+    AProjCalc.ZoneMeasure.Qc.AddTotalPrice(-StageRec.PreQcTotalPrice.AsFloat);
+    AProjCalc.ZoneMeasure.Gather.AddQuantity(-StageRec.PreGatherQuantity.AsFloat);
+    AProjCalc.ZoneMeasure.Gather.AddTotalPrice(-StageRec.PreGatherTotalPrice.AsFloat);
+  end;
+end;
+
+procedure TZoneProjGather.FreeProjectData;
+begin
+  inherited;
+  if Assigned(ProjectData) and (ProjectData.PhaseData <> FBeginPhaseData) and Assigned(FBeginPhaseData) then
+    FBeginPhaseData.Free;
+  if Assigned(ProjectData) and (ProjectData.PhaseData <> FEndPhaseData) and Assigned(FEndPhaseData) then
+    FEndPhaseData.Free;
+end;
+
+procedure TZoneProjGather.Gather(AProjs: TList; ABeginPhaseIndex,
+  AEndPhaseIndex: Integer);
+var
+  i: Integer;
+begin
+  FProjs := AProjs;
+  FCommonProjs.Assign(FProjs);
+  FBeginPhaseIndex := ABeginPhaseIndex;
+  FEndPhaseIndex := AEndPhaseIndex;
+
+  FTree := TProjGatherTree.Create(FProjs.Count, 0);
+  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 TZoneProjGather.OpenProjectData(AProj: TGatherProjInfo);
+
+  function CreatePhaseData(APhaseIndex: Integer): TPhaseData;
+  begin
+    Result := TPhaseData.Create(ProjectData);
+    Result.SimpleOpen2(Format('%sPhase%d.dat', [FProjectData.TempPath, APhaseIndex]));
+  end;
+
+var
+  iCurBegin, iCurEnd: Integer;
+begin
+  inherited;
+  iCurBegin := Min(FBeginPhaseIndex, FProjectData.ProjProperties.PhaseCount);
+  iCurEnd := Min(FEndPhaseIndex, FProjectData.ProjProperties.PhaseCount);
+
+  if iCurBegin = 0 then
+    FBeginPhaseData := nil
+  else if iCurBegin = FProjectData.PhaseIndex then
+    FBeginPhaseData := FProjectData.PhaseData
+  else
+    FBeginPhaseData := CreatePhaseData(iCurBegin);
+
+  if iCurEnd = 0 then
+    FEndPhaseData := nil
+  else if iCurEnd = FProjectData.PhaseIndex then
+    FEndPhaseData := FProjectData.PhaseData
+  else if iCurEnd = FBeginPhaseIndex then
+    FEndPhaseData := FBeginPhaseData
+  else
+    FEndPhaseData := CreatePhaseData(iCurEnd);
+end;
+
 end.

ProjGather/ProjGatherSelectFme.dfm

@@ -0,0 +1,253 @@
+object ProjGatherSelectFrame: TProjGatherSelectFrame
+  Left = 0
+  Top = 0
+  Width = 816
+  Height = 483
+  TabOrder = 0
+  object pnlProjects: TPanel
+    Left = 0
+    Top = 0
+    Width = 449
+    Height = 483
+    Align = alLeft
+    BevelOuter = bvNone
+    TabOrder = 0
+    object pnlProjectsTitle: TPanel
+      Left = 0
+      Top = 0
+      Width = 449
+      Height = 24
+      Align = alTop
+      BevelOuter = bvNone
+      TabOrder = 0
+      object lblProjectList: TLabel
+        Left = 8
+        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
+    end
+    object zgSelectProject: TZJGrid
+      Left = 5
+      Top = 24
+      Width = 441
+      Height = 456
+      Options = [goRangeSelect, goRowSizing, goColSizing, goCellNotMaintainData, goFixedRowShowNo, goFixedColShowNo, goAlwaysShowSelection, goShowTreeLine]
+      OptionsEx = []
+      RowCount = 1
+      ShowGridLine = False
+      DefaultColWidth = 35
+      DefaultFixedColWidth = 25
+      DefaultFixedRowHeight = 32
+      Selection.AlphaBlend = False
+      Selection.TransparentColor = False
+      FrozenCol = 0
+      FrozenRow = 0
+      OnGetCellText = zgSelectProjectGetCellText
+      OnSetCellText = zgSelectProjectSetCellText
+      OnCellTextChanged = zgSelectProjectCellTextChanged
+      OnDrawCellText = zgSelectProjectDrawCellText
+      OnCellGetColor = zgSelectProjectCellGetColor
+      Align = alClient
+    end
+    object pnlProjLeft: TPanel
+      Left = 0
+      Top = 24
+      Width = 5
+      Height = 456
+      Align = alLeft
+      BevelOuter = bvNone
+      TabOrder = 2
+    end
+    object pnlProjRight: TPanel
+      Left = 446
+      Top = 24
+      Width = 3
+      Height = 456
+      Align = alRight
+      BevelOuter = bvNone
+      TabOrder = 3
+    end
+    object pnlProjBottom: TPanel
+      Left = 0
+      Top = 480
+      Width = 449
+      Height = 3
+      Align = alBottom
+      BevelOuter = bvNone
+      TabOrder = 4
+    end
+  end
+  object pnlResults: TPanel
+    Left = 449
+    Top = 0
+    Width = 367
+    Height = 483
+    Align = alClient
+    BevelOuter = bvNone
+    TabOrder = 1
+    object pnlResultTitle: TPanel
+      Left = 0
+      Top = 0
+      Width = 367
+      Height = 24
+      Align = alTop
+      BevelOuter = bvNone
+      TabOrder = 0
+      object lblResult: TLabel
+        Left = 8
+        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
+    end
+    object zgResult: TZJGrid
+      Left = 3
+      Top = 24
+      Width = 359
+      Height = 456
+      OptionsEx = []
+      ColCount = 2
+      RowCount = 1
+      ShowGridLine = False
+      DefaultColWidth = 308
+      DefaultFixedColWidth = 25
+      DefaultFixedRowHeight = 32
+      Selection.AlphaBlend = False
+      Selection.TransparentColor = False
+      FrozenCol = 0
+      FrozenRow = 0
+      OnGetCellText = zgResultGetCellText
+      OnSetCellText = zgResultSetCellText
+      Align = alClient
+    end
+    object pnlResultLeft: TPanel
+      Left = 0
+      Top = 24
+      Width = 3
+      Height = 456
+      Align = alLeft
+      BevelOuter = bvNone
+      TabOrder = 2
+    end
+    object pnlResultBottom: TPanel
+      Left = 0
+      Top = 480
+      Width = 367
+      Height = 3
+      Align = alBottom
+      BevelOuter = bvNone
+      TabOrder = 3
+    end
+    object pnlResultRight: TPanel
+      Left = 362
+      Top = 24
+      Width = 5
+      Height = 456
+      Align = alRight
+      BevelOuter = bvNone
+      TabOrder = 4
+    end
+  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
+      item
+        Title.Caption = #35745#37327#26399#25968
+        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 = 'PhaseCount'
+        Width = 35
+        ReadOnly = True
+      end
+      item
+        Title.Caption = #23457#25209#29366#24577
+        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 = 'AuditStatus'
+        Width = 35
+        ReadOnly = False
+      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

ProjGather/ProjGatherSelectFme.pas

@@ -0,0 +1,464 @@
+unit ProjGatherSelectFme;
+
+interface
+
+uses
+  sdIDTree, sdDB,
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, StdCtrls, ExtCtrls, sdGridDBA, sdGridTreeDBA, ZJGrid, ZJCells;
+
+type
+  TAfterSelectEvent = procedure of Object;
+
+  TProjGatherSelectFrame = class(TFrame)
+    zgSelectProject: TZJGrid;
+    stdSelectProject: TsdGridTreeDBA;
+    pnlProjects: TPanel;
+    pnlProjectsTitle: TPanel;
+    lblProjectList: TLabel;
+    pnlProjLeft: TPanel;
+    pnlProjRight: TPanel;
+    pnlProjBottom: TPanel;
+    pnlResults: TPanel;
+    pnlResultTitle: TPanel;
+    lblResult: TLabel;
+    zgResult: TZJGrid;
+    pnlResultLeft: TPanel;
+    pnlResultBottom: TPanel;
+    pnlResultRight: TPanel;
+    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 zgSelectProjectDrawCellText(ACanvas: TCanvas;
+      const ARect: TRect; const ACoord: TPoint; AGrid: TZJGrid;
+      const Text: String; var ADefaultDraw: Boolean);
+    procedure zgResultGetCellText(Sender: TObject; const ACoord: TPoint;
+      var Value: String; DisplayText: Boolean);
+    procedure zgResultSetCellText(Sender: TObject; const ACoord: TPoint;
+      var Value: String; DisplayText: Boolean);
+    procedure zgSelectProjectCellGetColor(Sender: TObject; ACoord: TPoint;
+      var AColor: TColor);
+  private
+    FProjectID: Integer;
+    FValidProjs: TList;
+    FSelectProjs: TList;
+    FSpecialProjTypes: TStrings;
+    FSpecialProjIDs: array of Integer;
+    FMarkedProjs: TList;
+    FAfterSelectProject: TAfterSelectEvent;
+
+    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);
+  public
+    constructor Create(AProjectID: Integer; ASpecialProjTypes: TStrings);
+    destructor Destroy; override;
+
+    procedure LoadHistorySelects(AProjs: TList);
+    procedure AssignResult(AProjs: TList);
+
+    procedure ClearMarkedProj;
+    function CheckProjPhaseValid(APhaseIndex: Integer): Boolean;
+
+    property AfterSelectProject: TAfterSelectEvent read FAfterSelectProject write FAfterSelectProject;
+  end;
+
+implementation
+
+uses
+  Globals, GatherProjInfo, MainFrm, Math, ZhAPI;
+
+{$R *.dfm}
+
+{ TProjGatherSelectFrame }
+
+procedure TProjGatherSelectFrame.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 TProjGatherSelectFrame.AddValidProject(ANode: TsdIDTreeNode);
+var
+  iChild: Integer;
+begin
+  FValidProjs.Add(ANode);
+  for iChild := 0 to ANode.ChildCount - 1 do
+    AddValidProject(ANode.ChildNodes[iChild]);
+end;
+
+procedure TProjGatherSelectFrame.AssignSelectTenders;
+
+  procedure InitResultGrid;
+  var
+    i: Integer;
+  begin
+    zgResult.ColCount := 2;
+    zgResult.RowCount := 1;
+    zgResult.Cells[1, 0].Text := 'ËùÑ¡ÏîÄ¿';
+    zgResult.ColWidths[1] := 308;
+    if Assigned(FSpecialProjTypes) then
+    begin
+      zgResult.ColWidths[1] := 308 - (Min(FSpecialProjTypes.Count, 2)*45);
+      for i := 0 to FSpecialProjTypes.Count - 1 do
+      begin
+        zgResult.ColCount := zgResult.ColCount + 1;
+        zgResult.Cells[2+i, 0].Text := FSpecialProjTypes.Strings[i];
+        zgResult.ColWidths[2+i] := 45;
+        zgResult.CellClass.Cols[2+i] := TZjCheckBoxCell;
+      end;
+    end;
+  end;
+
+var
+  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;
+
+constructor TProjGatherSelectFrame.Create(AProjectID: Integer;
+  ASpecialProjTypes: TStrings);
+var
+  i: Integer;
+begin
+  inherited Create(nil);  
+  FMarkedProjs := TList.Create;
+  FSelectProjs := TList.Create;
+
+  FProjectID := AProjectID;
+  FValidProjs := TList.Create;
+  // È¡Ïû¹ýÂË
+  //FilterValidProject;
+  //ProjectManager.sdvProjectsSpare.OnFilterRecord := DoOnFilterRecord;
+  ProjectManager.sdvProjectsSpare.Filtered := True;
+  stdSelectProject.DataView := ProjectManager.sdvProjectsSpare;
+
+  FSpecialProjTypes := ASpecialProjTypes;
+  if FSpecialProjTypes <> nil then
+  begin
+    SetLength(FSpecialProjIDs, FSpecialProjTypes.Count);
+    for i := 0 to ASpecialProjTypes.Count - 1 do
+      FSpecialProjIDs[i] := -1;
+  end;
+end;
+
+destructor TProjGatherSelectFrame.Destroy;
+begin
+  //ProjectManager.sdvProjectsSpare.Filtered := False;
+  //ProjectManager.sdvProjectsSpare.OnFilterRecord := nil;
+  FValidProjs.Free;
+  FSelectProjs.Free;
+  FMarkedProjs.Free;
+  inherited;
+end;
+
+procedure TProjGatherSelectFrame.DoOnFilterRecord(ARecord: TsdDataRecord;
+  var AAllow: Boolean);
+begin
+  AAllow := Assigned(ARecord) and IsValidProj(ARecord.ValueByName('ID').AsInteger);
+end;
+
+procedure TProjGatherSelectFrame.FilterValidProject;
+var
+  vTopParent: TsdIDTreeNode;
+  i: Integer;
+begin
+  vTopParent := GetTopParent;
+  AddValidProject(vTopParent);
+end;
+
+function TProjGatherSelectFrame.GetTopParent: TsdIDTreeNode;
+begin
+  Result := ProjectManager.ProjectsTree.FindNode(FProjectID);
+  while Assigned(Result.Parent) do
+    Result := Result.Parent;
+end;
+
+function TProjGatherSelectFrame.HasSelect(AProjectID: Integer): Boolean;
+begin
+  Result := FSelectProjs.IndexOf(Pointer(AProjectID)) <> -1;
+end;
+
+function TProjGatherSelectFrame.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 TProjGatherSelectFrame.LoadHistorySelects(AProjs: TList);
+var
+  i: Integer;
+  vGatherProjInfo: TGatherProjInfo;
+begin
+  for i := 0 to AProjs.Count - 1 do
+  begin
+    vGatherProjInfo := TGatherProjInfo(AProjs.Items[i]);
+    FSelectProjs.Add(Pointer(vGatherProjInfo.ProjectID));
+    if Assigned(FSpecialProjTypes) then
+    begin
+      if (vGatherProjInfo.ProjType > 0) and (vGatherProjInfo.ProjType <= FSpecialProjTypes.Count) then
+        FSpecialProjIDs[vGatherProjInfo.ProjType-1] := vGatherProjInfo.ProjectID;
+    end;
+  end;
+  AssignSelectTenders;
+end;
+
+procedure TProjGatherSelectFrame.RemoveProjs(ANode: TsdIDTreeNode);
+var
+  iChild: Integer;
+  i: Integer;
+begin
+  if FSelectProjs.IndexOf(Pointer(ANode.ID)) <> -1 then
+  begin
+    FSelectProjs.Remove(Pointer(ANode.id));
+    for i := Low(FSpecialProjIDs) to High(FSpecialProjIDs) do
+      if FSpecialProjIDs[i] = ANode.ID then
+        FSpecialProjIDs[i] := -1;
+  end;
+  for iChild := 0 to ANode.ChildCount - 1 do
+    RemoveProjs(ANode.ChildNodes[iChild]);
+end;
+
+procedure TProjGatherSelectFrame.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 TProjGatherSelectFrame.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 TProjGatherSelectFrame.zgSelectProjectCellTextChanged(
+  Sender: TObject; Col, Row: Integer);
+begin
+  if (Col = 1) then
+  begin
+    AssignSelectTenders;
+    if Assigned(FAfterSelectProject) then
+      FAfterSelectProject;
+  end;
+end;
+
+procedure TProjGatherSelectFrame.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;
+
+procedure TProjGatherSelectFrame.zgResultGetCellText(Sender: TObject;
+  const ACoord: TPoint; var Value: String; DisplayText: Boolean);
+begin
+  if (ACoord.X > 1) and (ACoord.Y > 0) then
+  begin
+    if Assigned(zgResult.Rows[ACoord.Y].Data) and (TsdIDTreeNode(zgResult.Rows[ACoord.Y].Data).ID = FSpecialProjIDs[ACoord.X-2]) then
+      Value := 'True'
+    else
+      Value := 'False';
+  end;
+end;
+
+procedure TProjGatherSelectFrame.zgResultSetCellText(Sender: TObject;
+  const ACoord: TPoint; var Value: String; DisplayText: Boolean);
+var
+  iProjID, i: Integer;
+  stnNode: TsdIDTreeNode;
+begin
+  if (ACoord.X > 1) and (ACoord.Y > 0) then
+  begin
+    stnNode := TsdIDTreeNode(zgResult.Rows[ACoord.Y].Data);
+    iProjID := stnNode.ID;
+    if FSpecialProjIDs[ACoord.X-2] <> iProjID then
+    begin
+      for i := Low(FSpecialProjIDs) to High(FSpecialProjIDs) do
+      begin
+        if FSpecialProjIDs[i] = iProjID then
+          FSpecialProjIDs[i] := -1
+      end;
+      FSpecialProjIDs[ACoord.X-2] := iProjID;
+    end
+    else
+      FSpecialProjIDs[ACoord.X-2] := -1;
+    for i := 0 to FSpecialProjTypes.Count - 1 do
+      zgResult.InvalidateCol(i+2);
+  end;
+end;
+
+procedure TProjGatherSelectFrame.AssignResult(AProjs: TList);
+
+  function SpecialProjType(AID: Integer): Integer;
+  var
+    i: Integer;
+  begin
+    Result := 0;
+    for i := Low(FSpecialProjIDs) to High(FSpecialProjIDs) do
+    begin
+      if AID = FSpecialProjIDs[i] then
+      begin
+        Result := i+1;
+        Break;
+      end;
+    end;
+  end;
+
+var
+  iRow: Integer;
+  stnNode: TsdIDTreeNode;
+  vGatherProj: TGatherProjInfo;
+begin
+  AProjs.Clear;
+  for iRow := 1 to zgResult.RowCount - 1 do
+  begin
+    stnNode := TsdIDTreeNode(zgResult.Rows[iRow].Data);
+    vGatherProj := TGatherProjInfo.Create(stnNode, -1, SpecialProjType(stnNode.ID));
+    AProjs.Add(vGatherProj);
+  end;
+end;
+
+function TProjGatherSelectFrame.CheckProjPhaseValid(
+  APhaseIndex: Integer): Boolean;
+var
+  iRow: Integer;
+  stnNode: TsdIDTreeNode;
+begin
+  FMarkedProjs.Clear;
+  for iRow := 1 to zgResult.RowCount - 1 do
+  begin
+    stnNode := TsdIDTreeNode(zgResult.Rows[iRow].Data);
+    if stnNode.Rec.ValueByName('PhaseCount').AsInteger < APhaseIndex then
+      FMarkedProjs.Add(Pointer(stnNode.ID));
+  end;
+  Result := FMarkedProjs.Count = 0;
+  zgSelectProject.Invalidate;
+end;
+
+procedure TProjGatherSelectFrame.zgSelectProjectCellGetColor(
+  Sender: TObject; ACoord: TPoint; var AColor: TColor);
+var
+  vProj: TsdIDTreeNode;
+begin
+  if ACoord.Y > 0 then
+  begin
+    vProj := stdSelectProject.IDTree.Items[ACoord.Y - 1];
+    if Assigned(vProj) then
+    begin
+      if FMarkedProjs.IndexOf(Pointer(vProj.ID)) <> -1 then
+        AColor := $00646AFE
+      else
+        AColor := clWindow;
+    end;
+  end;
+end;
+
+procedure TProjGatherSelectFrame.ClearMarkedProj;
+begin
+  FMarkedProjs.Clear;
+  zgSelectProject.Invalidate;
+end;
+
+end.

ProjGather/ProjGatherSelectFrm.dfm

@@ -4,7 +4,7 @@ object ProjGatherSelectForm: TProjGatherSelectForm
   BorderStyle = bsSingle
   Caption = #36873#25321#27719#24635#39033#30446
   ClientHeight = 523
-  ClientWidth = 816
+  ClientWidth = 827
   Color = clBtnFace
   Font.Charset = ANSI_CHARSET
   Font.Color = clWindowText
@@ -14,175 +14,30 @@ object ProjGatherSelectForm: TProjGatherSelectForm
   OldCreateOrder = False
   PixelsPerInch = 96
   TextHeight = 12
-  object lblProjectList: TLabel
-    Left = 8
-    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 = 451
-    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 = 5
-    Top = 24
-    Width = 441
-    Height = 457
-    Options = [goRangeSelect, goRowSizing, goColSizing, goCellNotMaintainData, goFixedRowShowNo, goFixedColShowNo, goAlwaysShowSelection, goShowTreeLine]
-    OptionsEx = []
-    RowCount = 1
-    ShowGridLine = False
-    DefaultColWidth = 35
-    DefaultFixedColWidth = 25
-    DefaultFixedRowHeight = 32
-    Selection.AlphaBlend = False
-    Selection.TransparentColor = False
-    FrozenCol = 0
-    FrozenRow = 0
-    OnGetCellText = zgSelectProjectGetCellText
-    OnSetCellText = zgSelectProjectSetCellText
-    OnCellTextChanged = zgSelectProjectCellTextChanged
-    OnDrawCellText = zgSelectProjectDrawCellText
-  end
-  object zgResult: TZJGrid
-    Left = 451
-    Top = 24
-    Width = 360
-    Height = 457
-    OptionsEx = []
-    ColCount = 2
-    RowCount = 1
-    ShowGridLine = False
-    DefaultColWidth = 308
-    DefaultFixedColWidth = 25
-    DefaultFixedRowHeight = 32
-    Selection.AlphaBlend = False
-    Selection.TransparentColor = False
-    FrozenCol = 0
-    FrozenRow = 0
-    OnGetCellText = zgResultGetCellText
-    OnSetCellText = zgResultSetCellText
-  end
   object btnOk: TButton
-    Left = 649
-    Top = 489
+    Left = 660
+    Top = 492
     Width = 74
     Height = 25
     Caption = #30830' '#23450
-    TabOrder = 2
+    TabOrder = 0
     OnClick = btnOkClick
   end
   object btnCancel: TButton
-    Left = 736
-    Top = 489
+    Left = 747
+    Top = 492
     Width = 74
     Height = 25
     Caption = #21462' '#28040
     ModalResult = 2
-    TabOrder = 3
+    TabOrder = 1
   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
-      item
-        Title.Caption = #35745#37327#26399#25968
-        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 = 'PhaseCount'
-        Width = 35
-        ReadOnly = True
-      end
-      item
-        Title.Caption = #23457#25209#29366#24577
-        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 = 'AuditStatus'
-        Width = 35
-        ReadOnly = False
-      end>
-    Grid = zgSelectProject
-    ExtendRowCount = 0
-    Options = [aoAllowEdit]
-    AutoExpand = True
-    TreeCellCol = 2
-    KeyFieldName = 'ID'
-    ParentFieldName = 'ParentID'
-    NextSiblingFieldName = 'NextSiblingID'
-    TreeOptions = []
-    TopLevelBold = True
-    Left = 120
-    Top = 160
+  object pnlTop: TPanel
+    Left = 8
+    Top = 8
+    Width = 816
+    Height = 473
+    BevelOuter = bvNone
+    TabOrder = 2
   end
 end

ProjGather/ProjGatherSelectFrm.pas

@@ -3,55 +3,22 @@ unit ProjGatherSelectFrm;
 interface
 
 uses
+  ProjGatherSelectFme,
   sdIDTree, sdDB,
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
-  Dialogs, sdGridDBA, sdGridTreeDBA, StdCtrls, ZJGrid, ZJCells;
+  Dialogs, sdGridDBA, sdGridTreeDBA, StdCtrls, ZJGrid, ZJCells, ExtCtrls;
 
 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);
+    pnlTop: TPanel;
     procedure btnOkClick(Sender: TObject);
-    procedure zgSelectProjectDrawCellText(ACanvas: TCanvas;
-      const ARect: TRect; const ACoord: TPoint; AGrid: TZJGrid;
-      const Text: String; var ADefaultDraw: Boolean);
-    procedure zgResultGetCellText(Sender: TObject; const ACoord: TPoint;
-      var Value: String; DisplayText: Boolean);
-    procedure zgResultSetCellText(Sender: TObject; const ACoord: TPoint;
-      var Value: String; DisplayText: Boolean);
   private
-    FProjectID: Integer;
-    FValidProjs: TList;
-    FSelectProjs: TList;
-    FSpecialProjTypes: TStrings;
-    FSpecialProjIDs: array of Integer;
+    FSelectFrame: TProjGatherSelectFrame;
 
-    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);
+    FBeginPhaseIndex: Integer;
+    FEndPhaseIndex: Integer;
 
     procedure RefreshDiffWindows;
   public
@@ -61,24 +28,24 @@ type
     procedure AssignResult(AProjs: TList);
   end;
 
-function SelectGatherProject(AProjectID: Integer; AOrgProjs, ANewProjs: TList; ASpecialProjTypes: TStrings = nil): Boolean;
+function SelectGatherProject(AProjectID: Integer; AProjs: TList; ASpecialProjTypes: TStrings = nil): Boolean;
 
 implementation
 
 uses
-  Globals, GatherProjInfo, MainFrm, Math, ZhAPI;
+  UtilMethods;
 
 {$R *.dfm}
 
-function SelectGatherProject(AProjectID: Integer; AOrgProjs, ANewProjs: TList; ASpecialProjTypes: TStrings = nil): Boolean;
+function SelectGatherProject(AProjectID: Integer; AProjs: TList; ASpecialProjTypes: TStrings = nil): Boolean;
 var
   vSelectFrm: TProjGatherSelectForm;
 begin
-  vSelectFrm := TProjGatherSelectForm.Create(AProjectID, AOrgProjs, ASpecialProjTypes);
+  vSelectFrm := TProjGatherSelectForm.Create(AProjectID, AProjs, ASpecialProjTypes);
   try
     Result := vSelectFrm.ShowModal = mrOk;
     if Result then
-      vSelectFrm.AssignResult(ANewProjs);
+      vSelectFrm.AssignResult(AProjs);
   finally
     vSelectFrm.Free;
   end;
@@ -86,346 +53,41 @@ 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; ASpecialProjTypes: TStrings);
-var
-  i: Integer;
 begin
   inherited Create(nil);
-  RefreshDiffWindows;
-  FProjectID := AProjectID;
-  FSpecialProjTypes := ASpecialProjTypes;
-  if FSpecialProjTypes <> nil then
-  begin
-    SetLength(FSpecialProjIDs, FSpecialProjTypes.Count);
-    for i := 0 to ASpecialProjTypes.Count - 1 do
-      FSpecialProjIDs[i] := -1;
-  end;
-
-  FValidProjs := TList.Create;
-  // 取消过滤
-  //FilterValidProject;
-  //ProjectManager.sdvProjectsSpare.OnFilterRecord := DoOnFilterRecord;
-  ProjectManager.sdvProjectsSpare.Filtered := True;
 
-  stdSelectProject.DataView := ProjectManager.sdvProjectsSpare;
+  FSelectFrame := TProjGatherSelectFrame.Create(AProjectID, ASpecialProjTypes);
+  AlignControl(FSelectFrame, pnlTop, alClient);
+  FSelectFrame.LoadHistorySelects(AProjs);
 
-  FSelectProjs := TList.Create;
-  LoadHistorySelects(AProjs);
-  AssignSelectTenders;
+  RefreshDiffWindows;
 end;
 
 destructor TProjGatherSelectForm.Destroy;
 begin
-  //ProjectManager.sdvProjectsSpare.Filtered := False;
-  //ProjectManager.sdvProjectsSpare.OnFilterRecord := nil;
-  FValidProjs.Free;
-  FSelectProjs.Free;
+  FSelectFrame.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;
-  i: Integer;
-begin
-  if FSelectProjs.IndexOf(Pointer(ANode.ID)) <> -1 then
-  begin
-    FSelectProjs.Remove(Pointer(ANode.id));
-    for i := Low(FSpecialProjIDs) to High(FSpecialProjIDs) do
-      if FSpecialProjIDs[i] = ANode.ID then
-        FSpecialProjIDs[i] := -1;
-  end;
-  for iChild := 0 to ANode.ChildCount - 1 do
-    RemoveProjs(ANode.ChildNodes[iChild]);
-end;
-
-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;
-  var
-    i: Integer;
-  begin
-    zgResult.ColCount := 2;
-    zgResult.RowCount := 1;
-    zgResult.Cells[1, 0].Text := '所选项目';
-    zgResult.ColWidths[1] := 308;
-    if Assigned(FSpecialProjTypes) then
-    begin
-      zgResult.ColWidths[1] := 308 - (Min(FSpecialProjTypes.Count, 2)*45);
-      for i := 0 to FSpecialProjTypes.Count - 1 do
-      begin
-        zgResult.ColCount := zgResult.ColCount + 1;
-        zgResult.Cells[2+i, 0].Text := FSpecialProjTypes.Strings[i];
-        zgResult.ColWidths[2+i] := 45;
-        zgResult.CellClass.Cols[2+i] := TZjCheckBoxCell;
-      end;
-    end;
-  end;
-  
-var
-  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;
-  vGatherProjInfo: TGatherProjInfo;
-begin
-  for i := 0 to AProjs.Count - 1 do
-  begin
-    vGatherProjInfo := TGatherProjInfo(AProjs.Items[i]);
-    FSelectProjs.Add(Pointer(vGatherProjInfo.ProjectID));
-    if Assigned(FSpecialProjTypes) then
-    begin
-      if (vGatherProjInfo.ProjType > 0) and (vGatherProjInfo.ProjType <= FSpecialProjTypes.Count) then
-        FSpecialProjIDs[vGatherProjInfo.ProjType-1] := vGatherProjInfo.ProjectID;
-    end;
-  end;
-end;
-
 procedure TProjGatherSelectForm.btnOkClick(Sender: TObject);
 begin
-  if zgResult.RowCount > 1 then
-    ModalResult := mrOk;
+  if FSelectFrame.zgResult.RowCount > 1 then
+    ModalResult := mrOk
+  else
+    WarningMessage('请勾选汇总项目。', Handle);
 end;
 
 procedure TProjGatherSelectForm.AssignResult(AProjs: TList);
-
-  function SpecialProjType(AID: Integer): Integer;
-  var
-    i: Integer;
-  begin
-    Result := 0;
-    for i := Low(FSpecialProjIDs) to High(FSpecialProjIDs) do
-    begin
-      if AID = FSpecialProjIDs[i] then
-      begin
-        Result := i+1;
-        Break;
-      end;
-    end;
-  end;
-
-var
-  iRow: Integer;
-  stnNode: TsdIDTreeNode;
-  vGatherProj: TGatherProjInfo;
-begin
-  AProjs.Clear;
-  for iRow := 1 to zgResult.RowCount - 1 do
-  begin
-    stnNode := TsdIDTreeNode(zgResult.Rows[iRow].Data);
-    vGatherProj := TGatherProjInfo.Create(stnNode, -1, SpecialProjType(stnNode.ID));
-    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;
-
-procedure TProjGatherSelectForm.zgResultGetCellText(Sender: TObject;
-  const ACoord: TPoint; var Value: String; DisplayText: Boolean);
 begin
-  if (ACoord.X > 1) and (ACoord.Y > 0) then
-  begin
-    if Assigned(zgResult.Rows[ACoord.Y].Data) and (TsdIDTreeNode(zgResult.Rows[ACoord.Y].Data).ID = FSpecialProjIDs[ACoord.X-2]) then
-      Value := 'True'
-    else
-      Value := 'False';
-  end;
-end;
-
-procedure TProjGatherSelectForm.zgResultSetCellText(Sender: TObject;
-  const ACoord: TPoint; var Value: String; DisplayText: Boolean);
-var
-  iProjID, i: Integer;
-  stnNode: TsdIDTreeNode;
-begin
-  if (ACoord.X > 1) and (ACoord.Y > 0) then
-  begin
-    stnNode := TsdIDTreeNode(zgResult.Rows[ACoord.Y].Data);
-    iProjID := stnNode.ID;
-    if FSpecialProjIDs[ACoord.X-2] <> iProjID then
-    begin
-      for i := Low(FSpecialProjIDs) to High(FSpecialProjIDs) do
-      begin
-        if FSpecialProjIDs[i] = iProjID then
-          FSpecialProjIDs[i] := -1
-      end;
-      FSpecialProjIDs[ACoord.X-2] := iProjID;
-    end
-    else
-      FSpecialProjIDs[ACoord.X-2] := -1;
-    for i := 0 to FSpecialProjTypes.Count - 1 do
-      zgResult.InvalidateCol(i+2);
-  end;
+  FSelectFrame.AssignResult(AProjs);
 end;
 
 procedure TProjGatherSelectForm.RefreshDiffWindows;
 begin
   ClientHeight := 523;
-  ClientWidth := 816;
+  ClientWidth := 827;
 end;
 
 end.

Report/ProjGather/Zone/rpgZoneGatherControl.pas

@@ -0,0 +1,69 @@
+unit rpgZoneGatherControl;
+
+interface
+
+uses
+  rpgGatherControl, ReportManager, ADODB, ProjectData, rpgGatherData;
+
+type
+  TrpgZoneGatherControl = class(TrpgGatherControl)
+  private
+    FHistoryBeginPhase: Integer;
+    FHistoryEndPhase: Integer;
+    FBeginPhase: Integer;
+    FEndPhase: Integer;
+  protected
+    function SelectProject: Boolean; override;
+    function SameSelect: Boolean; override;
+
+    procedure RefreshGather; override;
+  public
+    constructor Create(AProjectData: TProjectData); override;
+  end;
+
+implementation
+
+uses
+  rpgZoneProjGatherSelectFrm, ProjGather, Forms, Controls, Globals, ZhAPI;
+
+{ TrpgZoneGatherControl }
+
+constructor TrpgZoneGatherControl.Create(AProjectData: TProjectData);
+begin
+  inherited;
+  FBeginPhase := 0;
+  FEndPhase := 0;
+end;
+
+procedure TrpgZoneGatherControl.RefreshGather;
+var
+  Gather: TZoneProjGather;
+begin
+  Screen.Cursor := crHourGlass;
+  Gather := TZoneProjGather.Create(GatherData.WriteGatherData,
+    ReportConfig.XmjCompare, ReportConfig.GclCompare);
+  try
+    Gather.Gather(FSelectProjs, FBeginPhase, FEndPhase);
+    GatherData.LoadRelaData(ProjectData.ProjectID);
+    ClearObjects(FHistroyProjs);
+    FHistroyProjs.Assign(FSelectProjs);
+    FHistoryBeginPhase := FBeginPhase;
+    FHistoryEndPhase := FEndPhase;
+  finally
+    Gather.Free;
+    Screen.Cursor := crDefault;
+  end;
+end;
+
+function TrpgZoneGatherControl.SameSelect: Boolean;
+begin
+  Result := inherited SameSelect;
+  Result := Result and (FHistoryBeginPhase = FBeginPhase) and (FHistoryEndPhase = FEndPhase);
+end;
+
+function TrpgZoneGatherControl.SelectProject: Boolean;
+begin
+  Result := SelectGatherProject(ProjectData.ProjectID, FSelectProjs, FBeginPhase, FEndPhase);
+end;
+
+end.

Report/ProjGather/Zone/rpgZoneProjGatherSelectFrm.dfm

@@ -0,0 +1,103 @@
+object rpgZoneProjGatherSelectForm: TrpgZoneProjGatherSelectForm
+  Left = 484
+  Top = 217
+  BorderIcons = [biSystemMenu]
+  BorderStyle = bsSingle
+  Caption = #36873#25321#21306#38388#27719#24635#39033#30446
+  ClientHeight = 529
+  ClientWidth = 827
+  Color = clBtnFace
+  Font.Charset = ANSI_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -12
+  Font.Name = #23435#20307
+  Font.Style = []
+  OldCreateOrder = False
+  PixelsPerInch = 96
+  TextHeight = 12
+  object pnlTop: TPanel
+    Left = 7
+    Top = 8
+    Width = 816
+    Height = 456
+    BevelOuter = bvNone
+    TabOrder = 0
+  end
+  object pnlPhase: TPanel
+    Left = 5
+    Top = 469
+    Width = 816
+    Height = 22
+    BevelOuter = bvNone
+    TabOrder = 1
+    object lblPhase: TLabel
+      Left = 229
+      Top = 4
+      Width = 36
+      Height = 12
+      Caption = #26399#25968#25454
+    end
+    object lblPhaseHint: TLabel
+      Left = 279
+      Top = 5
+      Width = 48
+      Height = 12
+      Caption = #38169#35823#25552#31034
+      Font.Charset = ANSI_CHARSET
+      Font.Color = clRed
+      Font.Height = -12
+      Font.Name = #23435#20307
+      Font.Style = []
+      ParentFont = False
+      Visible = False
+    end
+    object leBeginPhaseIndex: TLabeledEdit
+      Left = 110
+      Top = 1
+      Width = 41
+      Height = 18
+      Ctl3D = False
+      EditLabel.Width = 102
+      EditLabel.Height = 12
+      EditLabel.Caption = #27719#24635#21306#38388#65306#27719#24635#33258' '
+      LabelPosition = lpLeft
+      ParentCtl3D = False
+      TabOrder = 0
+      OnChange = leBeginPhaseIndexChange
+      OnKeyPress = leBeginPhaseIndexKeyPress
+    end
+    object leEndPhaseIndex: TLabeledEdit
+      Left = 181
+      Top = 1
+      Width = 41
+      Height = 18
+      Ctl3D = False
+      EditLabel.Width = 24
+      EditLabel.Height = 12
+      EditLabel.Caption = ' '#33267' '
+      LabelPosition = lpLeft
+      ParentCtl3D = False
+      TabOrder = 1
+      OnChange = leBeginPhaseIndexChange
+      OnKeyPress = leBeginPhaseIndexKeyPress
+    end
+  end
+  object btnOk: TButton
+    Left = 659
+    Top = 500
+    Width = 74
+    Height = 24
+    Caption = #30830' '#23450
+    TabOrder = 2
+    OnClick = btnOkClick
+  end
+  object btnCancel: TButton
+    Left = 746
+    Top = 500
+    Width = 74
+    Height = 24
+    Caption = #21462' '#28040
+    ModalResult = 2
+    TabOrder = 3
+  end
+end

Report/ProjGather/Zone/rpgZoneProjGatherSelectFrm.pas

@@ -0,0 +1,160 @@
+unit rpgZoneProjGatherSelectFrm;
+
+interface
+
+uses
+  ProjGatherSelectFme,
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, ExtCtrls, StdCtrls;
+
+type
+  TrpgZoneProjGatherSelectForm = class(TForm)
+    pnlTop: TPanel;
+    pnlPhase: TPanel;
+    btnOk: TButton;
+    btnCancel: TButton;
+    leBeginPhaseIndex: TLabeledEdit;
+    leEndPhaseIndex: TLabeledEdit;
+    lblPhase: TLabel;
+    lblPhaseHint: TLabel;
+    procedure leBeginPhaseIndexKeyPress(Sender: TObject; var Key: Char);
+    procedure leBeginPhaseIndexChange(Sender: TObject);
+    procedure btnOkClick(Sender: TObject);
+  private
+    FSelectFrame: TProjGatherSelectFrame;
+    FError: Integer;
+
+    procedure CheckPhaseIndex;
+
+    procedure RefreshDiffWindows;
+
+    function GetBeginPhaseIndex: Integer;
+    function GetEndPhaseIndex: Integer;
+    procedure SetBeginPhaseIndex(const Value: Integer);
+    procedure SetEndPhaseIndex(const Value: Integer);
+  public
+    constructor Create(AProjectID: Integer; AProjs: TList);
+    destructor Destroy; override;
+
+    property BeginPhaseIndex: Integer read GetBeginPhaseIndex write SetBeginPhaseIndex;
+    property EndPhaseIndex: Integer read GetEndPhaseIndex write SetEndPhaseIndex;
+  end;
+
+function SelectGatherProject(AProjectID: Integer; AProjs: TList; var ABeginPhaseIndex, AEndPhaseIndex: Integer): Boolean;
+
+implementation
+
+uses
+  UtilMethods, Math;
+
+{$R *.dfm}
+
+function SelectGatherProject(AProjectID: Integer; AProjs: TList; var ABeginPhaseIndex, AEndPhaseIndex: Integer): Boolean;
+var
+  vForm: TrpgZoneProjGatherSelectForm;
+begin
+  vForm := TrpgZoneProjGatherSelectForm.Create(AProjectID, AProjs);
+  vForm.BeginPhaseIndex := ABeginPhaseIndex;
+  vForm.EndPhaseIndex := AEndPhaseIndex;
+  try
+    Result := vForm.ShowModal = mrOk;
+    if Result then
+    begin
+      ABeginPhaseIndex := vForm.BeginPhaseIndex;
+      AEndPhaseIndex := vForm.EndPhaseIndex;
+      vForm.FSelectFrame.AssignResult(AProjs);
+    end;
+  finally
+    vForm.Free;
+  end;
+end;
+
+constructor TrpgZoneProjGatherSelectForm.Create(AProjectID: Integer; AProjs: TList);
+begin
+  inherited Create(nil);
+
+  FSelectFrame := TProjGatherSelectFrame.Create(AProjectID, nil);
+  AlignControl(FSelectFrame, pnlTop, alClient);
+  FSelectFrame.LoadHistorySelects(AProjs);
+  FSelectFrame.AfterSelectProject := CheckPhaseIndex;
+
+  RefreshDiffWindows;
+end;
+
+destructor TrpgZoneProjGatherSelectForm.Destroy;
+begin
+  FSelectFrame.Free;
+  inherited;
+end;
+
+function TrpgZoneProjGatherSelectForm.GetBeginPhaseIndex: Integer;
+begin
+  Result := StrToIntDef(leBeginPhaseIndex.Text, -1);
+end;
+
+function TrpgZoneProjGatherSelectForm.GetEndPhaseIndex: Integer;
+begin
+  Result := StrToIntDef(leEndPhaseIndex.Text, -1);
+end;
+
+procedure TrpgZoneProjGatherSelectForm.leBeginPhaseIndexKeyPress(Sender: TObject; var Key: Char);
+begin
+  if not (Key in ['0'..'9', #8, #13]) then
+    Key := #0;
+end;
+
+procedure TrpgZoneProjGatherSelectForm.SetBeginPhaseIndex(const Value: Integer);
+begin
+  if (Value >= 0) and (Value <= 50) then
+    leBeginPhaseIndex.Text := IntToStr(Value)
+  else
+    leBeginPhaseIndex.Text := '';
+end;
+
+procedure TrpgZoneProjGatherSelectForm.SetEndPhaseIndex(const Value: Integer);
+begin
+  if (Value >= 0) and (Value <= 50) then
+    leEndPhaseIndex.Text := IntToStr(Value)
+  else
+    leEndPhaseIndex.Text := '';
+end;
+
+procedure TrpgZoneProjGatherSelectForm.leBeginPhaseIndexChange(
+  Sender: TObject);
+begin
+  CheckPhaseIndex;
+end;
+
+procedure TrpgZoneProjGatherSelectForm.CheckPhaseIndex;
+begin
+  FError := 0;
+  if EndPhaseIndex < BeginPhaseIndex then
+    FError := 1
+  else if (EndPhaseIndex > 0) and (not FSelectFrame.CheckProjPhaseValid(EndPhaseIndex)) then
+    FError := 2
+  else
+    FSelectFrame.ClearMarkedProj;
+  lblPhaseHint.Visible := FError <> 0;
+  case FError of
+    1: lblPhaseHint.Caption := '截止期应大于起始期。';
+    2: lblPhaseHint.Caption := '标记为红色的标段，未达第'+ leEndPhaseIndex.Text +'期';
+  end;
+end;
+
+procedure TrpgZoneProjGatherSelectForm.RefreshDiffWindows;
+begin
+  ClientHeight := 529;
+  ClientWidth := 827;
+end;
+
+procedure TrpgZoneProjGatherSelectForm.btnOkClick(Sender: TObject);
+begin
+  case FError of
+    0: ModalResult := mrOk;
+    1: WarningMessage('截止期应大于起始期。');
+    2: if QuestMessageYesNo('部分选中标段未达第'+leEndPhaseIndex.Text+'期，是否继续汇总？', Handle) then
+         ModalResult := mrOk;
+  end;
+end;
+
+end.

Report/ProjGather/rProjGatherTables.pas

@@ -7,7 +7,7 @@ uses
 
 const
   SGatherProj = 'r_GatherProj';
-  tdGatherProj: array [0..7] of TScFieldDef =(
+  tdGatherProj: array [0..9] of TScFieldDef =(
     (FieldName: 'ID'; FieldType: ftInteger; Size: 0; Precision: 0; NotNull: True; PrimaryKey: True; ForceUpdate: False),
     // 标段类型
     (FieldName: 'ProjType'; FieldType: ftInteger; Size: 0; Precision: 0; NotNull: True; PrimaryKey: True; ForceUpdate: False),
@@ -17,6 +17,10 @@ const
     (FieldName: 'ProjectName'; FieldType: ftString; Size: 255; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
     // 标段 -- 期数
     (FieldName: 'PhaseCount'; FieldType: ftInteger; Size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 标段 -- 区间开始期数
+    (FieldName: 'BeginPhaseIndex'; FieldType: ftInteger; Size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 标段 -- 区间结束期数（汇总期数）
+    (FieldName: 'EndPhaseIndex'; FieldType: ftInteger; Size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
     // 标段 -- 审核状态
     (FieldName: 'AuditStatus'; FieldType: ftInteger; Size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
     // 标段 -- 父节点 -- 名称
@@ -68,10 +72,11 @@ const
   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
+
   // 此部分数据不汇总至r_Bills_Gather
   SBills_SProj = 'r_Bills_SProj';
 
-  tdBills_Calc: array [0..74] of TScFieldDef =(
+  tdBills_Calc: array [0..83] of TScFieldDef =(
     // 与Bills表ID对应
     (FieldName: 'ID'; FieldType: ftInteger; Size: 0; Precision: 0; NotNull: True; PrimaryKey: True; ForceUpdate: False),
     // 对应于r_GatherProj中的ID字段
@@ -242,7 +247,27 @@ const
     // 截止本期完成 -- 金额
     (FieldName: 'EndGatherTotalPrice'; FieldType: ftDouble; Size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
     // 截止本期完成 -- 金额 -- 重算
-    (FieldName: 'EndGatherTotalPrice_Rc'; FieldType: ftDouble; Size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False)
+    (FieldName: 'EndGatherTotalPrice_Rc'; FieldType: ftDouble; Size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    //--9
+
+    // 区间 -- 合同 -- 数量
+    (FieldName: 'ZoneDealQuantity'; FieldType: ftDouble; Size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 区间 -- 合同 -- 金额
+    (FieldName: 'ZoneDealTotalPrice'; FieldType: ftDouble; Size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 区间 -- 合同 -- 金额 -- 重算
+    (FieldName: 'ZoneDealTotalPrice_Rc'; FieldType: ftDouble; Size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 区间 -- 变更 -- 数量
+    (FieldName: 'ZoneQcQuantity'; FieldType: ftDouble; Size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 区间 -- 变更 -- 金额
+    (FieldName: 'ZoneQcTotalPrice'; FieldType: ftDouble; Size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 区间 -- 变更 -- 金额 -- 重算
+    (FieldName: 'ZoneQcTotalPrice_Rc'; FieldType: ftDouble; Size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 区间 -- 完成 -- 数量
+    (FieldName: 'ZoneGatherQuantity'; FieldType: ftDouble; Size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 区间 -- 完成 -- 金额
+    (FieldName: 'ZoneGatherTotalPrice'; FieldType: ftDouble; Size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 区间 -- 完成 -- 金额 -- 重算
+    (FieldName: 'ZoneGatherTotalPrice_Rc'; FieldType: ftDouble; Size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False)
     //--9
   );
 

Report/ProjGather/rpgBillsCalcDm.pas

@@ -128,6 +128,16 @@ begin
   Rec.ValueByName('EndGatherTotalPrice').AsFloat := AProjCalc.EndMeasure.Gather.TotalPrice;
   Rec.ValueByName('EndGatherTotalPrice_Rc').AsFloat := AProjCalc.EndMeasure.Gather.TotalPrice_Rc;
 
+  Rec.ValueByName('ZoneDealQuantity').AsFloat := AProjCalc.ZoneMeasure.Deal.Quantity;
+  Rec.ValueByName('ZoneDealTotalPrice').AsFloat := AProjCalc.ZoneMeasure.Deal.TotalPrice;
+  Rec.ValueByName('ZoneDealTotalPrice_Rc').AsFloat := AProjCalc.ZoneMeasure.Deal.TotalPrice_Rc;
+  Rec.ValueByName('ZoneQcQuantity').AsFloat := AProjCalc.ZoneMeasure.Qc.Quantity;
+  Rec.ValueByName('ZoneQcTotalPrice').AsFloat := AProjCalc.ZoneMeasure.Qc.TotalPrice;
+  Rec.ValueByName('ZoneQcTotalPrice_Rc').AsFloat := AProjCalc.ZoneMeasure.Qc.TotalPrice_Rc;
+  Rec.ValueByName('ZoneGatherQuantity').AsFloat := AProjCalc.ZoneMeasure.Gather.Quantity;
+  Rec.ValueByName('ZoneGatherTotalPrice').AsFloat := AProjCalc.ZoneMeasure.Gather.TotalPrice;
+  Rec.ValueByName('ZoneGatherTotalPrice_Rc').AsFloat := AProjCalc.ZoneMeasure.Gather.TotalPrice_Rc;
+
   Rec.ValueByName('DgnQuantity1').AsFloat := AProjCalc.DgnQuantity1;
   Rec.ValueByName('DgnQuantity2').AsFloat := AProjCalc.DgnQuantity2;
   Rec.ValueByName('DealDgnQuantity1').AsFloat := AProjCalc.DealDgnQuantity1;

Report/ProjGather/rpgGatherControl.pas

@@ -12,24 +12,29 @@ type
     FProjectData: TProjectData;
     // 当前汇总的报表 -- 主要用于读取报表中的附加信息
     FTemplate: TTemplateNode;
-    FHistroyProjs: TList;
-    // 选择的汇总项目
-    FSelectProjs: TList;
     // 汇总数据
     FGatherData: TrpgGatherData;
 
-    function SelectProject: Boolean;
-    function SameSelect: Boolean;
-
     procedure CopyTables(const AFileName, ATableName: string);
     procedure CopyRelaData;
+  protected
+    FHistroyProjs: TList;
+    // 选择的汇总项目
+    FSelectProjs: TList;
 
-    procedure RefreshGather;
+    function SelectProject: Boolean; virtual;
+    function SameSelect: Boolean; virtual;
+
+    procedure RefreshGather; virtual;
   public
-    constructor Create(AProjectData: TProjectData);
+    constructor Create(AProjectData: TProjectData); virtual;
     destructor Destroy; override;
 
     function RefreshConnection(ATemplate: TTemplateNode): TADOConnection;
+
+    property ProjectData: TProjectData read FProjectData;
+    property Template: TTemplateNode read FTemplate;
+    property GatherData: TrpgGatherData read FGatherData;
   end;
 
 implementation
@@ -150,9 +155,9 @@ end;
 function TrpgGatherControl.SelectProject: Boolean;
 begin
   if FTemplate.IsExtra then
-    Result := SelectGatherProject(FProjectData.ProjectID, FHistroyProjs, FSelectProjs, FTemplate.InteractInfo.SpecialProjGatherTypes)
+    Result := SelectGatherProject(FProjectData.ProjectID, FSelectProjs, FTemplate.InteractInfo.SpecialProjGatherTypes)
   else
-    Result := SelectGatherProject(FProjectData.ProjectID, FHistroyProjs, FSelectProjs);
+    Result := SelectGatherProject(FProjectData.ProjectID, FSelectProjs);
 end;
 
 procedure TrpgGatherControl.CopyTables(const AFileName,

Report/ProjGather/rpgGatherData.pas

@@ -11,9 +11,6 @@ type
   private
     FGatherFile: string;
     FConnection: TADOConnection;
-    FQuery: TADOQuery;
-
-    procedure ExecuteSql(const ASql: string);
 
     procedure ClearHistoryData;
 
@@ -24,7 +21,6 @@ type
     procedure SaveBillsGatherCalc(ATree: TProjGatherTree);
     procedure SaveBillsProjCalc(ATree: TProjGatherTree; AProjIndex: Integer);
     procedure SaveBillsSpecialProjCalc(ATree: TProjGatherTree; AProjType: Integer);
-    procedure SaveGatherData(AGather: TProjGather);
 
     procedure CalcDgnData(const ATableName: string);
     procedure CalcOtherData(AProjCount, ASProjCount: Integer);
@@ -34,6 +30,7 @@ type
     function GetCurSpecialProjCount: Integer;
   protected
     procedure AddTables(AProjCount, ASProjCount: Integer; AUpdater: TScUpdater); virtual;
+    procedure SaveGatherData(AGather: TProjGather); virtual;
   public
     constructor Create;
     destructor Destroy; override;
@@ -94,9 +91,9 @@ const
          '  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]));
+  ExecuteSql(FConnection, Format(sFinalDgn, [ATableName]));
+  ExecuteSql(FConnection, Format(sDgnPrice1_2, [ATableName]));
+  ExecuteSql(FConnection, Format(sDgn, [ATableName]));
 end;
 
 procedure TrpgGatherData.CalcOtherData(AProjCount, ASProjCount: Integer);
@@ -126,7 +123,7 @@ begin
       if Pos('r_', FTableList.Strings[iIndex]) = 1 then
       begin
         sDeleteTableSql := Format('Drop Table %s', [FTableList.Strings[iIndex]]);
-        ExecuteSql(sDeleteTableSql);
+        ExecuteSql(FConnection, sDeleteTableSql);
       end;
       Inc(iIndex);
     end;
@@ -144,9 +141,6 @@ begin
   FConnection.LoginPrompt := False;
   FConnection.ConnectionString := Format(SAdoConnectStr, [FGatherFile]);
   FConnection.Open;
-
-  FQuery := TADOQuery.Create(nil);
-  FQuery.Connection := FConnection;
 end;
 
 procedure TrpgGatherData.CreateDataTables(AProjCount, ASProjCount: Integer);
@@ -166,31 +160,12 @@ end;
 
 destructor TrpgGatherData.Destroy;
 begin
-  FQuery.Free;
   FConnection.Free;
   if FileExists(FGatherFile) then
     DeleteFile(FGatherFile);
   inherited;
 end;
 
-procedure TrpgGatherData.ExecuteSql(const ASql: string);
-var
-  vQuery: TADOQuery;
-begin
-  vQuery := TADOQuery.Create(nil);
-  try
-    vQuery.Connection := FConnection;
-    vQuery.SQL.Add(ASql);
-    vQuery.ExecSQL;
-  finally
-    vQuery.Free;
-  end;
-
-  {FQuery.SQL.Clear;
-  FQuery.SQL.Add(ASql);
-  FQuery.ExecSQL;}
-end;
-
 function TrpgGatherData.GetCurSpecialProjCount: Integer;
 var
   sgsTables: TStringList;
@@ -225,7 +200,7 @@ begin
     sFileName := GetTempFileName;
     vProjectData.SaveTempDataBaseFile(sFileName);
 
-    ExecuteSql(Format(sCopyProperty, [sFileName]));
+    ExecuteSql(FConnection, Format(sCopyProperty, [sFileName]));
   finally
     if FileExists(sFileName) then
       DeleteFile(sFileName);
@@ -294,7 +269,7 @@ begin
   for iProj := 0 to AGather.CommonProj.Count - 1 do
   begin
     SaveBillsProjCalc(AGather.Tree, iProj);
-    ExecuteSql(Format(sInsert, [SBills_TransProj, SBills_Proj+IntToStr(iProj+1)]));
+    ExecuteSql(FConnection, Format(sInsert, [SBills_TransProj, SBills_Proj+IntToStr(iProj+1)]));
   end;
   for iProj := 0 to AGather.Tree.SpecialProjCount - 1 do
     SaveBillsSpecialProjCalc(AGather.Tree, iProj+1);
@@ -319,7 +294,7 @@ var
   iProj: Integer;
 begin
   for iProj := 0 to AProjCount - 1 do
-    ExecuteSql(Format(sInsert, [SBills_TransProj, SBills_Proj+IntToStr(iProj+1)]));
+    ExecuteSql(FConnection, Format(sInsert, [SBills_TransProj, SBills_Proj+IntToStr(iProj+1)]));
 end;
 
 procedure TrpgGatherData.UpdateDataBase(ASpecialProjTypes: TStrings);
@@ -394,7 +369,7 @@ begin
     end;
 
     for iProj := iSpecialProjCount to ASpecialProjTypes.Count - 1 do
-      ExecuteSql(Format(sUpdateSql, [SBills_SProj+IntToStr(iProj+1), -3, iProj+1]));
+      ExecuteSql(FConnection, Format(sUpdateSql, [SBills_SProj+IntToStr(iProj+1), -3, iProj+1]));
   end;
 end;
 

Report/ProjGather/rpgGatherProjDm.dfm

@@ -36,7 +36,14 @@ object rpgGatherProjData: TrpgGatherProjData
       6D65060B4175646974537461747573094669656C644E616D65060B4175646974
       5374617475730844617461547970650203084461746153697A6502040549734B
       6579080F4E65656450726F636573734E616D650909507265636973696F6E0200
-      0453697A6502000000}
+      0453697A6502000001044E616D65060F426567696E5068617365496E64657809
+      4669656C644E616D65060F426567696E5068617365496E646578084461746154
+      7970650203084461746153697A6502040549734B6579080F4E65656450726F63
+      6573734E616D650909507265636973696F6E02000453697A6502000001044E61
+      6D65060D456E645068617365496E646578094669656C644E616D65060D456E64
+      5068617365496E6465780844617461547970650203084461746153697A650204
+      0549734B6579080F4E65656450726F636573734E616D65090950726563697369
+      6F6E02000453697A6502000000}
   end
   object sdpGatherProj: TsdADOProvider
     Left = 56

Report/ReportConnection.pas

@@ -3,7 +3,7 @@ unit ReportConnection;
 interface
 
 uses
-  ADODB, ProjectData, ReportManager, rpgGatherControl;
+  ADODB, ProjectData, ReportManager, rpgGatherControl, rpgZoneGatherControl;
 
 type
   TReportConnection = class
@@ -11,6 +11,7 @@ type
     FProjectData: TProjectData;
     FConnection: TADOConnection;
     FCommonGather: TrpgGatherControl;
+    FZoneGather: TrpgZoneGatherControl;
   public
     constructor Create(AProjectData: TProjectData);
     destructor Destroy; override;
@@ -28,12 +29,14 @@ constructor TReportConnection.Create(AProjectData: TProjectData);
 begin
   FProjectData := AProjectData;
   FCommonGather := TrpgGatherControl.Create(AProjectData);
+  FZoneGather := TrpgZoneGatherControl.Create(AProjectData);
   FConnection := AProjectData.ADOConnection;
 end;
 
 destructor TReportConnection.Destroy;
 begin
   FCommonGather.Free;
+  FZoneGather.Free;
   inherited;
 end;
 
@@ -42,6 +45,7 @@ begin
   case ATemplate.DataBaseFlag of
     0: FConnection := FProjectData.ADOConnection;
     1: FConnection := FCommonGather.RefreshConnection(ATemplate);
+    2: FConnection := FZoneGather.RefreshConnection(ATemplate);
   end;
 end;
 

Units/ProjectData.pas

@@ -135,6 +135,8 @@ type
     procedure OpenForGather(const AFileName: string; APhaseIndex: Integer = -1);
     //-----------------------  End ---ºǫ́´ò¿ª ------------------------
 
+    // 
+
     procedure SaveDebugFile(const AFileName: string);
     procedure SaveTempDataBaseFile(const AFileName: string);
 

Units/mDataRecord.pas

@@ -491,7 +491,6 @@ type
     property TotalPrice13 : TsdValue read FTotalPrice0;
     property Quantity14: TsdValue read FQuantity0;
     property TotalPrice14 : TsdValue read FTotalPrice0;
-
   end;
 
 implementation