purchpayfrm.~pas

来自「医药连锁经营管理系统源码」· ~PAS 代码 · 共 703 行 · 第 1/2 页

procedure TFmPurchPay.edProvNameButtonClick(Sender: TObject);
Var sProvNo,sProvName:String;
begin
  If FEditMode=0 Then Exit;
  sProvNo := CdsPurchPayProvNo.Value;
  If SelectProv(sProvNo,sProvName) Then Begin
    CdsPurchPayProvNo.Value := sProvNo;
    CdsPurchPayProvName.Value := sProvName;
  End;
End;

procedure TFmPurchPay.CdsPurchPayProvNoChange(Sender: TField);
Var
  sProvNo,sProvName,LogText:String;
begin
  if Not(CdsPurchPay.State in dsEditModes) Then Exit;
  sProvNo:=CdsPurchPayProvNo.Value;
  If sProvNo='' Then Exit;
  if sProvNo=BeforeProvNo Then Exit;
  BeforeProvNo:=sProvNo;
  sProvName:=VarToStr(SvrCommon.AppServer.GetProvInfo(iClientID,sProvNo,1,'ProvName',LogText));
  CdsPurchPayProvName.Value:=sProvName;
  If LogText<>'' Then Begin
    Messagebox(Handle,Pchar(LogText),nil,16);
    Abort;
  End;
  GetProvPayBalance;
end;

procedure TFmPurchPay.ActAuditExecute(Sender: TObject);
Var
  Str,BillNo:String;
  sSysInfo : Variant;
begin
  Try
    If CdsPurchPay.IsEmpty Then Exit;
    If FEditMode>0 then Exit;
    If Application.MessageBox('确实要审核当前数据吗？','提示',4+32)<>6 Then Exit;
    str := 'CurrMonth';
    If CdsPurchPayPayKind.Value=1 Then Begin
      CdsPurchPay.Edit;
      CdsPurchPayAudit.Value := LogonInfo^.UserID;
      CdsPurchPayTransfer.Value := True;
      try
        CdsPurchPay.Post;
      Except
        CdsPurchPay.Cancel;
        Raise;
      end;
      If CdsPurchPay.ApplyUpdates(0)>0 Then
        Messagebox(Handle,Pchar('审核数据不成功！'),nil,16)
      Else begin
        ActAudit.Enabled:=False and CanAudit;
        ActRevert.Enabled:=True and CanRevert;
        Lab_State.Caption:='单据状态：已审核';
        Lab_State.Font.Color:=clRed;
        ActRefreshExecute(NIL);
      End;
      Exit;
    End;
    sSysInfo := SvrCommon.AppServer.GetSysInfo(iClientID,Str,1);
    If Not(VarIsNull(sSysInfo)) Then Begin
      If CdsPurchPayFDATE.Value<VarToDateTime(sSysInfo) Then Begin
        Messagebox(Handle,Pchar('该月已结算，不能操作已月结的单据！'),nil,16);
        Exit;
      End;
    End Else Begin
      Messagebox(Handle,Pchar('请先设置开帐日期...'),nil,16);
      Exit;
    End;
    BillNo  := CdsPurchPayBillNo.Value;
    If BillNo='' then Exit;
    If Not(SvrPurchPay.AppServer.BillAudit(iClientID, 'PurchPay',BillNo, '')) then
      Messagebox(Handle,Pchar('审核数据不成功！'),nil,16)
    Else Begin
      ActAudit.Enabled:=False;
      ActRevert.Enabled:=True;
      Lab_State.Caption:='单据状态：已审核';
      Lab_State.Font.Color:=clRed;
      ActRefreshExecute(NIL);
    End;
  Except
    On E:Exception Do
      Messagebox(Handle,Pchar(E.Message),nil,16);
  End;
End;

procedure TFmPurchPay.ActRevertExecute(Sender: TObject);
Var BillNo: String;
begin
  Try
    If CdsPurchPay.IsEmpty Then Exit;
    If FEditMode>0 then Exit;
    inherited;
    If Application.MessageBox('确实要还原当前已审核过的数据吗？','提示',4+32)<>6 Then Exit;
    BillNo  := CdsPurchPayBillNo.Value;
    If Not(SvrPurchPay.AppServer.BillRevert(iClientID,'PurchPay',BillNo,'')) Then Begin
      Messagebox(Handle,Pchar('还原数据不成功！'),nil,16);
    End Else Begin
      ActAudit.Enabled:=True and CanAudit;
      ActRevert.Enabled:=False and CanRevert;
      Lab_State.Caption:='单据状态：未审核';
      Lab_State.Font.Color:=clHotLight;
      ActRefreshExecute(Nil);
    End;
  Except
    On E:Exception Do
      Messagebox(Handle,Pchar(E.Message),nil,16);
  End;
