Measure/SubTenderGather/stgGather.pas

unit stgGather;

interface

uses
  Classes, stgGatherCacheData, ProjectData, BillsTree, sdIDTree;

type
  TProgramHintEvent = procedure (const ATenderName: string) of Object;

  TstgSumBaseFileLoader = class
  private
    FTree: TstgGatherTree;
    FSumBaseFile: string;
    FTempFolder: string;
    FFileName: string;
    FProjectData: TProjectData;

    procedure LoadFileName;
    function LoadTreeNodeData(ANode: TBillsIDTreeNode; AParent: TstgGatherTreeNode): TstgGatherTreeNode;
    procedure LoadSumBaseTreeNode(ANode: TsdIDTreeNode; AParent: TstgGatherTreeNode);
  public
    constructor Create(ATree: TstgGatherTree; const ASumBaseFile: string);
    destructor Destroy; override;

    procedure LoadData;
  end;

  TstgSubTenderFileGather = class
  private
    FCacheData: TstgGatherCacheData;
    FProjectData: TProjectData;
    FCurSubTenderID: Integer;
    FLoadHint: TProgramHintEvent;
    procedure GatherDetailData(AGatherNode: TstgGatherTreeNode; ASourceNode: TMeasureBillsIDTreeNode);
    function GatherSubTenderTreeNodeData(ANode: TsdIDTreeNode; AParent: TstgGatherTreeNode): TstgGatherTreeNode;
    procedure GatherSubTenderTreeNode(ANode: TsdIDTreeNode; AParent: TstgGatherTreeNode);
    procedure GatherSubTender(ASubTenderID: Integer);
  public
    procedure GatherTo(AGatherCacheData: TstgGatherCacheData; ASubTenders: TList);

    property LoadHint: TProgramHintEvent read FLoadHint write FLoadHint;
  end;

  TstgErrorChecker = class
  private
    FCacheData: TstgGatherCacheData;

    procedure NewError(ANode: TstgGatherTreeNode; AType: Integer);

    function SafeCheckParent(ANode, ACheckParent: TstgGatherTreeNode): TstgGatherTreeNode;

    // ACheckParent的子项(总包中存在)，存在与ANode同编号节点
    function HasSameCodeLevelChild(ANode: TstgGatherTreeNode;
      ACheckParent: tstgGatherTreeNode = nil): Boolean;
    // ACheckParent的子项(总包中存在)，存在与ANode同编号、名称、单位，但不同层次节点
    function HasSameChildWithDiffLevel(ANode: TstgGatherTreeNode;
      ACheckParent: TstgGatherTreeNode = nil): Boolean;
    // ACheckParent的子项(总包中存在)(含子项的子项)，存在与ANode同编号节点
    // 子项（含子项的子项），存在与CheckParent的子项(总包中存在)同编号节点

    function HasShortRelaCodeChild(ANode: TstgGatherTreeNode): Boolean;
    function HasLongRelaCodeChild(ANode:TstgGatherTreeNode): Boolean;
    function HasXmjChildWithSameCodeChild(ANode: TstgGatherTreeNode): Boolean;

    procedure AddXmjError(ANode: TstgGatherTreeNode);
    procedure AddGclError(ANode: TstgGatherTreeNode);

    procedure AddError(ANode: TstgGatherTreeNode);
  public
    procedure Check(AGatherCacheData: TstgGatherCacheData);
  end;

implementation

uses Math, Globals, mDataRecord, UtilMethods, SysUtils, XMLDoc, XMLIntf,
  CacheTree;

{ TstgSumBaseFileLoader }

constructor TstgSumBaseFileLoader.Create(ATree: TstgGatherTree;
  const ASumBaseFile: string);
begin
  FTree := ATree;
  FSumBaseFile := ASumBaseFile;
  FTempFolder := GenerateTempFolder(GetTempFilePath);
  FProjectData := TProjectData.Create;
end;

destructor TstgSumBaseFileLoader.Destroy;
begin
  if FileExists(FTempFolder) then
    DeleteFolder(FTempFolder);
  if Assigned(FProjectData) then
    FProjectData.Free;
  inherited;
end;

