unit ProjectGLDm; interface uses SysUtils, Classes, sdDB, sdProvider, ADODB, mDataRecord, CalcDecimal; type TProjectGLData = class(TDataModule) sdpProjectGL: TsdADOProvider; sddProjectGL: TsdDataSet; sdvProjectGL: TsdDataView; procedure sddProjectGLAfterAddRecord(ARecord: TsdDataRecord); 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); procedure sddProjectGLBeforeDeleteRecord(ARecord: TsdDataRecord; var Allow: Boolean); private FProjectData: TObject; FTempGLs: TList; function CheckSameCode(ACode: Integer): Boolean; function CheckApplied(AGLID: 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 CalculatePALRela(ARec: TProjectGLRecord); procedure CalculatePALRelas; procedure ExecuteSql(const ASql: string); procedure SaveGLPrice; procedure SavePM_CurData; procedure BeforeBatchOperation; procedure AfterBatchOperation; function GetValidDeltaPrice(AID: Integer): Double; function GetPM_TotalPrice: Double; function GetActive: Boolean; function GetDecimal: TCalcDecimal; 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; property Decimal: TCalcDecimal read GetDecimal; end; implementation uses ProjectData, UtilMethods, DB, Variants, PhaseData, DetailGLDm, BillsMeasureDm, BillsTree, sdIDTree, PhasePayDm, DateUtils, ZhAPI; {$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; Rec.UsedQuantity.AsFloat := vQuery.FieldByName('UsedQuantity').AsFloat; Rec.UsedTotalPrice.AsFloat := vQuery.FieldByName('UsedTotalPrice').AsFloat; end else begin Rec.InfoPrice.AsFloat := 0; Rec.InfoDate.AsString := ''; Rec.DeltaPrice.AsFloat := 0; Rec.ValidDeltaPrice.AsFloat := 0; Rec.UsedQuantity.AsFloat := 0; Rec.UsedTotalPrice.AsFloat := 0; end; end; end; begin BeforeBatchOperation; 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; AfterBatchOperation; 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, UsedQuantity, UsedTotalPrice' + ' From ProjectGL'; sUpdateSql = 'Update GLPrice As G, ProjectGL As P'+ ' Set G.PM_PreQuantity = P.PM_PreQuantity, G.PM_PreTotalPrice = P.PM_PreTotalPrice,'+ ' G.PrePAL_UsedQuantity = P.PrePAL_UsedQuantity, G.PrePAL_UsedTotalPrice = P.PrePAL_UsedTotalPrice,' + ' G.PrePAL_DeltaPrice = P.PrePAL_DeltaPrice, G.PrePAL_Total = P.PrePAL_Total'+ ' 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.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)); CalculatePALRela(TProjectGLRecord(AValue.Owner)); //CalculateRelaBills(TProjectGLRecord(AValue.Owner)); TProjectData(FProjectData).PriceMarginBillsData.RefreshAllDetailBills; end; if SameText(AValue.FieldName, 'UsedQuantity') then begin CalculatePALRela(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 := Decimal.Price.RoundTo(DeltaC); if ValidDeltaC <> ARec.ValidDeltaPrice.AsFloat then ARec.ValidDeltaPrice.AsFloat := Decimal.Price.RoundTo(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 (Pos('PAL', AColumn.FieldName) = 1) or SameText('RiskRange', AColumn.FieldName)) then begin if AValue.AsFloat = 0 then Text := '' else Text := FormatFloat('0.###', Decimal.Price.RoundTo(AValue.AsFloat)); 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: TMeasureBillsIDTreeNode; 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 := TMeasureBillsIDTreeNode(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.PAL_UsedQuantity%d = P.PAL_UsedQuantity, G.PAL_UsedTotalPrice%d = P.PAL_UsedTotalPrice,'+ ' G.PAL_DeltaPrice%d = P.PAL_DeltaPrice, G.PAL_Total%d = P.PAL_Total,'+ ' G.PM_Quantity_F = P.PM_Quantity, G.PM_TotalPrice_F = P.PM_TotalPrice,'+ ' G.PAL_UsedQuantity_F = P.PAL_UsedQuantity, G.PAL_UsedTotalPrice_F = P.PAL_UsedTotalPrice,'+ ' G.PAL_DeltaPrice_F = P.PAL_DeltaPrice, G.PAL_Total_F = P.PAL_Total'+ ' 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, iStageIndex, iStageIndex, 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); CalculatePALRela(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; Rec: TProjectGLRecord; begin Rec := TProjectGLRecord(ARecord); 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 := Rec.LockedPhaseID.AsInteger; if iPhaseID > 0 then DataSetErrorMessage(Allow, Format('该工料在第%d期已进行调差计算,不可修改基础数据。', [iPhaseID])); end; if AValue.DataType in [ftInteger, ftFloat] then if not CheckNumeric(Text) then Text := ''; if SameText(AColumn.FieldName, 'Code') then begin if StrToIntDef(Text, 0) = 0 then begin DataSetErrorMessage(Allow, '编号不可为0或空。'); if Rec.Code.AsString = '' then sddProjectGL.Remove(ARecord); end else if CheckSameCode(StrToInt(Text)) then begin DataSetErrorMessage(Allow, '编号不可重复。'); if Rec.Code.AsString = '' then sddProjectGL.Remove(AValue.Owner); end else if CheckApplied(Rec.ID.AsInteger) then DataSetErrorMessage(Allow, '工料已被应用,不可修改编号。'); end else begin if (Rec.Code.AsString = '') then begin DataSetErrorMessage(Allow, '编号不可为空,请先填写编号,再填写其他信息。'); sddProjectGL.Remove(AValue.Owner); end; end; end; procedure TProjectGLData.LoadStagePM_CalcData; const sSelectSql = 'Select GLID, PhaseID, PM_PreQuantity, PM_PreTotalPrice,'+ ' PrePAL_UsedQuantity, PrePAL_UsedTotalPrice, PrePAL_DeltaPrice, PrePAL_Total,' + ' PM_Quantity%d As PM_Quantity, PM_TotalPrice%d As PM_TotalPrice,'+ ' PAL_UsedQuantity%d As PAL_UsedQuantity, PAL_UsedTotalPrice%d As PAL_UsedTotalPrice,' + ' PAL_DeltaPrice%d As PAL_DeltaPrice, PAL_Total%d As PAL_Total' + ' 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; Rec.PAL_UsedQuantity.AsFloat := vQuery.FieldByName('PAL_UsedQuantity').AsFloat; Rec.PAL_UsedTotalPrice.AsFloat := vQuery.FieldByName('PAL_UsedTotalPrice').AsFloat; Rec.PAL_DeltaPrice.AsFloat := vQuery.FieldByName('PAL_DeltaPrice').AsFloat; Rec.PAL_Total.AsFloat := vQuery.FieldByName('PAL_Total').AsFloat; end else begin Rec.PM_Quantity.AsFloat := 0; Rec.PM_TotalPrice.AsFloat := 0; Rec.PAL_UsedQuantity.AsFloat := 0; Rec.PAL_UsedTotalPrice.AsFloat := 0; Rec.PAL_DeltaPrice.AsFloat := 0; Rec.PAL_Total.AsFloat := 0; end; end; end; begin BeforeBatchOperation; vQuery := TADOQuery.Create(nil); try vQuery.Connection := sdpProjectGL.Connection; with TProjectData(FProjectData) do sSql := Format(sSelectSql, [StageIndex, StageIndex, StageIndex, StageIndex, StageIndex, StageIndex, PhaseIndex]); vQuery.SQL.Clear; vQuery.SQL.Add(sSql); vQuery.Open; LoadPM_Calc; finally vQuery.Free; AfterBatchOperation; end; end; procedure TProjectGLData.AfterBatchOperation; begin sddProjectGL.EndUpdate; sddProjectGL.EnableControls; sddProjectGL.AfterValueChanged := sddProjectGLAfterValueChanged; end; procedure TProjectGLData.BeforeBatchOperation; begin sddProjectGL.AfterValueChanged := nil; sddProjectGL.DisableControls; sddProjectGL.BeginUpdate; end; function TProjectGLData.CheckApplied(AGLID: Integer): Boolean; begin LoadDetailGLs(AGLID); Result := FTempGLs.Count > 0; end; procedure TProjectGLData.sddProjectGLBeforeDeleteRecord( ARecord: TsdDataRecord; var Allow: Boolean); begin Allow := not CheckApplied(ARecord.ValueByName('ID').AsInteger); if not Allow then ErrorMessage('工料已被应用,不可删除。'); end; function TProjectGLData.GetDecimal: TCalcDecimal; begin Result := TProjectData(FProjectData).ProjProperties.DecimalManager.PriceMargin; end; procedure TProjectGLData.CalculatePALRela(ARec: TProjectGLRecord); begin ARec.UsedTotalPrice.AsFloat := Decimal.TotalPrice.RoundTo(ARec.UsedQuantity.AsFloat * ARec.InfoPrice.AsFloat); ARec.PAL_UsedQuantity.AsFloat := Decimal.Quantity.RoundTo(ARec.PM_Quantity.AsFloat - ARec.UsedQuantity.AsFloat); ARec.PAL_UsedTotalPrice.AsFloat := Decimal.TotalPrice.RoundTo(ARec.PAL_UsedQuantity.AsFloat * ARec.BasePrice.AsFloat); ARec.PAL_DeltaPrice.AsFloat := Decimal.TotalPrice.RoundTo( - ARec.UsedQuantity.AsFloat * ARec.DeltaPrice.AsFloat); ARec.PAL_Total.AsFloat := Decimal.TotalPrice.RoundTo(ARec.BasePrice.AsFloat*ARec.PM_Quantity.AsFloat - ARec.InfoPrice.AsFloat*ARec.UsedQuantity.AsFloat); end; procedure TProjectGLData.CalculatePALRelas; 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]); CalculatePALRela(Rec); end; end; end.