sellpayfrm.pas

群星医药系统源码

unit SellPayFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ceBaseBillFrm, ActnList, ModuleAction, ImgList, TB2Dock,
  ExtCtrls, RzPanel, TB2Item, TB2Toolbar, DB, DBClient, MConnect, StdCtrls,
  RzCmboBx, RzDBBnEd, RzButton, RzRadChk, RzDBChk, ComCtrls, RzDTP,
  RzDBDTP, Mask, RzEdit, RzDBEdit, Grids, DBGridEh, DbUtilsEh, EhLibCDS, xEhLibCtl, RzTabs,
  RzDBCmbo,dbFuncs, Menus, Buttons,ckDBClient,ShowProGress,uDataTypes,
  ceGlobal,SelectCustFrm, RzDBLbl, RzLabel,SelectDepartFrm;

type
  TFmSellPay = class(TceBaseBillForm)
    DComConn: TDCOMConnection;
    CdsSellPay: TckClientDataSet;
    DsSellPay: TDataSource;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    DBEdit1: TRzDBEdit;
    DBEdit6: TRzDBEdit;
    edCustNo: TRzDBEdit;
    DBEdit8: TRzDBEdit;
    DBEdit2: TRzDBDateTimePicker;
    Label16: TLabel;
    DBEdit16: TRzDBEdit;
    Lab_State: TLabel;
    edProvName: TRzDBButtonEdit;
    DsSellPayDtl: TDataSource;
    CdsSellPayDtl: TckClientDataSet;
    Label10: TLabel;
    RzDBEdit4: TRzDBEdit;
    cbPayModes: TRzComboBox;
    RzLabel7: TRzLabel;
    RzDBLabel1: TRzDBLabel;
    RzLabel16: TRzLabel;
    RzDBLabel2: TRzDBLabel;
    dbgPurchPayDtl: TxDBGridEh;
    CdsSellPayBillNo: TStringField;
    CdsSellPayFDate: TDateTimeField;
    CdsSellPayCustNo: TStringField;
    CdsSellPayCustName: TStringField;
    CdsSellPayPayKind: TSmallintField;
    CdsSellPayCurrPay: TBCDField;
    CdsSellPayChequeNo: TStringField;
    CdsSellPayUsePrePay: TBooleanField;
    CdsSellPayPrePay: TBCDField;
    CdsSellPayPaidUp: TBCDField;
    CdsSellPayAudit: TStringField;
    CdsSellPayTransfer: TBooleanField;
    CdsSellPayInvoice: TStringField;
    CdsSellPayRemark: TStringField;
    CdsSellPayCreater: TStringField;
    CdsSellPayCreatTime: TDateTimeField;
    CdsSellPayMender: TStringField;
    CdsSellPayUpdateTime: TDateTimeField;
    CdsSellPayGrup: TIntegerField;
    CdsSellPayAdsSellPayDtl: TDataSetField;
    CdsSellPayDtlBillNo: TStringField;
    CdsSellPayDtlItemNo: TIntegerField;
    CdsSellPayDtlPInOutKind: TSmallintField;
    CdsSellPayDtlPDate: TDateTimeField;
    CdsSellPayDtlPBillNo: TStringField;
    CdsSellPayDtlPItemNo: TIntegerField;
    CdsSellPayDtlPAmount: TBCDField;
    CdsSellPayDtlPPaidUp: TBCDField;
    CdsSellPayDtlPUnPaid: TBCDField;
    CdsSellPayDtlPaidUp: TBCDField;
    CdsSellPayDtlSettle: TBooleanField;
    Panel1: TPanel;
    Label14: TLabel;
    Label9: TLabel;
    Label11: TLabel;
    edPrePay: TRzDBLabel;
    edOverplus: TRzDBLabel;
    DBCheckBox1: TRzDBCheckBox;
    Label15: TLabel;
    RzDBEdit2: TRzDBEdit;
    Button1: TRzButton;
    Label4: TLabel;
    CdsSellPayDepartID: TIntegerField;
    CdsSellPayDepartNo: TStringField;
    CdsSellPayDepartName: TStringField;
    edDepartNo: TRzDBEdit;
    RzDBButtonEdit1: TRzDBButtonEdit;
    lbBalance: TLabel;
    edUsableTotal: TRzNumericEdit;
    procedure ActSaveExecute(Sender: TObject);
    procedure ActAddSubItemExecute(Sender: TObject);
    procedure ActDelSubItemExecute(Sender: TObject);
    procedure CdsSellPayAfterScroll(DataSet: TDataSet);
    procedure FormCreate(Sender: TObject);
    procedure CdsSellPayNewRecord(DataSet: TDataSet);
    procedure CdsSellPayDtlNewRecord(DataSet: TDataSet);
    procedure CdsSellPayDtlBeforeInsert(DataSet: TDataSet);
    procedure CdsSellPayReconcileError(DataSet: TCustomClientDataSet;
      E: EReconcileError; UpdateKind: TUpdateKind;
      var Action: TReconcileAction);
    procedure ActDeleteExecute(Sender: TObject);
    procedure edProvNameButtonClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ActAuditExecute(Sender: TObject);
    procedure ActRevertExecute(Sender: TObject);
    procedure ActFieldLayoutExecute(Sender: TObject);
    procedure ActDataExportExecute(Sender: TObject);
    procedure ActUpdateExecute(Sender: TObject);
    procedure dbgPurchPayDtlColumns3EditButtonClick(Sender: TObject;
      var Handled: Boolean);
    procedure CdsSellPayDepartNoChange(Sender: TField);
    procedure CdsSellPayCurrPayChange(Sender: TField);
    procedure Button1Click(Sender: TObject);
    procedure CdsSellPayCustNoChange(Sender: TField);
    procedure RzDBButtonEdit1ButtonClick(Sender: TObject);
    procedure DBCheckBox1Click(Sender: TObject);
    procedure cbPayModesEnter(Sender: TObject);
    procedure CdsSellPayDtlPaidUpChange(Sender: TField);
  private
    iLastItemNO,iClientID:Integer;
    CdsFieldProPerty:TCKClientDataSet;
    BeforeCustNo,BeforeDepartNo:String;
    MoneyTotal : Integer;
    LocSetting: PLocSetting;
    bBrowDepart,CanAudit, CanRevert : Boolean;
    dBalance: Double;//结余款(含预付款)
    SvrSellPay,SvrCommon:TDispatchConnection;
    Procedure GetCustPayBalance;
    Procedure GetSumMoney;
    Procedure SumMoney;
  public
    { Public declarations }
  protected
    Function DoSome(cType: PChar; Values: Variant): Variant; override;   
  end;