procedure TstgSumBaseFileLoader.LoadData;
begin
  UnZipFile(FSumBaseFile, FTempFolder);
  LoadFileName;
  FProjectData.OpenForSumUpBase(FTempFolder + '\' + FFileName);
  LoadSumBaseTreeNode(FProjectData.BillsCompileData.BillsCompileTree.FirstNode, nil);
  FTree.MarkLeafXmj;
end;

procedure TstgSumBaseFileLoader.LoadFileName;
var
  FXmlDocument: IXMLDocument;
  RootXmlNode, InfoXmlNode: IXMLNode;
  ChildNodes: IXMLNodeList;
begin
  FXmlDocument := TXMLDocument.Create(nil) as IXMLDocument;
  try
    FXmlDocument.LoadFromFile(FTempFolder + '\Info.xml');
    FXmlDocument.Options := [doNodeAutoCreate,doNodeAutoIndent,doAutoPrefix,doNamespaceDecl];
    RootXmlNode := FXmlDocument.DocumentElement;

    ChildNodes := RootXmlNode.ChildNodes;
    InfoXmlNode := ChildNodes.FindNode('ProjectInfo');

    FFileName := InfoXmlNode.Attributes['FileName'];
  finally
    FXmlDocument := nil;
  end;
end;

procedure TstgSumBaseFileLoader.LoadSumBaseTreeNode(ANode: TsdIDTreeNode; AParent: TstgGatherTreeNode);
var
  vCurGatherNode: TstgGatherTreeNode;
begin
  if not Assigned(ANode) then Exit;
  vCurGatherNode := LoadTreeNodeData(TBillsIDTreeNode(ANode), AParent);
  LoadSumBaseTreeNode(ANode.FirstChild, vCurGatherNode);
  LoadSumBaseTreeNode(ANode.NextSibling, AParent);
end;

function TstgSumBaseFileLoader.LoadTreeNodeData(ANode: TBillsIDTreeNode;
  AParent: TstgGatherTreeNode): TstgGatherTreeNode;
begin
  Result := FTree.AddSumBaseNode(AParent, ANode.ID);
  Result.Code := ANode.Rec.Code.AsString;
  Result.B_Code := ANode.Rec.B_Code.AsString;
  Result.Name := ANode.Rec.Name.AsString;
  Result.Units := ANode.Rec.Units.AsString;
  Result.IsLeaf := not ANode.HasChildren;
end;

{ TstgSubTenderFileGather }

procedure TstgSubTenderFileGather.GatherDetailData(
  AGatherNode: TstgGatherTreeNode; ASourceNode: TMeasureBillsIDTreeNode);
var
  vSubTender: TstgSubTenderStageData;
begin
  //if Assigned(ASourceNode.StageRec) and
  //   ((ASourceNode.StageRec.GatherQuantity.AsFloat <> 0) or (ASourceNode.StageRec.GatherTotalPrice.AsFloat <> 0)) then
  
  //if not ASourceNode.HasChildren then
  if (AGatherNode.IsSubTender) or (not ASourceNode.HasChildren) then
  begin
    vSubTender := AGatherNode.SafeSubTender(FCurSubTenderID);
    vSubTender.AddDetail(ASourceNode);
  end;
end;

procedure TstgSubTenderFileGather.GatherSubTender(ASubTenderID: Integer);
var
  vNode: TsdIDTreeNode;
begin
  FCurSubTenderID := ASubTenderID;
  vNode := ProjectManager.ProjectsTree.FindNode(ASubTenderID);
  if vNode.Rec.ValueByName('Type').AsInteger = 1 then
  begin;
    FLoadHint(vNode.Rec.ValueByName('Name').AsString);
    FProjectData := OpenProjectManager.FindProjectData(ASubTenderID);
    try
      if not Assigned(FProjectData) then
      begin
        FProjectData := TProjectData.Create;
        FProjectData.OpenForSumUpGather(GetMyProjectsFilePath + vNode.Rec.ValueByName('FileName').AsString);
      end;
      FCacheData.AddSubTender(vNode.Rec);
      GatherSubTenderTreeNode(FProjectData.BillsMeasureData.BillsMeasureTree.FirstNode, nil);
    finally
      if not Assigned(OpenProjectManager.FindProjectData(ASubTenderID)) then
        FProjectData.Free;
    end;
  end;
end;

procedure TstgSubTenderFileGather.GatherSubTenderTreeNode(
  ANode: TsdIDTreeNode; AParent: TstgGatherTreeNode);
var
  vCur: TstgGatherTreeNode;
begin
  if not Assigned(ANode) then Exit;
  vCur := GatherSubTenderTreeNodeData(ANode, AParent);
  GatherSubTenderTreeNode(ANode.FirstChild, vCur);
  GatherSubTenderTreeNode(ANode.NextSibling, AParent);
end;

function TstgSubTenderFileGather.GatherSubTenderTreeNodeData(
  ANode: TsdIDTreeNode; AParent: TstgGatherTreeNode): TstgGatherTreeNode;
var
  vNode: TMeasureBillsIDTreeNode;
  vNext: TstgGatherTreeNode;
begin
  vNode := TMeasureBillsIDTreeNode(ANode);
  if ANode.ID < 100 then
    Result := FCacheData.GatherTree.FindNode(ANode.ID)
  else
    Result := FCacheData.GatherTree.FindNode(AParent, vNode);

  if not Assigned(Result) then
  begin
    vNext := FCacheData.GatherTree.FindNextSibling(AParent, vNode.Rec.Code.AsString, vNode.Rec.B_Code.AsString);
    if not Assigned(AParent) or (not (AParent.IsSumBase and AParent.IsLeafXmj)) or (vNode.Rec.B_Code.AsString <> '') {or (not ANode.HasChildren)} then
    begin
      if ANode.ID < 100 then
        Result := FCacheData.GatherTree.AddSubTenderNode(AParent, vNext, ANode.ID)
      else
        Result := FCacheData.GatherTree.AddSubTenderNode(AParent, vNext);
      Result.Code := Trim(vNode.Rec.Code.AsString);
      Result.B_Code := Trim(vNode.Rec.B_Code.AsString);
      Result.Name := Trim(vNode.Rec.Name.AsString);
      Result.Units := Trim(vNode.Rec.Units.AsString);
      Result.IsLeaf := not vNode.HasChildren;
    end
    else
      Result := AParent;
  end;

  if Assigned(Result) then
    GatherDetailData(Result, vNode)
  else
    Result := AParent;
end;

procedure TstgSubTenderFileGather.GatherTo(AGatherCacheData: TstgGatherCacheData;
  ASubTenders: TList);
var
  i, iSubTenderID: Integer;
begin
  FCacheData := AGatherCacheData;
  for i := 0 to ASubTenders.Count - 1 do
    GatherSubTender(Integer(ASubTenders.Items[i]));
  FCacheData.GatherTree.CalculateAll;
end;

{ TstgErrorChecker }

procedure TstgErrorChecker.AddError(ANode: TstgGatherTreeNode);
begin
  if ANode.IsGclBills then
    AddGclError(ANode)
  else
    AddXmjError(ANode);
end;

procedure TstgErrorChecker.AddGclError(ANode: TstgGatherTreeNode);
begin
  if HasXmjChildWithSameCodeChild(ANode) then
    NewError(ANode, iErrorXmjLess)
  else if HasLongRelaCodeChild(ANode) then
    NewError(ANode, iErrorGclMore)
  else if HasShortRelaCodeChild(ANode) then
    NewError(ANode, iErrorGclLess)
  else if HasSameChildWithDiffLevel(ANode) then
    NewError(ANode, iErrorGclMore)
  else if HasSameCodeLevelChild(ANode) then
    NewError(ANode, iErrorGclDiff)
  else
    NewError(ANode, iErrorGclAdd);
end;

procedure TstgErrorChecker.AddXmjError(ANode: TstgGatherTreeNode);
begin
  if HasSameCodeLevelChild(ANode) then
    NewError(ANode, iErrorXmjDiff)
  else
    NewError(ANode, iErrorXmjAdd);
end;

procedure TstgErrorChecker.Check(AGatherCacheData: TstgGatherCacheData);
var
  i: Integer;
  vNode, vParent: TstgGatherTreeNode;
begin
  FCacheData := AGatherCacheData;
  for i := 0 to FCacheData.GatherTree.CacheNodes.Count - 1 do
  begin
    vNode := TstgGatherTreeNode(FCacheData.GatherTree.CacheNodes[i]);
    vParent := TstgGatherTreeNode(vNode.Parent);
    if vNode.IsSubTender and (not Assigned(vParent) or not vParent.IsSubTender) then
      AddError(vNode);
  end;
end;

function TstgErrorChecker.HasLongRelaCodeChild(
  ANode: TstgGatherTreeNode): Boolean;
var
  vParent, vChild: TstgGatherTreeNode;
  i: Integer;
begin
  Result := False;
  vParent := SafeCheckParent(ANode, nil);
  for i := 0 to vParent.Children.Count - 1 do
  begin
    vChild := TstgGatherTreeNode(vParent.Children.Items[i]);
    if (Pos(ANode.B_Code + '-', vChild.B_Code) = 1) and (vChild.IsSumBase) then
    begin
      Result := True;
      Break;
    end;
  end;
end;

function TstgErrorChecker.HasSameChildWithDiffLevel(ANode,
  ACheckParent: TstgGatherTreeNode): Boolean;
var
  vParent, vChild: TstgGatherTreeNode;
  i: Integer;
begin
  Result := False;
  vParent := SafeCheckParent(ANode, ACheckParent);
  for i := 0 to vParent.Children.Count - 1 do
  begin
    vChild := TstgGatherTreeNode(vParent.Children.Items[i]);
    if vChild.IsSumBase and (vChild.Code = ANode.Code) and
       (vChild.B_Code = ANode.B_Code) and (vChild.Name = ANode.Name) and
       (vChild.Units = ANode.Units) and (vChild.IsLeaf = vChild.IsLeaf) then
    begin
      Result := True;
      Break;
    end;
  end;
end;

function TstgErrorChecker.HasSameCodeLevelChild(ANode,
  ACheckParent: tstgGatherTreeNode): Boolean;
var
  vParent, vChild: TstgGatherTreeNode;
  i: Integer;
begin
  Result := False;
  vParent := SafeCheckParent(ANode, ACheckParent);
  for i := 0 to vParent.Children.Count - 1 do
  begin
    vChild := TstgGatherTreeNode(vParent.Children.Items[i]);
    if vChild.IsSumBase and (vChild.Code = ANode.Code) and (vChild.B_Code = ANode.B_Code) and (vChild.IsLeaf = vChild.IsLeaf) then
    begin
      Result := True;
      Break;
    end;
  end;
end;

function TstgErrorChecker.HasShortRelaCodeChild(
  ANode: TstgGatherTreeNode): Boolean;
var
  vParent, vChild: TstgGatherTreeNode;
  i: Integer;
begin
  Result := False;
  vParent := SafeCheckParent(ANode, nil);
  for i := 0 to vParent.Children.Count - 1 do
  begin
    vChild := TstgGatherTreeNode(vParent.Children.Items[i]);
    if (Pos(vChild.B_Code + '-', ANode.B_Code) = 1) and (vChild.IsSumBase) then
    begin
      Result := True;
      Break;
    end;
  end;
end;

function TstgErrorChecker.HasXmjChildWithSameCodeChild(
  ANode: TstgGatherTreeNode): Boolean;
var
  vParent, vChild: TstgGatherTreeNode;
  i: Integer;
begin
  Result := False;
  vParent := SafeCheckParent(ANode, nil);
  for i := 0 to vParent.Children.Count - 1 do
  begin
    vChild := TstgGatherTreeNode(vParent.Children.Items[i]);
    if not vChild.IsGclBills and ANode.IsGclBills and vChild.IsSumBase then
    begin
      Result := True;
      Break;
    end;
  end;
end;

procedure TstgErrorChecker.NewError(ANode: TstgGatherTreeNode;
  AType: Integer);

  procedure RecursiveNewError(AParent: TstgGatherTreeNode);
  var
    i: Integer;
  begin
    if AParent.Children.Count > 0 then
    begin
      for i := 0 to AParent.Children.Count - 1 do
        RecursiveNewError(TstgGatherTreeNode(AParent.Children.Items[i]));
    end
    else
      FCacheData.AddError(ANode, AParent, AType);
  end;

begin
  RecursiveNewError(ANode);
end;

function TstgErrorChecker.SafeCheckParent(ANode,
  ACheckParent: TstgGatherTreeNode): TstgGatherTreeNode;
begin
  if Assigned(ACheckParent) then
    Result := ACheckParent
  else if Assigned(ANode.Parent) then
    Result := TstgGatherTreeNode(ANode.Parent)
  else
    Result := TstgGatherTreeNode(FCacheData.GatherTree.Root);
end;

end.