unit ProjectGLDm; interface uses SysUtils, Classes, sdDB, sdProvider, ADODB, mDataRecord; type TProjectGLData = class(TDataModule) sdpProjectGL: TsdADOProvider; sddProjectGL: TsdDataSet; sdvProjectGL: TsdDataView; procedure sddProjectGLAfterAddRecord(ARecord: TsdDataRecord); procedure sddProjectGLBeforeValueChange(AValue: TsdValue; const NewValue: Variant; var Allow: Boolean); procedure sddProjectGLAfterValueChanged(AValue: TsdValue); procedure sdvProjectGLGetText(var Text: String; ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn; DisplayText: Boolean); procedure sddProjectGLGetRecordClass(var ARecordClass: TsdRecordClass); procedure sdvProjectGLSetText(var Text: String; ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn; var Allow: Boolean); private FProjectData: TObject; FTempGLs: TList; function CheckSameCode(ACode: Integer): Boolean; procedure LoadDetailGLs(AGLID: Integer); procedure CalculateDeltaPrice(ARec: TProjectGLRecord); procedure CalculatePrice; procedure CalculatePM_Quantity(ARec: TProjectGLRecord); procedure CalculatePM_TotalPrice(ARec: TProjectGLRecord); procedure CalculatePriceMargin; procedure CalculateRelaBills(ARec: TProjectGLRecord); procedure ExecuteSql(const ASql: string); procedure SaveGLPrice; procedure SavePM_CurData; function GetValidDeltaPrice(AID: Integer): Double; function GetPM_TotalPrice: Double; function GetActive: Boolean; public constructor Create(AProjectData: TObject); destructor Destroy; override; procedure Open(AConnection: TADOConnection); procedure Save; procedure LoadCurPhaseInfoPrice; procedure LoadStagePM_CalcData; procedure CalculateAll; procedure CalculateGL_PM(AGLID: Integer); procedure CalculateGLs_PM(ADetailGLs: TList); property ProjectData: TObject read FProjectData write FProjectData; property Active: Boolean read GetActive; property ValidDeltaPrice[AID: Integer]: Double read GetValidDeltaPrice; property PM_TotalPrice: Double read GetPM_TotalPrice; end; implementation uses ProjectData, UtilMethods, DB, Variants, PhaseData, DetailGLDm, BillsMeasureDm, BillsTree, sdIDTree, PhasePayDm, DateUtils; {$R *.dfm} { TProjectGLData } function TProjectGLData.CheckSameCode(ACode: Integer): Boolean; var Rec: TsdDataRecord; begin Rec := sddProjectGL.FindKey('idxCode', ACode); Result := Assigned(Rec); end; constructor TProjectGLData.Create(AProjectData: TObject); begin inherited Create(nil); FProjectData := AProjectData; FTempGLs := TList.Create; end; destructor TProjectGLData.Destroy; begin FTempGLs.Free; inherited; end; procedure TProjectGLData.LoadCurPhaseInfoPrice; const sSelectSql = 'Select * From GLPrice Where PhaseID = %d'; var sSql: string; vQuery: TADOQuery; procedure LoadInfoPrice; var iRec: Integer; Rec: TProjectGLRecord; begin for iRec := 0 to sddProjectGL.RecordCount - 1 do begin Rec := TProjectGLRecord(sddProjectGL.Records[iRec]); if vQuery.Active and vQuery.Locate('GLID', Rec.ValueByName('ID').AsInteger, []) then begin Rec.InfoPrice.AsFloat := vQuery.FieldByName('InfoPrice').AsFloat; Rec.InfoDate.AsString := vQuery.FieldByName('InfoDate').AsString; Rec.DeltaPrice.AsFloat := vQuery.FieldByName('DeltaPrice').AsFloat; Rec.ValidDeltaPrice.AsFloat := vQuery.FieldByName('ValidDeltaPrice').AsFloat; end else begin Rec.InfoPrice.AsFloat := 0; Rec.InfoDate.AsString := ''; Rec.DeltaPrice.AsFloat := 0; Rec.ValidDeltaPrice.AsFloat := 0; end; end; end; begin sddProjectGL.BeginUpdate; vQuery := TADOQuery.Create(nil); try vQuery.Connection := sdpProjectGL.Connection; sSql := Format(sSelectSql, [TProjectData(FProjectData).PhaseIndex]); vQuery.SQL.Clear; vQuery.SQL.Add(sSql); vQuery.Open; LoadInfoPrice; finally vQuery.Free; sddProjectGL.EndUpdate; end; end; procedure TProjectGLData.Open(AConnection: TADOConnection); begin sdpProjectGL.Connection := AConnection; sddProjectGL.Open; if not Assigned(sddProjectGL.IndexList.FindByName('idxID')) then sddProjectGL.AddIndex('idxID', 'ID'); if not Assigned(sddProjectGL.IndexList.FindByName('idxCode')) then sddProjectGL.AddIndex('idxCode', 'Code'); sdvProjectGL.Open; sdvProjectGL.IndexName := 'idxCode'; LoadCurPhaseInfoPrice; LoadStagePM_CalcData; end; procedure TProjectGLData.Save; begin sddProjectGL.Save; if not TProjectData(FProjectData).PriceMarginReadOnly then SaveGLPrice; if not TProjectData(FProjectData).StageDataReadOnly then SavePM_CurData; end; procedure TProjectGLData.SaveGLPrice; const sDeleteSql = 'Delete From GLPrice Where PhaseID = %d'; sInsertSql = 'Insert Into GLPrice'+ ' Select ID As GLID, %d As PhaseID, InfoPrice, InfoDate, DeltaPrice, ValidDeltaPrice' + ' From ProjectGL'; sUpdateSql = 'Update GLPrice As G, ProjectGL As P'+ ' Set G.PM_PreQuantity = P.PM_PreQuantity, G.PM_PreTotalPrice = P.PM_PreTotalPrice'+ ' Where (G.PhaseID = %d) and (G.GLID = P.ID)'; var iPhaseID: Integer; sSql: String; begin iPhaseID := TProjectData(FProjectData).ProjProperties.PhaseCount; sSql := Format(sDeleteSql, [iPhaseID]); ExecuteSql(sSql); sSql := Format(sInsertSql, [iPhaseID]); ExecuteSql(sSql); sSql := Format(sUpdateSql, [iPhaseID]); ExecuteSql(sSql); end; procedure TProjectGLData.sddProjectGLAfterAddRecord( ARecord: TsdDataRecord); begin ARecord.ValueByName('ID').AsInteger := GetsdDataSetNewID(sddProjectGL, 'idxID'); ARecord.ValueByName('CreatePhaseID').AsInteger := TProjectData(FProjectData).ProjProperties.PhaseCount; end; procedure TProjectGLData.sddProjectGLBeforeValueChange(AValue: TsdValue; const NewValue: Variant; var Allow: Boolean); begin if SameText(AValue.FieldName, 'Code') then begin Allow := False; if VarIsNull(NewValue) then ErrorMessage('编号不可为空。') else if CheckSameCode(NewValue) then ErrorMessage('编号不可重复。') else Allow := True; end else if not(SameText(AValue.FieldName, 'ID') or SameText(AValue.FieldName, 'CreatePhaseID')) then begin Allow := False; if (AValue.Owner.ValueByName('Code').AsString = '') then begin ErrorMessage('编号不可为空,请先填写编号,再填写其他信息。'); sddProjectGL.Remove(AValue.Owner); end else Allow := True; end; end; procedure TProjectGLData.sddProjectGLAfterValueChanged(AValue: TsdValue); begin if SameText(AValue.FieldName, 'BasePrice') or SameText(AValue.FieldName, 'RiskRange') or SameText(AValue.FieldName, 'InfoPrice') then begin CalculateDeltaPrice(TProjectGLRecord(AValue.Owner)); CalculatePM_Quantity(TProjectGLRecord(AValue.Owner)); CalculatePM_TotalPrice(TProjectGLRecord(AValue.Owner)); CalculateRelaBills(TProjectGLRecord(AValue.Owner)); end; end; procedure TProjectGLData.CalculateDeltaPrice(ARec: TProjectGLRecord); var C0, Ci, r, DeltaC, RiskC, ValidDeltaC: Double; begin C0 := ARec.BasePrice.AsFloat; Ci := ARec.InfoPrice.AsFloat; r := ARec.RiskRange.AsFloat; DeltaC := Ci - C0; RiskC := C0 * r / 100; if (DeltaC > 0) and (DeltaC - RiskC > 0) then ValidDeltaC := DeltaC - RiskC else if (DeltaC < 0) and (DeltaC + RiskC < 0) then ValidDeltaC := DeltaC + RiskC else ValidDeltaC := 0; if DeltaC <> ARec.DeltaPrice.AsFloat then ARec.DeltaPrice.AsFloat := PriceRoundTo(DeltaC); if ValidDeltaC <> ARec.ValidDeltaPrice.AsFloat then ARec.ValidDeltaPrice.AsFloat := PriceRoundTo(ValidDeltaC); end; procedure TProjectGLData.sdvProjectGLGetText(var Text: String; ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn; DisplayText: Boolean); procedure GetDisplayText; begin if ((Pos('Price', AColumn.FieldName) > 0) or (Pos('Quantity', AColumn.FieldName) > 0) or SameText('RiskRange', AColumn.FieldName)) then begin if AValue.AsFloat = 0 then Text := ''; end; end; begin if DisplayText then GetDisplayText; end; procedure TProjectGLData.CalculateAll; begin CalculatePrice; CalculatePriceMargin; end; procedure TProjectGLData.ExecuteSql(const ASql: string); var vQuery: TADOQuery; begin vQuery := TADOQuery.Create(nil); try vQuery.Connection := sdpProjectGL.Connection; vQuery.SQL.Add(ASql); vQuery.ExecSQL; finally vQuery.Free; end; end; function TProjectGLData.GetValidDeltaPrice(AID: Integer): Double; var Rec: TProjectGLRecord; begin Rec := TProjectGLRecord(sddProjectGL.FindKey('idxID', AID)); if Assigned(Rec) then Result := Rec.ValidDeltaPrice.AsFloat else Result := 0; end; procedure TProjectGLData.CalculatePrice; var iRec: Integer; begin if TProjectData(FProjectData).PriceMarginReadOnly then Exit; for iRec := 0 to sddProjectGL.RecordCount - 1 do CalculateDeltaPrice(TProjectGLRecord(sddProjectGL.Records[iRec])); end; procedure TProjectGLData.CalculatePriceMargin; var iRec: Integer; Rec: TProjectGLRecord; begin if TProjectData(FProjectData).PhaseData.StageDataReadOnly then Exit; for iRec := 0 to sddProjectGL.RecordCount - 1 do begin Rec := TProjectGLRecord(sddProjectGL.Records[iRec]); CalculatePM_Quantity(Rec); CalculatePM_TotalPrice(Rec); end; end; procedure TProjectGLData.CalculatePM_Quantity(ARec: TProjectGLRecord); var vGLs: TList; fQuantity: Double; i: Integer; GLRec: TsdDataRecord; BillsNode: TBillsIDTreeNode; begin vGLs := TList.Create; try fQuantity := 0; with TProjectData(FProjectData).DetailGLData do LoadProjectGL_DetailGLs(ARec.ValueByName('ID').AsInteger, vGLs); for i := 0 to vGLs.Count - 1 do begin GLRec := TsdDataRecord(vGLs.Items[i]); with TProjectData(FProjectData).BillsMeasureData do BillsNode := TBillsIDTreeNode(BillsMeasureTree.FindNode(GLRec.ValueByName('BillsID').AsInteger)); if Assigned(BillsNode.StageRec) then fQuantity := fQuantity + BillsNode.StageRec.GatherQuantity.AsFloat * GLRec.ValueByName('Quantity').AsFloat; end; if fQuantity <> ARec.PM_Quantity.AsFloat then ARec.PM_Quantity.AsFloat := fQuantity; finally vGLs.Free; end; end; procedure TProjectGLData.CalculatePM_TotalPrice(ARec: TProjectGLRecord); var fTotalPrice: Double; begin fTotalPrice := ARec.ValidDeltaPrice.AsFloat * ARec.PM_Quantity.AsFloat; if fTotalPrice <> ARec.PM_TotalPrice.AsFloat then ARec.PM_TotalPrice.AsFloat := fTotalPrice; end; procedure TProjectGLData.sddProjectGLGetRecordClass( var ARecordClass: TsdRecordClass); begin ARecordClass := TProjectGLRecord; end; function TProjectGLData.GetPM_TotalPrice: Double; var i: Integer; Rec: TProjectGLRecord; begin Result := 0; for i := 0 to sddProjectGL.RecordCount - 1 do begin Rec := TProjectGLRecord(sddProjectGL.Records[i]); Result := Result + Rec.PM_TotalPrice.AsFloat; end; end; procedure TProjectGLData.SavePM_CurData; const sUpdateSql = 'Update GLPrice As G, ProjectGL As P'+ ' Set G.PM_Quantity%d = P.PM_Quantity, G.PM_TotalPrice%d = P.PM_TotalPrice,'+ ' G.PM_Quantity_F = P.PM_Quantity, G.PM_TotalPrice_F = P.PM_TotalPrice'+ ' Where (G.PhaseID = %d) and (G.GLID = P.ID)'; var iStageIndex: Integer; iPhaseCount: Integer; sSql: string; begin iStageIndex := TProjectData(FProjectData).PhaseData.StageIndex; iPhaseCount := TProjectData(FProjectData).ProjProperties.PhaseCount; sSql := Format(sUpdateSql, [iStageIndex, iStageIndex, iPhaseCount]); ExecuteSql(sSql); end; procedure TProjectGLData.CalculateGL_PM(AGLID: Integer); var Rec: TProjectGLRecord; begin Rec := TProjectGLRecord(sddProjectGL.FindKey('idxID', AGLID)); if not Assigned(Rec) then Exit; CalculatePM_Quantity(Rec); CalculatePM_TotalPrice(Rec); end; procedure TProjectGLData.CalculateGLs_PM(ADetailGLs: TList); var i: Integer; DetailGLRec: TDetailGLRecord; begin for i := 0 to ADetailGLs.Count - 1 do begin DetailGLRec := TDetailGLRecord(ADetailGLs.Items[i]); CalculateGL_PM(DetailGLRec.GLID.AsInteger); end; end; procedure TProjectGLData.CalculateRelaBills(ARec: TProjectGLRecord); var iGL: Integer; DetailGLRec: TDetailGLRecord; begin LoadDetailGLs(ARec.ID.AsInteger); for iGL := 0 to FTempGLs.Count - 1 do begin DetailGLRec := TDetailGLRecord(FTempGLs.Items[iGL]); with TProjectData(FProjectData).PhaseData do StageData.CalculatePriceMargin(DetailGLRec.BillsID.AsInteger); end; with TProjectData(FProjectData).PhaseData do StageData.CalculatePriceMarginNode; end; procedure TProjectGLData.LoadDetailGLs(AGLID: Integer); begin FTempGLs.Clear; with TProjectData(FProjectData).DetailGLData do LoadProjectGL_DetailGLs(AGLID, FTempGLs); end; function TProjectGLData.GetActive: Boolean; begin Result := sddProjectGL.Active; end; procedure TProjectGLData.sdvProjectGLSetText(var Text: String; ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn; var Allow: Boolean); var iPhaseID: Integer; begin if SameText(AColumn.FieldName, 'Code') or SameText(AColumn.FieldName, 'Name') or SameText(AColumn.FieldName, 'Units') or SameText(AColumn.FieldName, 'Specs') or SameText(AColumn.FieldName, 'BasePrice') or SameText(AColumn.FieldName, 'RiskRange') then begin iPhaseID := TProjectGLRecord(ARecord).LockedPhaseID.AsInteger; if iPhaseID > 0 then DataSetErrorMessage(Allow, Format('该工料在第%d期已进行调差计算,不可修改基础数据。', [iPhaseID])); end; end; procedure TProjectGLData.LoadStagePM_CalcData; const sSelectSql = 'Select GLID, PhaseID, PM_PreQuantity, PM_PreTotalPrice,'+ ' PM_Quantity%d As PM_Quantity, PM_TotalPrice%d As PM_TotalPrice'+ ' From GLPrice Where PhaseID = %d'; var sSql: string; vQuery: TADOQuery; procedure LoadPM_Calc; var iRec: Integer; Rec: TProjectGLRecord; begin for iRec := 0 to sddProjectGL.RecordCount - 1 do begin Rec := TProjectGLRecord(sddProjectGL.Records[iRec]); if vQuery.Active and vQuery.Locate('GLID', Rec.ValueByName('ID').AsInteger, []) then begin Rec.PM_Quantity.AsFloat := vQuery.FieldByName('PM_Quantity').AsFloat; Rec.PM_TotalPrice.AsFloat := vQuery.FieldByName('PM_TotalPrice').AsFloat; end else begin Rec.PM_Quantity.AsFloat := 0; Rec.PM_TotalPrice.AsFloat := 0; end; end; end; begin sddProjectGL.BeginUpdate; vQuery := TADOQuery.Create(nil); try vQuery.Connection := sdpProjectGL.Connection; with TProjectData(FProjectData) do sSql := Format(sSelectSql, [StageIndex, StageIndex, PhaseIndex]); vQuery.SQL.Clear; vQuery.SQL.Add(sSql); vQuery.Open; LoadPM_Calc; finally vQuery.Free; sddProjectGL.EndUpdate; end; end; end.