End;

procedure TFmPurchPay.ActFieldLayoutExecute(Sender: TObject);
begin
  SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name,
                  [dbgPurchPayDtl],'采购付款明细');
end;

procedure TFmPurchPay.ActDataExportExecute(Sender: TObject);
begin
	ExportData([CdsPurchPay, CdsPurchPayDtl],'采购付款;采购付款明细', '');
end;

procedure TFmPurchPay.ActUpdateExecute(Sender: TObject);
begin
  If CdsPurchPay.IsEmpty Then Exit;
  If CdsPurchPayTransfer.Value  Then Begin
    Messagebox(Handle,Pchar('当前的采购付款单已审核，不能进行修改操作!'),nil,16);
    Exit;
  End;
  inherited;
  BeforeProvNo :='';  
end;

function TFmPurchPay.DoSome(cType: PChar; Values: Variant): Variant;
const
  cTypes = 'viewbill'#13'query';
  //       查看某单     查询
var sTypes: TStrings;
    i: integer;
    str, str2: String;
begin
  sTypes := TStringList.Create;
  sTypes.Text := cTypes;
  i := sTypes.IndexOf(cType);
  case i of
    0: begin//ViewBill
      if VarIsArray(Values) then begin
        str := Values[0];
        str2:= Values[1];
      end else begin
        str := Values;
        str2:= '';
      end;
      if str2='' then begin
        if sBillNoList.IndexOf(str)<0 then
          sBillNoList.Add(str);
      end else
        sBillNoList.Text := str2;
      self.BringToFront;
      SetCurrBillNo(str);
    end;
  end;
end;

procedure TFmPurchPay.ActInsertExecute(Sender: TObject);
begin
  inherited;
  BeforeProvNo :='';
end;

procedure TFmPurchPay.dbgPurchPayDtlColumns3EditButtonClick(
  Sender: TObject; var Handled: Boolean);
Var
  sBillNo : String;
begin
  sBillNo := CdsPurchPayDtlPBillNo.Value;
  SelectArrearage(CdsPurchPayDtl,sBillNo,False,False);
end;

procedure TFmPurchPay.CdsPurchPayDepartNoChange(Sender: TField);
Var
  sDepartNo,LogText:String;
  A:Variant;
begin
  if Not(CdsPurchPay.State in dsEditModes) Then Exit;
  If bBrowDepart Then Begin
    sDepartNo:=CdsPurchPayDepartNo.Value;
    If sDepartNo='' Then Exit;
    if sDepartNo=BeforeDepartNo Then Exit;
    BeforeDepartNo:=sDepartNo;
    A := SvrCommon.AppServer.GetDepartInfo(iClientID,sDepartNo,2,'DepartID,DepartName',LogText);
    CdsPurchPayDepartID.Value  := A[0];
    CdsPurchPayDepartName.Value:= A[1];
    If LogText<>'' Then Begin
      Messagebox(Handle,Pchar('无效的部门编号...'),nil,16);
      edDepartNo.SetFocus;
      Abort;
    End;
  End;
  GetProvPayBalance;
end;

procedure TFmPurchPay.RzDBButtonEdit1ButtonClick(Sender: TObject);
var iDepartID: Integer;
    DepartNo,DepartName: string;
begin
  If FEditMode=0 Then Exit;
  bBrowDepart := False;
  iDepartID := CdsPurchPayDepartID.Value;
  If SelectDepart(iDepartID,DepartNo,DepartName) Then Begin
    CdsPurchPayDepartID.Value := iDepartID;
    CdsPurchPayDepartNo.Value := DepartNo;
    CdsPurchPayDepartName.Value := DepartName;
  End;
  bBrowDepart := True;
end;

procedure TFmPurchPay.GetProvPayBalance;
Var iDepartID : Integer;
    sProvNo : String;
