123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786 |
- unit DealPaymentDm;
- interface
- uses
- SysUtils, Classes, sdDB, sdProvider, ADODB, FormulaCalc, UtilMethods;
- type
- TDealPaymentData = class(TDataModule)
- sdpDealPayment: TsdADOProvider;
- sddDealPayment: TsdDataSet;
- sdvDealPayment: TsdDataView;
- procedure sddDealPaymentAfterAddRecord(ARecord: TsdDataRecord);
- procedure sdvDealPaymentGetText(var Text: String;
- ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
- DisplayText: Boolean);
- procedure sdvDealPaymentNeedLookupRecord(ARecord: TsdDataRecord;
- AColumn: TsdViewColumn; ANewText: String);
- procedure sdvDealPaymentSetText(var Text: string;
- ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
- var Allow: Boolean);
- procedure sddDealPaymentBeforeAddRecord(ARecord: TsdDataRecord;
- var Allow: Boolean);
- procedure sddDealPaymentAfterValueChanged(AValue: TsdValue);
- procedure sddDealPaymentBeforeDeleteRecord(ARecord: TsdDataRecord;
- var Allow: Boolean);
- procedure sdvDealPaymentBeforeAddRecord(ARecord: TsdDataRecord;
- var Allow: Boolean);
- private
- FProjectData: TObject;
- FPayFormula: TPayFormula;
- procedure InitPredefinedPayItems;
- procedure RepairSerialNo;
- procedure RepairLockedFormula;
- function GetNewID: Integer;
- function GetNewSerialNo: Integer;
- function GetAddTotalPrice: Double;
- function GetCutTotalPrice: Double;
- function GetPaidTotalPrice: Double;
- public
- constructor Create(AProjectData: TObject);
- destructor Destroy; override;
- procedure Open(AConnection: TADOConnection);
- procedure Close;
- procedure Save;
- procedure Init;
- // 扣款项是否已达起扣金额
- function CheckStartedPrice(AID: Integer): Boolean;
- function CheckReachPlan(ARec: TsdDataRecord): Boolean;
- function GetAllowTotalPrice(AID: Integer; ATotalPrice, APreTotalPrice: Double): Double;
- procedure UpdateTotalPrice(AID: Integer; ATotalPrice: Double);
- function DealPayRecord(const AName: string): TsdDataRecord;
- function PlanStr(ARec: TsdDataRecord): string;
- function GetStartedPrice(AID: Integer): Double;
- procedure CalcStarted_RangePrice;
- procedure ResetPhaseLink;
- procedure LockedData;
- procedure UpdateLinkSerialNo;
- property ProjectData: TObject read FProjectData;
- // 扣款项,累计金额合计
- property CutTotalPrice: Double read GetCutTotalPrice;
- // 非扣款项,累计金额合计
- property AddTotalPrice: Double read GetAddTotalPrice;
- // 实付
- property PaidTotalPrice: Double read GetPaidTotalPrice;
- property PayFormula: TPayFormula read FPayFormula;
- end;
- implementation
- uses
- ProjectData, PhasePayDm, PhaseData, ZhAPI, BillsDm, Math, Variants,
- ProjectProperty;
- {$R *.dfm}
- { TDealPaymentData }
- function TDealPaymentData.CheckStartedPrice(AID: Integer): Boolean;
- var
- Rec: TsdDataRecord;
- begin
- Rec := sddDealPayment.FindKey('idxID', AID);
- with TProjectData(FProjectData).BillsData do
- Result := Settlement[AddGatherIndex] >= Rec.ValueByName('StartedPrice').AsFloat;
- end;
- constructor TDealPaymentData.Create(AProjectData: TObject);
- begin
- inherited Create(nil);
- FProjectData := AProjectData;
- FPayFormula := TPayFormula.Create(FProjectData);
- with TProjectData(FProjectData) do
- FPayFormula.Decimal := ProjProperties.DecimalManager.DealPay;
- end;
- destructor TDealPaymentData.Destroy;
- begin
- FPayFormula.Free;
- inherited;
- end;
- function TDealPaymentData.GetAllowTotalPrice(AID: Integer;
- ATotalPrice, APreTotalPrice: Double): Double;
- var
- Rec: TsdDataRecord;
- fAllowPrice: Double;
- begin
- Result := ATotalPrice;
- Rec := sddDealPayment.FindKey('idxID', AID);
- if Rec.ValueByName('RangePrice').AsFloat = 0 then Exit;
- fAllowPrice := Rec.ValueByName('RangePrice').AsFloat - APreTotalPrice;
- if not CheckReachPlan(Rec) then
- Result := Min(fAllowPrice, ATotalPrice)
- else
- Result := fAllowPrice;
- end;
- function TDealPaymentData.GetNewID: Integer;
- var
- idx: TsdIndex;
- begin
- idx := sddDealPayment.FindIndex('idxID');
- if idx.RecordCount > 0 then
- Result := idx.Records[idx.RecordCount - 1].ValueByName('ID').AsInteger + 1
- else
- Result := 1;
- end;
- procedure TDealPaymentData.Init;
- begin
- if sddDealPayment.RecordCount > 0 then Exit;
- InitPredefinedPayItems;
- end;
- procedure TDealPaymentData.InitPredefinedPayItems;
- procedure AddPredefinedPayItem(const AItem: string);
- var
- sgsItem: TStrings;
- f: Double;
- Rec: TsdDataRecord;
- begin
- sgsItem := TStringList.Create;
- try
- sgsItem.Delimiter := ';';
- sgsItem.DelimitedText := AItem;
- if sgsItem.Count < 7 then Exit;
- Rec := sddDealPayment.Add;
- Rec.ValueByName('Name').AsString := sgsItem[0];
- Rec.ValueByName('CalcType').AsInteger := StrToIntDef(sgsItem[1], 0);
- Rec.ValueByName('IsMinus').AsBoolean := sgsItem[2] = '1';
- if TryStrToFloat(sgsItem[3], f) then
- Rec.ValueByName('StartedPrice').AsFloat := f
- else
- Rec.ValueByName('SFormula').AsString := sgsItem[3];
- if TryStrToFloat(sgsItem[4], f) then
- Rec.ValueByName('RangePrice').AsFloat := f
- else
- Rec.ValueByName('RFormula').AsString := sgsItem[4];
- Rec.ValueByName('Formula').AsString := sgsItem[5];
- if SameText(sgsItem[5], 'bqwc') then
- Rec.ValueByName('LockedFormula').AsBoolean := True;
- Rec.ValueByName('PreDefined').AsBoolean := StrToBoolDef(sgsItem[6], False);
- finally
- sgsItem.Free;
- end;
- end;
- var
- sgsItems: TStrings;
- I: Integer;
- begin
- sgsItems := TStringList.Create;
- try
- sgsItems.LoadFromFile(GetAppFilePath + 'DealPayment.txt');
- for I := 0 to sgsItems.Count - 1 do
- if sgsItems[I] <> '' then
- AddPredefinedPayItem(sgsItems[I]);
- finally
- sgsItems.Free;
- end;
- end;
- procedure TDealPaymentData.LockedData;
- var
- iIndex: Integer;
- Rec: TsdDataRecord;
- begin
- for iIndex := 0 to sddDealPayment.RecordCount - 1 do
- begin
- Rec := sddDealPayment.Records[iIndex];
- Rec.ValueByName('Locked').AsBoolean := True;
- if Rec.ValueByName('Formula').AsString <> '' then
- Rec.ValueByName('LockedFormula').AsBoolean := True;
- end;
- end;
- procedure TDealPaymentData.Open(AConnection: TADOConnection);
- begin
- sdpDealPayment.Connection := AConnection;
- sddDealPayment.Open;
- RepairSerialNo;
- RepairLockedFormula;
- if not Assigned(sddDealPayment.IndexList.FindByName('idxID')) then
- sddDealPayment.AddIndex('idxID', 'ID');
- if not Assigned(sddDealPayment.IndexList.FindByName('idxView')) then
- sddDealPayment.AddIndex('idxView', 'SerialNo');
- // 开始计量前,CutTotalPrice链接至TotalPrice,已解决无计量数据时无法输入问题
- sddDealPayment.FieldByName('TotalPrice').ValidChars := sddDealPayment.FieldByName('TotalPrice').ValidChars + ArithmeticCharSet + ExprsBaseCharSet;
- sddDealPayment.FieldByName('StartedPrice').ValidChars := sddDealPayment.FieldByName('StartedPrice').ValidChars + ArithmeticCharSet + ExprsExceptCharSet;
- sddDealPayment.FieldByName('RangePrice').ValidChars := sddDealPayment.FieldByName('RangePrice').ValidChars + ArithmeticCharSet + ExprsExceptCharSet;
- sdvDealPayment.Open;
- sdvDealPayment.IndexName := 'idxView';
- end;
- procedure TDealPaymentData.ResetPhaseLink;
- begin
- with TProjectData(FProjectData).PhaseData do
- begin
- sdvDealPayment.Columns.FindColumn('CurTotalPrice').LookupDataSet := PhasePayData.sddPhasePay;
- sdvDealPayment.Columns.FindColumn('CurTotalPrice').LookupResultField := 'TotalPrice' + IntToStr(StageIndex);
- end;
- end;
- procedure TDealPaymentData.Save;
- begin
- sddDealPayment.Save;
- end;
- procedure TDealPaymentData.sddDealPaymentAfterAddRecord(
- ARecord: TsdDataRecord);
- var
- iSerialNo: Integer;
- begin
- iSerialNo := GetNewSerialNo;
- ARecord.ValueByName('ID').AsInteger := GetNewID;
- ARecord.ValueByName('SerialNo').AsInteger := iSerialNo;
- ARecord.ValueByName('CreatePhaseID').AsInteger := TProjectData(FProjectData).PhaseIndex;
- end;
- procedure TDealPaymentData.sdvDealPaymentGetText(var Text: String;
- ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
- DisplayText: Boolean);
- procedure GetDisplayText;
- begin
- if not Assigned(AValue) or
- ((Pos('Price', AValue.FieldName) > 0) and (AValue.AsFloat = 0)) then
- Text := '';
- end;
- function GetFormulaField(const APriceField: string): string;
- begin
- if SameText(APriceField, 'StartedPrice') then
- Result := 'SFormula'
- else if SameText(APriceField, 'RangePrice') then
- Result := 'RFormula'
- else if SameText(APriceField, 'CurTotalPrice') then
- Result := 'Formula'
- else if Pos('TotalPrice', APriceField) = 1 then
- Result := StringReplace(AValue.FieldName, 'TotalPrice', 'Formula', []);
- end;
- procedure GetStageEditText;
- var
- sField, sFormula: string;
- begin
- if Assigned(AValue) then
- begin
- sField := GetFormulaField(AValue.FieldName);
- sFormula := AValue.Owner.ValueByName(sField).AsString;
- if (sField <> '') and (sFormula <> '') then
- Text:= sFormula;
- end
- else
- Text := '';
- end;
- procedure GetMainEditText;
- var
- sField, sFormula: string;
- begin
- sField := GetFormulaField(AColumn.FieldName);
- if (sField <> '') then
- begin
- sFormula := ARecord.ValueByName(sField).AsString;
- if (sFormula <> '') then
- Text := sFormula;
- end
- else
- Text := '';
- end;
- begin
- if Pos('Price', AColumn.FieldName)> 0 then
- begin
- if DisplayText then
- GetDisplayText
- else if TProjectData(FProjectData).PhaseIndex > 0 then
- GetStageEditText
- else
- GetMainEditText;
- end;
- end;
- procedure TDealPaymentData.sdvDealPaymentNeedLookupRecord(
- ARecord: TsdDataRecord; AColumn: TsdViewColumn; ANewText: String);
- procedure SetNewRecData(APayRec: TsdDataRecord);
- var
- iID: Integer;
- sTPField, sFField: string;
- fTotalPrice, fAllow: Double;
- begin
- sTPField := 'TotalPrice' + IntToStr(TProjectData(FProjectData).PhaseData.StageIndex);
- sFField := 'Formula' + IntToStr(TProjectData(FProjectData).PhaseData.StageIndex);
- if CheckNumeric(ANewText) then
- begin
- APayRec.ValueByName(sFField).AsString := ANewText;
- fTotalPrice := StrToFloat(ANewText);
- end
- else
- begin
- APayRec.ValueByName(sFField).AsString := ANewText;
- ARecord.ValueByName('Formula').AsString := ANewText;
- fTotalPrice := FPayFormula.Calculate(ANewText, ARecord.ValueByName('StartedPrice').AsFloat);
- end;
- iID := ARecord.ValueByName('ID').AsInteger;
- if CheckStartedPrice(iID) then
- begin
- fAllow := GetAllowTotalPrice(iID, fTotalPrice, 0);
- APayRec.ValueByName(sTPField).AsFloat := fAllow;
- if fAllow < fTotalPrice then
- TipMessage(Format('“%s”已达扣款限额,本期金额计%s。', [ARecord.ValueByName('Name').AsString, FloatToStr(fAllow)]))
- else if fAllow > fTotalPrice then
- TipMessage(Format('“%s”已达计提期限,本期金额计%s。', [ARecord.ValueByName('Name').AsString, FloatToStr(fAllow)]));
- end
- else
- TipMessage(Format('“%s”未达到起扣金额,本期金额计零。', [ARecord.ValueByName('Name').AsString]));
- end;
- var
- NewRec: TsdDataRecord;
- begin
- if SameText(AColumn.FieldName, 'CurTotalPrice') then
- begin
- with TProjectData(FProjectData).PhaseData.PhasePayData do
- NewRec := AddPayRecord(ARecord.ValueByName('ID').AsInteger);
- SetNewRecData(NewRec);
- end;
- end;
- procedure TDealPaymentData.sdvDealPaymentSetText(var Text: string;
- ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
- var Allow: Boolean);
- procedure CheckLockedData;
- var
- Rec: TsdDataRecord;
- sFormula: string;
- begin
- Rec := ARecord;//sddDealPayment.FindKey('idxID', ARecord.ValueByName('ID').AsInteger);
- if Rec.ValueByName('CalcType').AsInteger = 1 then
- begin
- if SameText(AValue.FieldName, 'Name') or
- SameText(AValue.FieldName, 'IsMinus') or
- (Pos('TotalPrice', AValue.FieldName) > 0) or
- SameText(AValue.FieldName, 'StartedPrice') or
- SameText(AValue.FieldName, 'RangePrice') then
- DataSetErrorMessage(Allow, '固定项不可修改!');
- end;
- if not Allow then Exit;
- if Rec.ValueByName('LockedFormula').AsBoolean then
- begin
- if (Pos('TotalPrice', AValue.FieldName) = 1) and
- (Rec.ValueByName('Formula').AsString <> '') then
- begin
- // 如果有公式计算,如果是纯数学计算式,则可设置,基数计算,则不可
- sFormula := Rec.ValueByName('Formula').AsString;
- if (Pos('bqwc', sFormula)>0) or (Pos('htj', sFormula)>0) or
- (Pos('kgyfk', sFormula)>0) or (Pos('clyfk', sFormula)>0) then
- DataSetErrorMessage(Allow, '该支付(扣款)项已设置基数计算公式且被锁定,不可修改!');
- end;
- end;
- if not Allow then Exit;
- if Rec.ValueByName('Locked').AsBoolean then
- begin
- if SameText(AValue.FieldName, 'StartedPrice') then
- DataSetErrorMessage(Allow, '该支付(扣款)项的起扣金额被锁定,不可修改!')
- else if SameText(AValue.FieldName, 'RangePrice') then
- DataSetErrorMessage(Allow, '该支付(扣款)项的付(扣)款限额被锁定,不可修改!')
- else if SameText(AValue.FieldName, 'Name') or SameText(AValue.FieldName, 'IsMinus') then
- DataSetErrorMessage(Allow, '该项已被锁定,不可修改!');
- end;
- end;
- procedure DoStartedPriceChanged;
- begin
- if AValue.Owner.ValueByName('TotalPrice').AsFloat <> 0 then
- DataSetErrorMessage(Allow, '该付(扣)款金额已经计量,不可修改起扣金额!');
- if not Allow then Exit;
- if CheckStringNull(Text) or CheckNumeric(Text) then
- AValue.Owner.ValueByName('SFormula').AsString := ''
- else if Pos('bqwc', Text) = 0 then
- begin
- AValue.Owner.ValueByName('SFormula').AsString := Text;
- Text := FloatToStr(FPayFormula.Calculate(Text));
- end
- else
- DataSetErrorMessage(Allow, '起扣金额不可引用“本期计算价”进行计算!');
- end;
- procedure DoRangePriceChanged;
- begin
- if AValue.Owner.ValueByName('TotalPrice').AsFloat <> 0 then
- DataSetErrorMessage(Allow, '该付(扣)款金额已经计量,不可修改付(扣)款限额!');
- if not Allow then Exit;
- if CheckStringNull(Text) or CheckNumeric(Text) then
- AValue.Owner.ValueByName('RFormula').AsString := ''
- else if Pos('bqwc', Text) = 0 then
- begin
- AValue.Owner.ValueByName('RFormula').AsString := Text;
- Text := FloatToStr(FPayFormula.Calculate(Text));
- end
- else
- DataSetErrorMessage(Allow, '付(扣)款限额不可引用“本期计算价”进行计算!');
- end;
- procedure DoCurTotalPriceChanged;
- var
- iID: Integer;
- sFField, sPreField: string;
- fTotalPrice, fAllow: Double;
- Rec: TsdDataRecord;
- begin
- Rec := ARecord;//sddDealPayment.FindKey('idxID', ARecord.ValueByName('ID').AsInteger);
- sFField := StringReplace(AValue.FieldName, 'TotalPrice', 'Formula', []);
- if CheckStringNull(Text) or CheckNumeric(Text) then
- begin
- Rec.ValueByName('Formula').AsString := '';
- AValue.Owner.ValueByName(sFField).AsString := Text;
- fTotalPrice := StrToFloatDef(Text, 0);
- end
- else
- begin
- Rec.ValueByName('Formula').AsString := Text;
- AValue.Owner.ValueByName(sFField).AsString := Text;
- if AValue.Owner.ValueByName('Pre' + AValue.FieldName).AsFloat = 0 then
- fTotalPrice := FPayFormula.Calculate(Text, Rec.ValueByName('StartedPrice').AsFloat)
- else
- fTotalPrice := FPayFormula.Calculate(Text);
- end;
- if AValue.Owner.ValueByName('StopCalc').AsBoolean then
- begin
- fTotalPrice := 0;
- Text := '';
- end
- else
- begin
- iID := ARecord.ValueByName('ID').AsInteger;
- if CheckStartedPrice(iID) then
- begin
- sPreField := StringReplace(AValue.FieldName, 'TotalPrice', 'PreTotalPrice', []);
- fAllow := GetAllowTotalPrice(iID, fTotalPrice, AValue.Owner.ValueByName(sPreField).AsFloat);
- Text := FloatToStr(fAllow);
- if fAllow < fTotalPrice then
- TipMessage(Format('“%s”已达扣款限额,本期金额计%s。', [Rec.ValueByName('Name').AsString, Text]))
- else if fAllow > fTotalPrice then
- TipMessage(Format('“%s”已达计提期限,本期金额计%s。', [Rec.ValueByName('Name').AsString, Text]));
- end
- else
- begin
- Text := '';
- TipMessage(Format('“%s”未达到起扣金额,本期金额计零。', [Rec.ValueByName('Name').AsString]));
- end;
- end;
- end;
- procedure DoLedgerFormulaChanged;
- begin
- if CheckStringNull(Text) or CheckNumeric(Text) then
- ARecord.ValueByName('Formula').AsString := ''
- else
- ARecord.ValueByName('Formula').AsString := Text;
- Text := '';
- end;
- begin
- if not Assigned(AValue) then Exit;
- Text := Trim(Text);
- if SameText('Name', AValue.FieldName) and (Text = '') then
- begin
- ErrorMessage('合同支付项名称不允许为空,如需删除,请点击右键进行删除');
- Allow := False;
- Exit;
- end;
- CheckLockedData;
- if not Allow then Exit;
- if SameText('StartedPrice', AValue.FieldName) then
- DoStartedPriceChanged;
- if SameText('RangePrice', AValue.FieldName) then
- DoRangePriceChanged;
- if SameText('CurTotalPrice', AColumn.FieldName) then
- if TProjectData(FProjectData).ProjProperties.PhaseCount > 0 then
- DoCurTotalPriceChanged
- else
- DoLedgerFormulaChanged;
- end;
- procedure TDealPaymentData.UpdateTotalPrice(AID: Integer;
- ATotalPrice: Double);
- var
- Rec: TsdDataRecord;
- begin
- Rec := sddDealPayment.FindKey('idxID', AID);
- Rec.ValueByName('TotalPrice').AsFloat := Rec.ValueByName('TotalPrice').AsFloat + ATotalPrice;
- end;
- procedure TDealPaymentData.sddDealPaymentBeforeAddRecord(
- ARecord: TsdDataRecord; var Allow: Boolean);
- begin
- { if ARecord.ValueByName('Name').AsString = '' then
- Allow := False;}
- end;
- procedure TDealPaymentData.CalcStarted_RangePrice;
- var
- I: Integer;
- Rec: TsdDataRecord;
- begin
- with TProjectData(FProjectData).ProjProperties do
- if (PhaseCount > 1) or ((PhaseCount = 1) and (AuditStatus <> 0)) then Exit;
- for I := 0 to sddDealPayment.RecordCount - 1 do
- begin
- Rec := sddDealPayment.Records[I];
- if Rec.ValueByName('CalcType').AsInteger <> 0 then Continue;
- Rec.ValueByName('StartedPrice').AsFloat := FPayFormula.Calculate(Rec.ValueByName('SFormula').AsString);
- Rec.ValueByName('RangePrice').AsFloat := FPayFormula.Calculate(Rec.ValueByName('RFormula').AsString);
- end;
- end;
- procedure TDealPaymentData.sddDealPaymentAfterValueChanged(
- AValue: TsdValue);
- begin
- if SameText('IsMinus', AValue.FieldName) then
- TProjectData(FProjectData).PhaseData.PhasePayData.CalculateCurPay;
- end;
- function TDealPaymentData.GetAddTotalPrice: Double;
- var
- iIndex: Integer;
- Rec: TsdDataRecord;
- begin
- Result := 0;
- for iIndex := 0 to sddDealPayment.RecordCount - 1 do
- begin
- Rec := sddDealPayment.Records[iIndex];
- if (Rec.ValueByName('CalcType').AsInteger = 0) and not Rec.ValueByName('IsMinus').AsBoolean then
- Result := Result + Rec.ValueByName('TotalPrice').AsFloat;
- end;
- end;
- function TDealPaymentData.GetCutTotalPrice: Double;
- var
- iIndex: Integer;
- Rec: TsdDataRecord;
- begin
- Result := 0;
- for iIndex := 0 to sddDealPayment.RecordCount - 1 do
- begin
- Rec := sddDealPayment.Records[iIndex];
- if (Rec.ValueByName('CalcType').AsInteger = 0) and Rec.ValueByName('IsMinus').AsBoolean then
- Result := Result + Rec.ValueByName('TotalPrice').AsFloat;
- end;
- end;
- function TDealPaymentData.GetPaidTotalPrice: Double;
- var
- Rec: TsdDataRecord;
- begin
- Rec := sddDealPayment.Locate('CalcType', 2);
- if Assigned(Rec) then
- Result := Rec.ValueByName('TotalPrice').AsFloat
- else
- Result := 0;
- end;
- procedure TDealPaymentData.sddDealPaymentBeforeDeleteRecord(
- ARecord: TsdDataRecord; var Allow: Boolean);
- begin
- if ARecord.ValueByName('Locked').AsBoolean then
- DataSetErrorMessage(Allow, '该支付(扣款)项已锁定,不可删除!')
- else if ARecord.ValueByName('PreDefined').AsBoolean then
- DataSetErrorMessage(Allow, '此项为预定义项,不允许删除!')
- else if ARecord.ValueByName('TotalPrice').AsFloat <> 0 then
- DataSetErrorMessage(Allow, '该支付(扣款)项存在数据,如需删除请先清除本期金额!');
-
- if Allow and TProjectData(FProjectData).PhaseData.Active then
- TProjectData(FProjectData).PhaseData.PhasePayData.Delete(ARecord.ValueByName('ID').AsInteger);
- end;
- procedure TDealPaymentData.Close;
- begin
- sddDealPayment.Close;
- end;
- procedure TDealPaymentData.RepairSerialNo;
- var
- Rec: TsdDataRecord;
- iRec: Integer;
- begin
- if sddDealPayment.RecordCount = 0 then Exit;
- Rec := sddDealPayment.Records[0];
- if Rec.ValueByName('SerialNo').AsString = '' then
- begin
- for iRec := 0 to sddDealPayment.RecordCount - 1 do
- begin
- Rec := sddDealPayment.Records[iRec];
- Rec.ValueByName('SerialNo').AsInteger := iRec;
- end;
- end;
- end;
- function TDealPaymentData.GetNewSerialNo: Integer;
- var
- idx: TsdIndex;
- begin
- idx := sddDealPayment.FindIndex('idxView');
- if idx.RecordCount > 0 then
- Result := idx.Records[idx.RecordCount - 1].ValueByName('SerialNo').AsInteger + 1
- else
- Result := 1;
- end;
- procedure TDealPaymentData.RepairLockedFormula;
- function CheckHasRepair: Boolean;
- var
- iRec: Integer;
- Rec: TsdDataRecord;
- begin
- Result := True;
- for iRec := 0 to sddDealPayment.RecordCount - 1 do
- begin
- Rec := sddDealPayment.Records[iRec];
- if Rec.ValueByName('Locked').AsBoolean and
- (Rec.ValueByName('Formula').AsString <> '') and (Rec.ValueByName('LockedFormula').AsBoolean) then
- begin
- Result := False;
- Break;
- end;
- end;
- end;
- var
- iRec: Integer;
- Rec: TsdDataRecord;
- begin
- if sddDealPayment.RecordCount = 0 then Exit;
- if CheckHasRepair then
- begin
- for iRec := 0 to sddDealPayment.RecordCount - 1 do
- begin
- Rec := sddDealPayment.Records[iRec];
- if Rec.ValueByName('Locked').AsBoolean and (Rec.ValueByName('Formula').AsString <> '') then
- Rec.ValueByName('LockedFormula').AsBoolean := True;
- end;
- end;
- end;
- function TDealPaymentData.GetStartedPrice(AID: Integer): Double;
- var
- Rec: TsdDataRecord;
- begin
- Rec := sddDealPayment.FindKey('idxID', AID);
- Result := Rec.ValueByName('StartedPrice').AsFloat;
- end;
- function TDealPaymentData.CheckReachPlan(ARec: TsdDataRecord): Boolean;
- var
- fCurValue, fDeadlineValue: Double;
- begin
- Result := False;
- if ARec.ValueByName('PlanType').AsInteger <> 0 then
- begin
- if ARec.ValueByName('PlanType').AsInteger = 1 then
- fCurValue := TProjectData(FProjectData).ProjProperties.PhaseCount
- else if ARec.ValueByName('PlanSubType').AsInteger = 0 then
- fCurValue := TProjectData(FProjectData).BillsData.Settlement[4]
- else if ARec.ValueByName('PlanSubType').AsInteger = 1 then
- fCurValue := TProjectData(FProjectData).BillsData.Settlement[1]
- else if ARec.ValueByName('PlanSubType').AsInteger = 2 then
- fCurValue := TProjectData(FProjectData).BillsData.Settlement[2];
- fDeadlineValue := ARec.ValueByName('PlanDeadline').AsFloat;
- Result := fCurValue >= fDeadlineValue;
- end;
- end;
- function TDealPaymentData.PlanStr(ARec: TsdDataRecord): string;
- begin
- if ARec.ValueByName('PlanType').AsInteger = 0 then
- Result := '无'
- else if ARec.ValueByName('PlanType').AsInteger = 1 then
- Result := Format('计量期数 >= %d', [ARec.ValueByName('PlanDeadline').AsInteger])
- else if ARec.ValueByName('PlanSubType').AsInteger = 0 then
- Result := Format('累计完成计量金额 >= %f', [ARec.ValueByName('PlanDeadline').AsFloat])
- else if ARec.ValueByName('PlanSubType').AsInteger = 1 then
- Result := Format('累计合同计量金额 >= %f', [ARec.ValueByName('PlanDeadline').AsFloat])
- else if ARec.ValueByName('PlanSubType').AsInteger = 2 then
- Result := Format('累计变更计量金额 >= %f', [ARec.ValueByName('PlanDeadline').AsFloat]);
- end;
- procedure TDealPaymentData.UpdateLinkSerialNo;
- var
- iPay, iCut, iIndex: Integer;
- Rec: TsdDataRecord;
- begin
- iPay := 1;
- iCut := 1;
- for iIndex := 0 to sdvDealPayment.RecordCount - 1 do
- begin
- Rec := sdvDealPayment.Records[iIndex];
- if Rec.ValueByName('CalcType').AsInteger = 0 then
- begin
- if Rec.ValueByName('IsMinus').AsBoolean then
- begin
- Rec.ValueByName('LinkSerialNo').AsInteger := iCut;
- Inc(iCut);
- end
- else
- begin
- Rec.ValueByName('LinkSerialNo').AsInteger := iPay;
- Inc(iPay);
- end;
- end;
- end;
- end;
- function TDealPaymentData.DealPayRecord(
- const AName: string): TsdDataRecord;
- var
- iRec: Integer;
- Rec: TsdDataRecord;
- begin
- Result := nil;
- 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;
- procedure TDealPaymentData.sdvDealPaymentBeforeAddRecord(
- ARecord: TsdDataRecord; var Allow: Boolean);
- begin
- Allow := VarToStrDef(ARecord.ValueByName('Name').CachedValue, '') <> '';
- end;
- end.
|