Const
  sFieldProPerty='Select * From SysFieldProPerty '+ 
       ' Where TableName in(''SellPay'',''SellPayDtl'', ''Goodses'')';
  sFilter=' TableName =''%s'' and Requisite ';
         
var
  FmSellPay: TFmSellPay;

implementation
uses FieldsLayoutFrm,DataExportFrm,SelectGatheringFrm;

{$R *.dfm}

procedure TFmSellPay.FormCreate(Sender: TObject);
begin
  inherited;
  dBalance := 0;
  CdsFieldProPerty:=TCKClientDataSet.Create(Self);
  LocSetting := IFmMain.IFmMainEx.GetLocSetting;
  CdsFieldProPerty.ProviderName:='DspTemp';
  SetGressHint('正在登录到销售收款服务器...');
  CanAudit := ActAudit.Enabled;
  CanRevert:= ActCancel.Enabled;
  iClientID:=LogonInfo^.ClientID;
  SvrSellPay:=IFmMain.GetConnection(Handle,'','ckSalesBase.SalesBase');

  sBillNoList.Text := SvrSellPay.AppServer.GetCurrMonthBills(iClientID, 'SellPay');

  CdsSellPay.RemoteServer:=SvrSellPay;
  SetGressHint('正在连接到公用信息服务器...');
  SvrCommon:=IFmMain.GetConnection(Handle,'','CommonSvr.CommonRDM');
  CdsFieldProPerty.RemoteServer:=SvrCommon;
  SetGressHint('读取用户操作权限...');
  IFmMain.SetActionStatus(ActionList1, hInstance, self.ClassName);
  SetLength(FDetailDataSets, 1);
  MasterDataSet:=CdsSellPay;
  sBillNoList.Text := SvrSellPay.AppServer.GetCurrMonthBills(iClientID, 'SellPay');
  FDetailDataSets[0] := CdsSellPayDtl;
  RepDataSetNames := '销售收款;销售收款明细';
  sRepSection := '销售收款';
  dbgPurchPayDtl.SetAutoSort('');