begin
  IF CdsPurchPayProvNo.IsNull Then Exit;
  If CdsPurchPayDepartID.IsNull Then Exit;
  dBalance := 0;
  sProvNo := CdsPurchPayProvNo.Value;
  iDepartID := CdsPurchPayDepartID.Value;
  If SvrPurchPay.AppServer.GetProvPayBalance(iClientID,sProvNo,iDepartID,dBalance) Then
  begin
    lbBalance.Caption := FormatFloat('#.00##', dBalance);
  end else
    lbBalance.Caption := '0.00';
end;

procedure TFmPurchPay.CdsPurchPayDtlPaidUpChange(Sender: TField);
begin
  If CdsPurchPayDtl.IsEmpty Then Exit;
  If CdsPurchPayDtlPaidUp.AsFloat >=CdsPurchPayDtlPUnPaid.AsFloat Then
    CdsPurchPayDtlSettle.Value := True
  Else
    CdsPurchPayDtlSettle.Value := False;
end;

procedure TFmPurchPay.GetSumMoney;
Var
  dCurrPay : Double;
  bPrePay : Boolean;
begin
  dCurrPay := CdsPurchPayCurrPay.AsFloat;
  bPrePay := CkPrePay.Checked;
  If bPrePay Then
    edUsableTotal.Value := dCurrPay+dBalance
  else
    edUsableTotal.Value := dCurrPay;
end;

procedure TFmPurchPay.CdsPurchPayCurrPayChange(Sender: TField);
begin
  If FEditMode>0 Then GetSumMoney;
end;

procedure TFmPurchPay.CkPrePayClick(Sender: TObject);
begin
//  PerForm(WM_NextDLGCTL,0,0);
  If FEditMode >0 Then GetSumMoney;
end;

procedure TFmPurchPay.btnAutoCalcClick(Sender: TObject);
var Mark1: TBookMark;
    d1, dTotal: Double;
begin
  If cbPayModes.ItemIndex=1 Then Begin
    Messagebox(Handle,Pchar('当前付款为预付款...'),'提示',64);
    Exit;
  End;
	dTotal := edUsableTotal.Value;
	with CdsPurchPayDtl do begin
  	If (State=dsInsert)or(State=dsEdit) then
    	Post;
    Mark1 := GetBookMark;
  	DisableControls;
    First;
    MoneyTotal := 1;
    while not Eof do begin
    	d1 := FieldByName('PUnPaid').AsFloat;
      Edit;
      if dTotal>=d1 then begin
	      FieldByName('PaidUp').AsFloat := d1;
        dTotal := dTotal-d1;
      end else begin
	      FieldByName('PaidUp').AsFloat := dTotal;
        dTotal := 0;
        MoneyTotal := -1;
      end;
      Post;
//      if dTotal=0 then Break;
      Next;
    end;
    edOverplus.Caption := FormatFloat('0.0000',dTotal);
    GotoBookmark(Mark1);
    FreeBookmark(Mark1);
    EnableControls;
  end;
end;

procedure TFmPurchPay.SumMoney;
Var dPaidUp,dPUnPaid : Double;
  Mark1 : TBookMark;
begin
  dPaidUp := 0 ; dPUnPaid := 0;
  With CdsPurchPayDtl Do Begin
    Mark1 := GetBookmark;
    DisableControls;
    First;
    While Not(Eof) Do Begin
      //dPaidUp := CdsPurchPayDtlPaidUp.Value+dPaidUp; //PaidUp:本次支付
      dPaidUp := CdsPurchPayPaidUp.Value+dPaidUp; //PaidUp:本次支付
      dPUnPaid := CdsPurchPayDtlPUnPaid.Value+dPUnPaid; //PUnPaid:欠付金额
      Next ;
    End;
    if dPaidUP > edUsableTotal.Value Then Begin
      MoneyTotal := -1;
    End Else Begin
      If dPaidUp < dPUnPaid Then
        MoneyTotal := -1
      Else
        MoneyTotal := 1;
    End;
    EnableControls;
    GotoBookmark(Mark1);
    FreeBookmark(Mark1);
  End;
end;

procedure TFmPurchPay.cbPayModesEnter(Sender: TObject);
begin
  inherited;
  If Not(CdsPurchPayDtl.IsEmpty) Then Begin
    If cbPayModes.ItemIndex = 0 Then Begin
      cbPayModes.Enabled := False;
    End;
  End;
end;

Initialization
  RegisterClass(TFmPurchPay);

Finalization
  RegisterClass(TFmPurchPay);
end.