sellpayfrm.~pas

医药连锁经营管理系统源码

    Exit;
  End;
  inherited;
end;

procedure TFmSellPay.edProvNameButtonClick(Sender: TObject);
Var sCustNo,sCustName:String;
begin
  If FEditMode=0 Then Exit;
  sCustNo := CdsSellPayCustNo.Value;
  If SelectCust(sCustNo,sCustName) Then Begin
    CdsSellPayCustNo.Value := sCustNo;
    CdsSellPayCustName.Value := sCustName;
  End;
End;

procedure TFmSellPay.ActAuditExecute(Sender: TObject);
Var
  Str,BillNo:String;
  sSysInfo : Variant;
begin
  Try
    If CdsSellPay.IsEmpty Then Exit;
    If FEditMode>0 then Exit;
    If Application.MessageBox('确实要审核当前数据吗？','提示',4+32)<>6 Then Exit;
    str := 'CurrMonth';
    If CdsSellPayPayKind.Value=1 Then Begin
      CdsSellPay.Edit;
      CdsSellPayAudit.Value := LogonInfo^.UserID;
      CdsSellPayTransfer.Value := True;
      If CdsSellPay.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 CdsSellPayFDATE.Value<VarToDateTime(sSysInfo) Then Begin
        Messagebox(Handle,Pchar('单据日期不对，系统已对该月做过月结...'),nil,16);
        Exit;
      End;
    End Else Begin
      Messagebox(Handle,Pchar('请先设置开帐日期...'),nil,16);
      Exit;
    End;
    BillNo  := CdsSellPayBillNo.Value;
    If BillNo='' then Exit;
    If Not(SvrSellPay.AppServer.BillAudit(iClientID, 'SellPay',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 TFmSellPay.ActRevertExecute(Sender: TObject);
Var BillNo: String;
begin
  Try
    If CdsSellPay.IsEmpty Then Exit;
    If FEditMode>0 then Exit;
    inherited;
    If Application.MessageBox('确实要还原当前已审核过的数据吗？','提示',4+32)<>6 Then Exit;
    BillNo  := CdsSellPayBillNo.Value;
    CdsSellPay.Edit;
    CdsSellPayAudit.Value := '';
    CdsSellPayTransfer.Value := False;
    If CdsSellPay.ApplyUpdates(0)>0 Then
      Messagebox(Handle,Pchar('审核数据不成功！'),nil,16)
    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 TFmSellPay.ActFieldLayoutExecute(Sender: TObject);
begin
  SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name,
                  [dbgPurchPayDtl],'采购付款明细');
end;

procedure TFmSellPay.ActDataExportExecute(Sender: TObject);
begin
	ExportData([CdsSellPay, CdsSellPayDtl],'采购付款;采购付款明细', '');
end;

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

function TFmSellPay.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 TFmSellPay.dbgPurchPayDtlColumns3EditButtonClick(
  Sender: TObject; var Handled: Boolean);
Var
  sBillNo : String;
begin
  sBillNo := CdsSellPayDtlPBillNo.Value;
  SelectGathering(CdsSellPayDtl,sBillNo,False,False);
end;

procedure TFmSellPay.GetCustPayBalance;
Var iDepartID : Integer;
    sCustNo : String;
begin
  dBalance := 0;
  IF CdsSellPayCustNo.IsNull Then Exit;
  If CdsSellPayDepartID.IsNull Then Exit;
  sCustNo := CdsSellPayCustNo.Value;
  iDepartID := CdsSellPayDepartID.Value;
  If SvrSellPay.AppServer.GetCustPayBalance(iClientID,sCustNo,iDepartID,dBalance) Then
  begin
    lbBalance.Caption := FormatFloat('#.00##', dBalance);
  end else
    lbBalance.Caption := '0.00';
end;

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

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

procedure TFmSellPay.GetSumMoney;
Var
  dCurrPay : Double;
  bPrePay : Boolean;
begin
  dCurrPay := CdsSellPayCurrPay.AsFloat;
  bPrePay := CdsSellPayUsePrePay.Value;
  If bPrePay Then
    edUsableTotal.Value := dCurrPay+dBalance
  else
    edUsableTotal.Value := dCurrPay;
end;

procedure TFmSellPay.Button1Click(Sender: TObject);
var Mark1: TBookMark;
    d1, dTotal: Double;
begin
  If cbPayModes.ItemIndex=1 Then Begin
    Messagebox(Handle,Pchar('当前付款为预付款...'),'提示',64);
    Exit;
  End;
  If CdsSellPayDtl.IsEmpty Then Exit;
	dTotal := edUsableTotal.Value;
	with CdsSellPayDtl 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 TFmSellPay.CdsSellPayCustNoChange(Sender: TField);
Var
  sCustNo,sCustName,LogText:String;
begin
  If Not(CdsSellPay.State in dsEditModes) Then Exit;
  sCustNo:=CdsSellPayCustNo.Value;
  If sCustNo='' Then Exit;
  if sCustNo=BeforeCustNo Then Exit;
  BeforeCustNo:=sCustNo;
  sCustName:=VarToStr(SvrCommon.AppServer.GetCustInfo(iClientID,sCustNo,1,'CustName',LogText));
  CdsSellPayCustName.Value:=sCustName;
  If LogText<>'' Then Begin
    Messagebox(Handle,Pchar(LogText),nil,16);
    Abort;
  End;
  GetCustPayBalance;
end;

procedure TFmSellPay.RzDBButtonEdit1ButtonClick(Sender: TObject);
var iDepartID: Integer;
    DepartNo,DepartName: string;
begin
  If FEditMode=0 Then Exit;
  bBrowDepart := False;
  iDepartID := CdsSellPayDepartID.Value;
  If SelectDepart(iDepartID,DepartNo,DepartName) Then Begin
    CdsSellPayDepartID.Value := iDepartID;
    CdsSellPayDepartNo.Value := DepartNo;
    CdsSellPayDepartName.Value := DepartName;
  End;
  bBrowDepart := True;
end;

procedure TFmSellPay.DBCheckBox1Click(Sender: TObject);
begin
  If FEditMode>0 Then GetSumMoney;
end;

procedure TFmSellPay.SumMoney;
Var dPaidUp,dPUnPaid : Double;
  Mark1 : TBookMark;
begin
  dPaidUp := 0 ; dPUnPaid := 0;
  With CdsSellPayDtl Do Begin
    Mark1 := GetBookmark;
    DisableControls;
    First;
    While Not(Eof) Do Begin
      dPaidUp := CdsSellPayDtlPaidUp.Value+dPaidUp;
      dPUnPaid := CdsSellPayDtlPUnPaid.Value+dPUnPaid;
      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 TFmSellPay.cbPayModesEnter(Sender: TObject);
begin
  inherited;
  If Not(CdsSellPayDtl.IsEmpty) Then Begin
    If cbPayModes.ItemIndex = 0 Then Begin
      cbPayModes.Enabled := False;
    End;
  End;
end;

procedure TFmSellPay.CdsSellPayDtlPaidUpChange(Sender: TField);
begin
  If CdsSellPayDtl.IsEmpty Then Exit;
  If CdsSellPayDtlPaidUp.AsFloat>=CdsSellPayDtlPUnPaid.AsFloat Then
    CdsSellPayDtlSettle.Value := True
  Else
    CdsSellPayDtlSettle.Value := False;
end;

Initialization
  RegisterClass(TFmSellPay);
Finalization
  RegisterClass(TFmSellPay);
end.