end;

procedure TFmSellPay.FormShow(Sender: TObject);
Var
  sTableNames:String;
Begin
  LoadFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name, [dbgPurchPayDtl]);
  SetGressHint('初始化本地环境...');
  SetGridEhColor(dbgPurchPayDtl);
  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFmSellPay.Xml');
  SetFieldProperty(CdsFieldProPerty,CdsSellPay, 'SellPay');
  SetFieldProperty(CdsFieldProPerty,CdsSellPayDtl, 'SellPayDtl,Goodses');
  SetGressHint('读取历史单据...');
  SetCurrBillIdx(0);
  inherited;
  FreeGressForm;
End;

procedure TFmSellPay.ActSaveExecute(Sender: TObject);
Var
  iIndex:Integer;
  dOverPlus : Double;
begin
  If  FEditMode=0 Then Exit;
  iIndex:=cbPayModes.ItemIndex;
  If iIndex=-1 Then Begin
    Messagebox(Handle,Pchar('收款类型不能为空!'),nil,16);
    Abort;
  End Else
    CdsSellPayPayKind.Value := iIndex;
  If CdsSellPayPayKind.Value=1 Then Begin  //保存预收款
    CdsSellPayPrePay.Value := CdsSellPayCurrPay.Value;
    If edCustNo.Text='' Then Begin
      Messagebox(Handle,Pchar('客户单位不能为空...'),'提示',64);
      Exit;
    End;
    If edDepartNo.Text='' Then Begin
      Messagebox(Handle,Pchar('收款部门不能为空...'),'提示',64);
      Exit;
    End;
    Inherited;
    Exit;
  End;
  dOverPlus := StrToFloat(edOverPlus.Caption);
  CdsSellPayPaidUp.Value := edUsableTotal.Value-dOverPlus;
  If CdsSellPayDtl.IsEmpty Then Begin
    MessageBox(Handle,Pchar('收款单的明细不能为空...'),'提示',64);
    Exit;
  End;
  SumMoney;
  If MoneyTotal < 0 Then Begin
    Messagebox(Handle,Pchar('[可用总金额]不足以付清应付款'),'提示',64);
    Exit;
  End;
  IF CdsSellPayDtl.State In dsEditModes Then
    CdsSellPayDtl.Post;
  Inherited;
End;

procedure TFmSellPay.ActAddSubItemExecute(Sender: TObject);
begin
  If FEditMode=0 Then Exit;
  if edCustNo.Text ='' Then Begin
    Messagebox(Handle,Pchar('客户单位不能为空...'),'提示',64);
    edCustNo.SetFocus;
    Exit;
  End;
  if edDepartNo.Text ='' Then Begin
    Messagebox(Handle,Pchar('收款部门不能为空...'),'提示',64);
    edDepartNo.SetFocus;
    Exit;
  End;
  If cbPayModes.ItemIndex=1 Then Begin
    Messagebox(Handle,Pchar('当前付款为预付款...'),'提示',64);
    Exit;
  End;
  CdsSellPayDtl.Append;
  SelectGathering(CdsSellPayDtl,'',True,True);
