| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785 | 
							- 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;
 
- {$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
 
-       Text := AValue.AsString;
 
-       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
 
-   if TProjectData(FProjectData).ProjProperties.PhaseCount > 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.
 
 
  |