unit rmBGBillsGatherDm; interface uses SysUtils, Classes, DB, DBClient, rmSelectProjectFrm, ProjectData, BillsTree, sdDB; type TBGBills = class private FIndexCode: string; FB_Code: string; FName: string; FUnits: string; FPrice: Double; FQuantity: Double; FTotalPrice: Double; FCurQuantity: Double; FCurTotalPrice: Double; FPreQuantity: Double; FPreTotalPrice: Double; FEndQuantity: Double; FEndTotalPrice: Double; procedure SetB_Code(const Value: string); function GetPercent: Double; public procedure Calcualte; property B_Code: string read FB_Code write SetB_Code; property IndexCode: string read FIndexCode; property Name: string read FName write FName; property Units: string read FUnits write FUnits; property Price: Double read FPrice write FPrice; property Quantity: Double read FQuantity write FQuantity; property TotalPrice: Double read FTotalPrice write FTotalPrice; property CurQuantity: Double read FCurQuantity write FCurQuantity; property CurTotalPrice: Double read FCurTotalPrice; property PreQuantity: Double read FPreQuantity write FPreQuantity; property PreTotalPrice: Double read FPreTotalPrice; property EndQuantity: Double read FEndQuantity; property EndTotalPrice: Double read FEndTotalPrice; property Percent: Double read GetPercent; end; TBGLData = class private FBGLCode: string; FBGBillsList: TList; function GetBGBills(AIndex: Integer): TBGBills; function GetBGBillsCount: Integer; public constructor Create(const ACode: string); destructor Destroy; override; function AddBGBills: TBGBills; function FindBGBills(const AB_Code: string): TBGBills; procedure Calculate; property BGLCode: string read FBGLCode; property BGBills[AIndex: Integer]: TBGBills read GetBGBills; property BGBillsCount: Integer read GetBGBillsCount; end; TTenderData = class private FSerialNo: Integer; FID: Integer; FName: String; FBGLs: TList; FTotalPrice: Double; FCurTotalPrice: Double; FPreTotalPrice: Double; FEndTotalPrice: Double; function GetBGLCount: Integer; function GetBGLData(AIndex: Integer): TBGLData; function GetPercent: Double; public constructor Create(ASerialNo, AID: Integer; const AName: string); destructor Destroy; override; procedure Calculate; function AddBGL(const ACode: string): TBGLData; function FindBGL(const ACode: string): TBGLData; property SerialNo: Integer read FSerialNo; property ID: Integer read FID; property Name: string read FName; property BGL[AIndex: Integer]: TBGLData read GetBGLData; property BGLCount: Integer read GetBGLCount; property TotalPrice: Double read FTotalPrice; property CurTotalPrice: Double read FCurTotalPrice; property PreTotalPrice: Double read FPreTotalPrice; property EndTotalPrice: Double read FEndTotalPrice; property Percent: Double read GetPercent; end; TGatherData = class private FTenders: TList; FTotalPrice: Double; FCurTotalPrice: Double; FPreTotalPrice: Double; FEndTotalPrice: Double; function GetTender(AIndex: Integer): TTenderData; function GetTenderCount: Integer; function GetPercent: Double; public constructor Create; destructor Destroy; override; function AddTender(AIndex, AID: Integer; const AName: string): TTenderData; procedure Calculate; property Tender[AIndex: Integer]: TTenderData read GetTender; property TenderCount: Integer read GetTenderCount; property TotalPrice: Double read FTotalPrice; property CurTotalPrice: Double read FCurTotalPrice; property PreTotalPrice: Double read FPreTotalPrice; property EndTotalPrice: Double read FEndTotalPrice; property Percent: Double read GetPercent; end; TrmBGBillsGatherData = class(TDataModule) cdsBGBills: TClientDataSet; cdsBGBillsTenderID: TIntegerField; cdsBGBillsPartID: TIntegerField; cdsBGBillsIndexCode: TWideStringField; cdsBGBillsB_Code: TWideStringField; cdsBGBillsName: TWideStringField; cdsBGBillsUnits: TWideStringField; cdsBGBillsPrice: TFloatField; cdsBGBillsQuantity: TFloatField; cdsBGBillsTotalPrice: TFloatField; cdsBGBillsCurQuantity: TFloatField; cdsBGBillsCurTotalPrice: TFloatField; cdsBGBillsPreQuantity: TFloatField; cdsBGBillsPreTotalPrice: TFloatField; cdsBGBillsEndQuantity: TFloatField; cdsBGBillsEndTotalPrice: TFloatField; cdsBGBillsPercent: TFloatField; cdsBGBillsBGLCode: TWideStringField; private FGatherData: TGatherData; FProjectName: string; FProjectData: TProjectData; procedure BeforeGather; procedure AfterGather; procedure OpenProjectData(AProject: TSelectProject; AProjectIndex: Integer); procedure FreeProjectData; procedure GatherBGBills(ABGL: TBGLData; ABGLID: Integer); procedure GatherBGL(ATenderData: TTenderData); procedure GatherMeasureData(ATenderData: TTenderData); procedure GatherProject(AProject: TSelectProject; AProjectIndex: Integer); procedure CalculateGatherData; procedure WriteData; public function AssignData(AProjects: TList): TDataSet; end; implementation uses ZhAPI, UtilMethods, DateUtils, Globals, BGLDm, mDataRecord; {$R *.dfm} { TGatherData } function TGatherData.AddTender(AIndex, AID: Integer; const AName: string): TTenderData; begin Result := TTenderData.Create(AIndex, AID, AName); FTenders.Add(Result); end; procedure TGatherData.Calculate; var i: Integer; begin FTotalPrice := 0; FCurTotalPrice := 0; FPreTotalPrice := 0; FEndTotalPrice := 0; for i := 0 to TenderCount - 1 do begin Tender[i].Calculate; FTotalPrice := FTotalPrice + Tender[i].TotalPrice; FCurTotalPrice := FCurTotalPrice + Tender[i].CurTotalPrice; FPreTotalPrice := FPreTotalPrice + Tender[i].PreTotalPrice; FEndTotalPrice := FEndTotalPrice + Tender[i].EndTotalPrice; end; end; constructor TGatherData.Create; begin FTenders := TList.Create; end; destructor TGatherData.Destroy; begin ClearObjects(FTenders); FTenders.Free; inherited; end; function TGatherData.GetPercent: Double; begin if FTotalPrice <> 0 then Result := CommonRoundTo(FEndTotalPrice / FTotalPrice * 100, -2) else Result := 0; end; function TGatherData.GetTender(AIndex: Integer): TTenderData; begin Result := TTenderData(FTenders[AIndex]); end; function TGatherData.GetTenderCount: Integer; begin Result := FTenders.Count; end; { TTenderData } function TTenderData.AddBGL(const ACode: string): TBGLData; begin Result := TBGLData.Create(ACode); FBGLs.Add(Result); end; procedure TTenderData.Calculate; var i, j: Integer; vBGL: TBGLData; begin FTotalPrice := 0; FPreTotalPrice := 0; FCurTotalPrice := 0; FEndTotalPrice := 0; for i := 0 to BGLCount - 1 do begin vBGL := BGL[i]; vBGL.Calculate; for j := 0 to vBGL.BGBillsCount - 1 do begin FTotalPrice := FTotalPrice + vBGL.BGBills[j].TotalPrice; FCurTotalPrice := FCurTotalPrice + vBGL.BGBills[j].CurTotalPrice; FPreTotalPrice := FPreTotalPrice + vBGL.BGBills[j].PreTotalPrice; FEndTotalPrice := FEndTotalPrice + vBGL.BGBills[j].EndTotalPrice; end; end; end; constructor TTenderData.Create(ASerialNo, AID: Integer; const AName: string); begin FSerialNo := ASerialNo; FID := AID; FName := AName; FBGLs := TList.Create; end; destructor TTenderData.Destroy; begin ClearObjects(FBGLs); FBGLs.Free; inherited; end; function TTenderData.FindBGL(const ACode: string): TBGLData; var i: Integer; begin Result := nil; for i := 0 to BGLCount - 1 do begin if (ACode = BGL[i].BGLCode) then begin Result := BGL[i]; Break; end; end; end; function TTenderData.GetBGLCount: Integer; begin Result := FBGLs.Count; end; function TTenderData.GetBGLData(AIndex: Integer): TBGLData; begin Result := TBGLData(FBGLs[AIndex]); end; function TTenderData.GetPercent: Double; begin if FTotalPrice <> 0 then Result := CommonRoundTo(FEndTotalPrice / FTotalPrice * 100, -2) else Result := 0; end; { TBGLData } function TBGLData.AddBGBills: TBGBills; begin Result := TBGBills.Create; FBGBillsList.Add(Result); end; procedure TBGLData.Calculate; var i: Integer; begin for i := 0 to BGBillsCount - 1 do BGBills[i].Calcualte; end; constructor TBGLData.Create(const ACode: string); begin FBGLCode := ACode; FBGBillsList := TList.Create; end; destructor TBGLData.Destroy; begin ClearObjects(FBGBillsList); FBGBillsList.Free; inherited; end; function TBGLData.FindBGBills(const AB_Code: string): TBGBills; var i: Integer; begin Result := nil; for i := 0 to BGBillsCount - 1 do begin if (AB_Code = BGBills[i].B_Code) then begin Result := BGBills[i]; Break; end; end; end; function TBGLData.GetBGBills(AIndex: Integer): TBGBills; begin Result := TBGBills(FBGBillsList[AIndex]); end; function TBGLData.GetBGBillsCount: Integer; begin Result := FBGBillsList.Count; end; { TrmBGBillsGatherData } procedure TrmBGBillsGatherData.AfterGather; begin cdsBGBills.EnableControls; FGatherData.Free; end; function TrmBGBillsGatherData.AssignData(AProjects: TList): TDataSet; var iProject: Integer; SelectProject: TSelectProject; begin BeforeGather; try for iProject := 0 to AProjects.Count - 1 do GatherProject(TSelectProject(AProjects.Items[iProject]), iProject); CalculateGatherData; WriteData; finally Result := cdsBGBills; AfterGather; end; end; procedure TrmBGBillsGatherData.BeforeGather; begin FGatherData := TGatherData.Create; cdsBGBills.DisableControls; cdsBGBills.Active := True; cdsBGBills.EmptyDataSet; end; procedure TrmBGBillsGatherData.CalculateGatherData; begin FGatherData.Calculate; end; procedure TrmBGBillsGatherData.FreeProjectData; begin if not Assigned(OpenProjectManager.FindProjectData(FProjectData.ProjectID)) then FProjectData.Free; end; procedure TrmBGBillsGatherData.GatherBGBills(ABGL: TBGLData; ABGLID: Integer); var vBGBills: TBGBills; begin with FProjectData.BGLData do begin cdsBGBills.Filter := 'BGID = ' + IntToStr(ABGLID); cdsBGBills.Filtered := True; try cdsBGBills.First; while not cdsBGBills.Eof do begin vBGBills := ABGL.AddBGBills; vBGBills.B_Code := cdsBGBillsB_Code.AsString; vBGBills.Name := cdsBGBillsName.AsString; vBGBills.Units := cdsBGBillsUnits.AsString; vBGBills.Price := cdsBGBillsPrice.AsFloat; vBGBills.Quantity := cdsBGBillsQuantity.AsFloat; vBGBills.TotalPrice := cdsBGBillsTotalPrice.AsFloat; cdsBGBills.Next; end; finally cdsBGBills.Filtered := False; end; end; end; procedure TrmBGBillsGatherData.GatherBGL(ATenderData: TTenderData); var vBGL: TBGLData; begin with FProjectData.BGLData do begin cdsBGL.First; while not cdsBGL.Eof do begin vBGL := ATenderData.AddBGL(cdsBGLCode.AsString); GatherBGBills(vBGL, cdsBGLID.AsInteger); cdsBGL.Next; end; end; end; procedure TrmBGBillsGatherData.GatherMeasureData(ATenderData: TTenderData); procedure GatherCur(ANode: TMeasureBillsIDTreeNode); var sgsCode, sgsNum: TStrings; i: Integer; sCode: string; fNumber: Double; vBGL: TBGLData; vBGBills: TBGBills; begin sgsCode := TStringList.Create; sgsNum := TStringList.Create; try sgsCode.Delimiter := ';'; sgsNum.Delimiter := ';'; sgsCode.DelimitedText := ANode.StageRec.QcBGLCode.AsString; sgsNum.DelimitedText := ANode.StageRec.QcBGLNum.AsString; for i := 0 to sgsCode.Count - 1 do begin sCode := sgsCode[i]; fNumber := StrToFloatDef(sgsNum[i], 0); vBGL := ATenderData.FindBGL(sCode); if Assigned(vBGL) then begin vBGBills := vBGL.FindBGBills(ANode.Rec.B_Code.AsString); if Assigned(vBGBills) then vBGBills.CurQuantity := vBGBills.CurQuantity + fNumber; end; end; finally sgsCode.Free; sgsNum.Free; end; end; procedure GatherPre(ANode: TMeasureBillsIDTreeNode); var sgsCode, sgsNum: TStrings; i: Integer; sCode: string; fNumber: Double; vBGL: TBGLData; vBGBills: TBGBills; begin sgsCode := TStringList.Create; sgsNum := TStringList.Create; try sgsCode.Delimiter := ';'; sgsNum.Delimiter := ';'; sgsCode.DelimitedText := ANode.StageRec.PreQcBGLCode.AsString; sgsNum.DelimitedText := ANode.StageRec.PreQcBGLNum.AsString; for i := 0 to sgsCode.Count - 1 do begin sCode := sgsCode[i]; fNumber := StrToFloatDef(sgsNum[i], 0); vBGL := ATenderData.FindBGL(sCode); if Assigned(vBGL) then begin vBGBills := vBGL.FindBGBills(ANode.Rec.B_Code.AsString); if Assigned(vBGBills) then vBGBills.PreQuantity := vBGBills.PreQuantity + fNumber; end; end; finally sgsCode.Free; sgsNum.Free; end; end; var i: Integer; vNode: TMeasureBillsIDTreeNode; begin for i := 0 to FProjectData.BillsMeasureData.BillsMeasureTree.Count - 1 do begin vNode := TMeasureBillsIDTreeNode(FProjectData.BillsMeasureData.BillsMeasureTree.Items[i]); if (vNode.HasChildren) or (not Assigned(vNode.StageRec)) then Continue; if (vNode.StageRec.QcBGLCode.AsString <> '') then GatherCur(vNode); if (vNode.StageRec.PreQcBGLCode.AsString <> '') then GatherPre(vNode); end; end; procedure TrmBGBillsGatherData.GatherProject(AProject: TSelectProject; AProjectIndex: Integer); var vTenderData: TTenderData; begin OpenProjectData(AProject, AProjectIndex); try vTenderData := FGatherData.AddTender(AProjectIndex, AProject.ProjectID, FProjectName); GatherBGL(vTenderData); GatherMeasureData(vTenderData); finally FreeProjectData; end; end; procedure TrmBGBillsGatherData.OpenProjectData(AProject: TSelectProject; AProjectIndex: Integer); var Rec: TsdDataRecord; begin FProjectData := OpenProjectManager.FindProjectData(AProject.ProjectID); Rec := ProjectManager.sddProjectsInfo.FindKey('idxID', AProject.ProjectID); if not Assigned(FProjectData) then begin FProjectData := TProjectData.Create; FProjectData.OpenForReport3(GetMyProjectsFilePath + Rec.ValueByName('FileName').AsString); end; FProjectName := Rec.ValueByName('Name').AsString; end; procedure TrmBGBillsGatherData.WriteData; procedure WriteBGLData(ATenderID: Integer; ABGL: TBGLData); var i: Integer; vBills: TBGBills; begin for i := 0 to ABGL.BGBillsCount - 1 do begin vBills := ABGL.BGBills[i]; cdsBGBills.Append; cdsBGBillsTenderID.AsInteger := ATenderID; cdsBGBillsPartID.AsInteger := 2; cdsBGBillsIndexCode.AsString := vBills.IndexCode; cdsBGBillsB_Code.AsString := vBills.B_Code; cdsBGBillsName.AsString := vBills.Name; cdsBGBillsUnits.AsString := vBills.Units; cdsBGBillsPrice.AsFloat := vBills.Price; cdsBGBillsQuantity.AsFloat := vBills.Quantity; cdsBGBillsTotalPrice.AsFloat := vBills.TotalPrice; cdsBGBillsCurQuantity.AsFloat := vBills.CurQuantity; cdsBGBillsCurTotalPrice.AsFloat := vBills.CurTotalPrice; cdsBGBillsPreQuantity.AsFloat := vBills.PreQuantity; cdsBGBillsPreTotalPrice.AsFloat := vBills.PreTotalPrice; cdsBGBillsEndQuantity.AsFloat := vBills.EndQuantity; cdsBGBillsEndTotalPrice.AsFloat := vBills.EndTotalPrice; cdsBGBillsPercent.AsFloat := vBills.Percent; cdsBGBillsBGLCode.AsString := ABGL.BGLCode; cdsBGBills.Post; end; end; procedure WriteTenderData(ATender: TTenderData); var iBGL: Integer; begin cdsBGBills.Append; cdsBGBillsTenderID.AsInteger := ATender.SerialNo; cdsBGBillsPartID.AsInteger := 1; cdsBGBillsName.AsString := ATender.Name; cdsBGBills.Post; for iBGL := 0 to ATender.BGLCount - 1 do WriteBGLData(ATender.SerialNo, ATender.BGL[iBGL]); cdsBGBills.Append; cdsBGBillsTenderID.AsInteger := ATender.SerialNo; cdsBGBillsPartID.AsInteger := 3; cdsBGBillsName.AsString := 'С¼Æ'; cdsBGBillsTotalPrice.AsFloat := ATender.TotalPrice; cdsBGBillsCurTotalPrice.AsFloat := ATender.CurTotalPrice; cdsBGBillsPreTotalPrice.AsFloat := ATender.PreTotalPrice; cdsBGBillsEndTotalPrice.AsFloat := ATender.EndTotalPrice; cdsBGBillsPercent.AsFloat := ATender.Percent; cdsBGBills.Post; end; procedure WriteGatherData; begin cdsBGBills.Append; cdsBGBillsTenderID.AsInteger := FGatherData.TenderCount + 1; cdsBGBillsName.AsString := 'ºÏ¼Æ'; cdsBGBillsTotalPrice.AsFloat := FGatherData.TotalPrice; cdsBGBillsCurTotalPrice.AsFloat := FGatherData.CurTotalPrice; cdsBGBillsPreTotalPrice.AsFloat := FGatherData.PreTotalPrice; cdsBGBillsEndTotalPrice.AsFloat := FGatherData.EndTotalPrice; cdsBGBillsPercent.AsFloat := FGatherData.Percent; cdsBGBills.Post; end; var i: Integer; begin for i := 0 to FGatherData.TenderCount - 1 do WriteTenderData(FGatherData.Tender[i]); WriteGatherData; end; { TBGBills } procedure TBGBills.Calcualte; begin FCurTotalPrice := FCurQuantity * FPrice; FPreTotalPrice := FPreQuantity * FPrice; FEndQuantity := FCurQuantity + FPreQuantity; FEndTotalPrice := FEndQuantity * FPrice; end; function TBGBills.GetPercent: Double; begin if FTotalPrice <> 0 then Result := CommonRoundTo(FEndTotalPrice / FTotalPrice * 100, -2) else Result := 0; end; procedure TBGBills.SetB_Code(const Value: string); begin FB_Code := Value; FIndexCode := B_CodeToIndexCode(FB_Code); end; end.