end;

procedure TFmSellPay.ActDelSubItemExecute(Sender: TObject);
begin
  If FEditMode=0 Then Exit;
  if CdsSellPayDtl.IsEmpty then Exit;
    CdsSellPayDtl.Delete;
end;

procedure TFmSellPay.CdsSellPayAfterScroll(DataSet: TDataSet);
Var
  iIndex:Integer;
  dPrePay,dCurrpay: Double;  
begin
  iIndex:=CdsSellPayPayKind.Value;
  if iIndex=-1 Then Exit;
  cbPayModes.ItemIndex:=iIndex;
  If CdsSellPayTransfer.Value Then Begin
    ActAudit.Enabled:=False and CanAudit;
    ActRevert.Enabled:=True and CanRevert;
    Lab_State.Caption:='单据状态：已审核';
    Lab_State.Font.Color:=clRed;
  End Else Begin
    ActAudit.Enabled:=True and CanAudit;
    ActRevert.Enabled:=False and CanRevert;
    Lab_State.Caption:='单据状态：未审核';
    Lab_State.Font.Color:=clHotLight;
  End;
  If CdsSellPayPayKind.Value=0 Then Begin
    dCurrPay:= CdsSellPayCurrPay.AsFloat;
    If CdsSellPayUsePrePay.Value Then Begin
      dPrePay := CdsSellPayPrePay.AsFloat;
    End Else
      dPrePay := 0.00;
    edUsableTotal.Value := dCurrPay+dPrePay;
    edOverPlus.Caption := FloatToStr(dCurrPay+dPrePay-CdsSellPayPaidUp.AsFloat);
  End;
End;

procedure TFmSellPay.CdsSellPayNewRecord(DataSet: TDataSet);
Var sCustNo,sCustName,DepartNo,DepartName : string;
  iDepartID : Integer;
begin
  BeforeCustNo:='';
//  edProvName.Button.Click;
  dbgPurchPayDtl.SumList.Active := False;
  dbgPurchPayDtl.SumList.Active := True;
  CdsSellPayBillNo.Value := BuildBillNo('SellPay');
  CdsSellPayCreater.Value := LogonInfo^.UserID;
  CdsSellPayGrup.Value := LogonInfo^.UserGrupID;
  CdsSellPayFDate.Value:=Date;
  If SelectCust(sCustNo,sCustName) Then Begin
    CdsSellPayCustNo.Value := sCustNo;
    CdsSellPayCustName.Value := sCustName;
  End;
  If SelectDepart(iDepartID,DepartNo,DepartName) Then Begin
    CdsSellPayDepartID.Value := iDepartID;
    CdsSellPayDepartNo.Value := DepartNo;
    CdsSellPayDepartName.Value := DepartName;
  End;
End;

procedure TFmSellPay.CdsSellPayDtlNewRecord(DataSet: TDataSet);
begin
  CdsSellPayDtlBILLNO.Value:=CdsSellPayBillNO.Value;
  CdsSellPayDtlItemNO.Value:=iLastItemNo+1;
  CdsSellPayDtlPDate.Value:=Date;  
end;

procedure TFmSellPay.CdsSellPayDtlBeforeInsert(DataSet: TDataSet);
begin
  iLastItemNO:=GetFieldMaxInt(CdsSellPayDtl,'ItemNO');
end;

Procedure TFmSellPay.CdsSellPayReconcileError(
  DataSet: TCustomClientDataSet; E: EReconcileError;
  UpdateKind: TUpdateKind; var Action: TReconcileAction);
begin
  Messagebox(Handle,Pchar(E.Message),'',16);
  Action:=RaAbort;
//  HandleReconcileError(DataSet,UpdateKind,E);
end;

procedure TFmSellPay.ActDeleteExecute(Sender: TObject);
begin
  If CdsSellPayTransfer.Value Then Begin
    Messagebox(Handle,Pchar('当前单据已[复核]，不能执行删除操作！'),'警告:',64);