unit rmCustomized2Dm; // 广东肇庆定制 -- 汇总表(计量汇总表) // 严禁任何其他项目使用该单元 interface uses SysUtils, Classes, ZhAPI, DB, ProjectData, DBClient, rmSelectProjectFrm, sdDB; type TTenderBaseData = class private FTenderName: string; FTotalPrice: Double; FEndCTotalPrice: Double; FCurDealTotalPrice: Double; FPreDealTotalPrice: Double; FEndDealTotalPrice: Double; function GetEndGatherTotalPrice: Double; function GetPrecent: Double; public constructor Create(const ATenderName: string); property TenderName: string read FTenderName; property TotalPrice: Double read FTotalPrice write FTotalPrice; property EndCTotalPrice: Double read FEndCTotalPrice write FEndCTotalPrice; property EndGatherTotalPrice: Double read GetEndGatherTotalPrice; property CurDealTotalPrice: Double read FCurDealTotalPrice write FCurDealTotalPrice; property PreDealTotalPrice: Double read FPreDealTotalPrice write FPreDealTotalPrice; property EndDealTotalPrice: Double read FEndDealTotalPrice write FEndDealTotalPrice; property Precent: Double read GetPrecent; end; TDealPayData = class private FName: string; FCurTotalPrice: Double; FPreTotalPrice: Double; FEndTotalPrice: Double; public constructor Create(const AName: string); property Name: string read FName; property CurTotalPrice: Double read FCurTotalPrice write FCurTotalPrice; property PreTotalPrice: Double read FPreTotalPrice write FPreTotalPrice; property EndTotalPrice: Double read FEndTotalPrice write FEndTotalPrice; end; TGatherData = class private FTenders: TList; FTenderGather: TTenderBaseData; FDealPays: TList; FPayGather: TDealPayData; function FindDealPay(const AName: string): TDealPayData; function GetTenderCount: Integer; function GetTenders(AIndex: Integer): TTenderBaseData; function GetDealPay(AIndex: Integer): TDealPayData; function GetDealPayCount: Integer; public constructor Create; destructor Destroy; override; function AddTender(const ATenderName: string): TTenderBaseData; procedure GatherTender; function AddDealPay(const AName: string): TDealPayData; property TenderCount: Integer read GetTenderCount; property Tenders[AIndex: Integer]: TTenderBaseData read GetTenders; property TenderGather: TTenderBaseData read FTenderGather; property DealPayCount: Integer read GetDealPayCount; property DealPay[AIndex: Integer]: TDealPayData read GetDealPay; property PayGather: TDealPayData read FPayGather; end; TrmCustomized2Data = class(TDataModule) cdsCustom: TClientDataSet; cdsCustomSerialNo: TIntegerField; cdsCustomName: TWideStringField; cdsCustomTotalPrice: TFloatField; cdsCustomEndCTotalPrice: TFloatField; cdsCustomEndGatherTotalPrice: TFloatField; cdsCustomCurDealTotalPrice: TFloatField; cdsCustomPreDealTotalPrice: TFloatField; cdsCustomEndDealTotalPrice: TFloatField; cdsCustomPrecent: TFloatField; private FProjectData: TProjectData; FProjectName: string; FGatherData: TGatherData; FSerialNo: Integer; procedure BeforeGather; procedure AfterGather; procedure OpenProjectData(AProject: TSelectProject); procedure FreeProjectData; procedure GatherProject(AProject: TSelectProject); procedure WriteData; public function AssignData(AProjects: TList): TDataSet; end; implementation uses DealPaymentDm, PhasePayDm, Globals, UtilMethods; {$R *.dfm} { TTenderBaseData } constructor TTenderBaseData.Create(const ATenderName: string); begin FTenderName := ATenderName; FTotalPrice := 0; FEndCTotalPrice := 0; FCurDealTotalPrice := 0; FPreDealTotalPrice := 0; FEndDealTotalPrice := 0; end; function TTenderBaseData.GetEndGatherTotalPrice: Double; begin Result := TotalPrice + EndCTotalPrice; end; function TTenderBaseData.GetPrecent: Double; begin if EndGatherTotalPrice <> 0 then Result := EndDealTotalPrice/EndGatherTotalPrice*100 else Result := 0; end; { TGatherData } function TGatherData.AddDealPay(const AName: string): TDealPayData; begin Result := FindDealPay(AName); if not Assigned(Result) then begin Result := TDealPayData.Create(AName); FDealPays.Add(Result); end; end; function TGatherData.AddTender(const ATenderName: string): TTenderBaseData; begin Result := TTenderBaseData.Create(ATenderName); FTenders.Add(Result); end; constructor TGatherData.Create; begin FTenders := TList.Create; FTenderGather := TTenderBaseData.Create('合计'); FDealPays := TList.Create; FPayGather := TDealPayData.Create('支付'); end; destructor TGatherData.Destroy; begin FPayGather.Free; ClearObjects(FDealPays); FDealPays.Free; FTenderGather.Free; ClearObjects(FTenders); FTenders.Free; inherited; end; function TGatherData.FindDealPay(const AName: string): TDealPayData; var iIndex: Integer; begin Result := nil; for iIndex := 0 to DealPayCount - 1 do begin if SameText(AName, DealPay[iIndex].Name) then begin Result := DealPay[iIndex]; Break; end; end; end; procedure TGatherData.GatherTender; var iIndex: Integer; Tender: TTenderBaseData; begin FTenderGather.TotalPrice := 0; FTenderGather.EndCTotalPrice := 0; FTenderGather.CurDealTotalPrice := 0; FTenderGather.PreDealTotalPrice := 0; FTenderGather.EndDealTotalPrice := 0; for iIndex := 0 to FTenders.Count - 1 do begin Tender := Tenders[iIndex]; FTenderGather.TotalPrice := FTenderGather.TotalPrice + Tender.TotalPrice; FTenderGather.EndCTotalPrice := FTenderGather.EndCTotalPrice + Tender.FEndCTotalPrice; FTenderGather.CurDealTotalPrice := FTenderGather.CurDealTotalPrice + Tender.CurDealTotalPrice; FTenderGather.PreDealTotalPrice := FTenderGather.PreDealTotalPrice + Tender.PreDealTotalPrice; FTenderGather.EndDealTotalPrice := FTenderGather.EndDealTotalPrice + Tender.EndDealTotalPrice; end; end; function TGatherData.GetDealPay(AIndex: Integer): TDealPayData; begin Result := TDealPayData(FDealPays.Items[AIndex]); end; function TGatherData.GetDealPayCount: Integer; begin Result := FDealPays.Count; end; function TGatherData.GetTenderCount: Integer; begin Result := FTenders.Count; end; function TGatherData.GetTenders(AIndex: Integer): TTenderBaseData; begin Result := TTenderBaseData(FTenders.Items[AIndex]); end; { TDealPayData } constructor TDealPayData.Create(const AName: string); begin FName := AName; FCurTotalPrice := 0; FPreTotalPrice := 0; FEndTotalPrice := 0; end; { TrmCustomized2Data } procedure TrmCustomized2Data.AfterGather; begin FGatherData.Free; end; function TrmCustomized2Data.AssignData(AProjects: TList): TDataSet; var iProject: Integer; begin BeforeGather; try for iProject := 0 to AProjects.Count - 1 do GatherProject(TSelectProject(AProjects.Items[iProject])); FGatherData.GatherTender; WriteData; finally Result := cdsCustom; AfterGather; end; end; procedure TrmCustomized2Data.BeforeGather; begin cdsCustom.Active := True; cdsCustom.EmptyDataSet; FGatherData := TGatherData.Create; end; procedure TrmCustomized2Data.FreeProjectData; begin if not Assigned(OpenProjectManager.FindProjectData(FProjectData.ProjectID)) then FProjectData.Free; end; procedure TrmCustomized2Data.GatherProject(AProject: TSelectProject); var sCurField, sPreField, sEndField: string; function DealPayRecord(const AName: string): TsdDataRecord; var iRec: Integer; Rec: TsdDataRecord; begin Result := nil; with FProjectData.DealPaymentData do begin for iRec := 0 to sddDealPayment.RecordCount - 1 do begin Rec := sddDealPayment.Records[iRec]; if SameText(AName, Rec.ValueByName('Name').AsString) then begin Result := Rec; Break; end; end; end; end; procedure GatherBaseData; var TenderBase: TTenderBaseData; Rec, StageRec: TsdDataRecord; begin TenderBase := FGatherData.AddTender(FProjectName); TenderBase.TotalPrice := FProjectData.BillsData.Settlement[0]; TenderBase.EndCTotalPrice := FProjectData.BillsData.Settlement[2]; Rec := DealPayRecord('本期完成计量'); StageRec := FProjectData.PhaseData.PhasePayData.PayRecord(Rec.ValueByName('ID').AsInteger); TenderBase.CurDealTotalPrice := StageRec.ValueByName(sCurField).AsFloat; TenderBase.PreDealTotalPrice := StageRec.ValueByName(sPreField).AsFloat; TenderBase.EndDealTotalPrice := StageRec.ValueByName(sEndField).AsFloat; end; procedure GatherCommonDealPayData; var iRec: Integer; Rec, StageRec: TsdDataRecord; DealPay: TDealPayData; begin with FProjectData.DealPaymentData do begin for iRec := 0 to sddDealPayment.RecordCount - 1 do begin Rec := sddDealPayment.Records[iRec]; if SameText(Rec.ValueByName('Name').AsString, '本期完成计量') or SameText(Rec.ValueByName('Name').AsString, '本期应付') or SameText(Rec.ValueByName('Name').AsString, '本期实付') then Continue; StageRec := FProjectData.PhaseData.PhasePayData.PayRecord(Rec.ValueByName('ID').AsInteger); if StageRec.ValueByName(sEndField).AsFloat = 0 then Continue; DealPay := FGatherData.AddDealPay(Rec.ValueByName('Name').AsString); DealPay.CurTotalPrice := DealPay.CurTotalPrice + StageRec.ValueByName(sCurField).AsFloat; DealPay.PreTotalPrice := DealPay.PreTotalPrice + StageRec.ValueByName(sPreField).AsFloat; DealPay.EndTotalPrice := DealPay.EndTotalPrice + StageRec.ValueByName(sEndField).AsFloat; end; end; end; procedure GatherPayData; var Rec, StageRec: TsdDataRecord; begin Rec := DealPayRecord('本期应付'); StageRec := FProjectData.PhaseData.PhasePayData.PayRecord(Rec.ValueByName('ID').AsInteger); with FGatherData.PayGather do begin CurTotalPrice := CurTotalPrice + StageRec.ValueByName(sCurField).AsFloat; PreTotalPrice := PreTotalPrice + StageRec.ValueByName(sPreField).AsFloat; EndTotalPrice := EndTotalPrice + StageRec.ValueByName(sEndField).AsFloat; end; end; begin OpenProjectData(AProject); try sCurField := 'TotalPrice' + IntToStr(FProjectData.PhaseData.AuditCount); sPreField := 'PreTotalPrice' + IntToStr(FProjectData.PhaseData.AuditCount); sEndField := 'EndTotalPrice' + IntToStr(FProjectData.PhaseData.AuditCount); GatherBaseData; GatherCommonDealPayData; GatherPayData; finally FreeProjectData; end; end; procedure TrmCustomized2Data.OpenProjectData(AProject: TSelectProject); 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.OpenForReport2(GetMyProjectsFilePath + Rec.ValueByName('FileName').AsString); end; FProjectName := Rec.ValueByName('Name').AsString; end; procedure TrmCustomized2Data.WriteData; procedure WriteProjectData; var i: Integer; Tender: TTenderBaseData; begin for i := 0 to FGatherData.TenderCount - 1 do begin Tender := FGatherData.Tenders[i]; cdsCustom.Append; cdsCustomSerialNo.AsInteger := FSerialNo; cdsCustomName.AsString := Tender.TenderName; cdsCustomTotalPrice.AsFloat := Tender.TotalPrice; cdsCustomEndCTotalPrice.AsFloat := Tender.EndCTotalPrice; cdsCustomEndGatherTotalPrice.AsFloat := Tender.EndGatherTotalPrice; cdsCustomCurDealTotalPrice.AsFloat := Tender.CurDealTotalPrice; cdsCustomPreDealTotalPrice.AsFloat := Tender.PreDealTotalPrice; cdsCustomEndDealTotalPrice.AsFloat := Tender.EndDealTotalPrice; cdsCustomPrecent.AsFloat := Tender.Precent; cdsCustom.Post; Inc(FSerialNo); end; end; procedure WriteProjectGather; begin cdsCustom.Append; cdsCustomName.AsString := FGatherData.TenderGather.TenderName; cdsCustomTotalPrice.AsFloat := FGatherData.TenderGather.TotalPrice; cdsCustomEndCTotalPrice.AsFloat := FGatherData.TenderGather.EndCTotalPrice; cdsCustomEndGatherTotalPrice.AsFloat := FGatherData.TenderGather.EndGatherTotalPrice; cdsCustomCurDealTotalPrice.AsFloat := FGatherData.TenderGather.CurDealTotalPrice; cdsCustomPreDealTotalPrice.AsFloat := FGatherData.TenderGather.PreDealTotalPrice; cdsCustomEndDealTotalPrice.AsFloat := FGatherData.TenderGather.EndDealTotalPrice; cdsCustomPrecent.AsFloat := FGatherData.TenderGather.Precent; cdsCustom.Post; end; procedure WriteDealPays; var i: Integer; DealPay: TDealPayData; begin for i := 0 to FGatherData.DealPayCount - 1 do begin DealPay := FGatherData.DealPay[i]; cdsCustom.Append; cdsCustomSerialNo.AsInteger := FSerialNo; cdsCustomName.AsString := DealPay.Name; cdsCustomCurDealTotalPrice.AsFloat := DealPay.CurTotalPrice; cdsCustomPreDealTotalPrice.AsFloat := DealPay.PreTotalPrice; cdsCustomEndDealTotalPrice.AsFloat := DealPay.EndTotalPrice; cdsCustom.Post; Inc(FSerialNo); end; end; procedure WriteGatherPay; begin cdsCustom.Append; cdsCustomSerialNo.AsInteger := FSerialNo; cdsCustomName.AsString := FGatherData.PayGather.Name; cdsCustomCurDealTotalPrice.AsFloat := FGatherData.PayGather.CurTotalPrice; cdsCustomPreDealTotalPrice.AsFloat := FGatherData.PayGather.PreTotalPrice; cdsCustomEndDealTotalPrice.AsFloat := FGatherData.PayGather.EndTotalPrice; cdsCustom.Post; end; begin FSerialNo := 1; WriteProjectData; WriteProjectGather; WriteDealPays; WriteGatherPay; end; end.