purchpayfrm.pas

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

unit PurchPayFrm;

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, ckDBClient, DBGridEh, DbUtilsEh, EhLibCDS,
  xEhLibCtl, RzLabel, RzDBLbl, RzTabs,RzDBCmbo,dbFuncs, Menus, Buttons,
  ShowProGress,uDataTypes,ceGlobal,SelectProvFrm, DBSumLst,SelectDepartFrm;

type
  TFmPurchPay = class(TceBaseBillForm)
    DComConn: TDCOMConnection;
    CdsPurchPay: TckClientDataSet;
    DsPurchPay: TDataSource;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    DBEdit1: TRzDBEdit;
    DBEdit6: TRzDBEdit;
    edProvNo: TRzDBEdit;
    DBEdit8: TRzDBEdit;
    DBEdit2: TRzDBDateTimePicker;
    Label16: TLabel;
    DBEdit16: TRzDBEdit;
    Lab_State: TLabel;
    edProvName: TRzDBButtonEdit;
    DsPurchPayDtl: TDataSource;
    CdsPurchPayDtl: TckClientDataSet;
    Label10: TLabel;
    RzDBEdit4: TRzDBEdit;
    CdsPurchPayBillNo: TStringField;
    CdsPurchPayFDATE: TDateTimeField;
    CdsPurchPayProvNo: TStringField;
    CdsPurchPayProvName: TStringField;
    CdsPurchPayPayKind: TSmallintField;
    CdsPurchPayCurrPay: TBCDField;
    CdsPurchPayChequeNo: TStringField;
    CdsPurchPayUsePrePay: TBooleanField;
    CdsPurchPayPrePay: TBCDField;
    CdsPurchPayPaidUp: TBCDField;
    CdsPurchPayAudit: TStringField;
    CdsPurchPayTransfer: TBooleanField;
    CdsPurchPayInvoice: TStringField;
    CdsPurchPayRemark: TStringField;
    CdsPurchPayAdsPurchPayDtl: TDataSetField;
    cbPayModes: TRzComboBox;
    RzLabel7: TRzLabel;
    RzDBLabel1: TRzDBLabel;
    RzLabel16: TRzLabel;
    RzDBLabel2: TRzDBLabel;
    CdsPurchPayCreater: TStringField;
    CdsPurchPayCreatTime: TDateTimeField;
    dbgPurchPayDtl: TxDBGridEh;
    CdsPurchPayMender: TStringField;
    CdsPurchPayUpdateTime: TDateTimeField;
    CdsPurchPayGrup: TIntegerField;
    Label15: TLabel;
    RzDBEdit2: TRzDBEdit;
    Panel1: TPanel;
    Label14: TLabel;
    CkPrePay: TRzDBCheckBox;
    Label4: TLabel;
    Label9: TLabel;
    edPrePay: TRzDBLabel;
    edOverplus: TRzDBLabel;
    CdsPurchPayDepartID: TIntegerField;
    CdsPurchPayDepartNo: TStringField;
    CdsPurchPayDepartName: TStringField;
    Label5: TLabel;
    edDepartNo: TRzDBEdit;
    RzDBButtonEdit1: TRzDBButtonEdit;
    btnAutoCalc: TRzButton;
    lbBalance: TLabel;
    edUsableTotal: TRzNumericEdit;
    CdsPurchPayDtlBillNo: TStringField;
    CdsPurchPayDtlItemNo: TIntegerField;
    CdsPurchPayDtlPInOutKind: TSmallintField;
    CdsPurchPayDtlPDate: TDateTimeField;
    CdsPurchPayDtlPBillNo: TStringField;
    CdsPurchPayDtlPItemNo: TIntegerField;
    CdsPurchPayDtlPAmount: TBCDField;
    CdsPurchPayDtlPPaidUp: TBCDField;
    CdsPurchPayDtlPUnPaid: TBCDField;
    CdsPurchPayDtlPaidUp: TBCDField;
    CdsPurchPayDtlSettle: TBooleanField;
    procedure ActSaveExecute(Sender: TObject);
    procedure ActAddSubItemExecute(Sender: TObject);
    procedure ActDelSubItemExecute(Sender: TObject);
    procedure CdsPurchPayAfterScroll(DataSet: TDataSet);
    procedure FormCreate(Sender: TObject);
    procedure CdsPurchPayNewRecord(DataSet: TDataSet);
    procedure CdsPurchPayDtlNewRecord(DataSet: TDataSet);
    procedure CdsPurchPayDtlBeforeInsert(DataSet: TDataSet);
    procedure CdsPurchPayReconcileError(DataSet: TCustomClientDataSet;
      E: EReconcileError; UpdateKind: TUpdateKind;
      var Action: TReconcileAction);
    procedure ActDeleteExecute(Sender: TObject);
    procedure edProvNameButtonClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure CdsPurchPayProvNoChange(Sender: TField);
    procedure ActAuditExecute(Sender: TObject);
    procedure ActRevertExecute(Sender: TObject);
    procedure ActFieldLayoutExecute(Sender: TObject);
    procedure ActDataExportExecute(Sender: TObject);
    procedure ActUpdateExecute(Sender: TObject);
    procedure ActInsertExecute(Sender: TObject);
    procedure dbgPurchPayDtlColumns3EditButtonClick(Sender: TObject;
      var Handled: Boolean);
    procedure CdsPurchPayDepartNoChange(Sender: TField);
    procedure RzDBButtonEdit1ButtonClick(Sender: TObject);
    procedure CdsPurchPayDtlPaidUpChange(Sender: TField);
    procedure CdsPurchPayCurrPayChange(Sender: TField);
    procedure CkPrePayClick(Sender: TObject);
    procedure btnAutoCalcClick(Sender: TObject);
    procedure cbPayModesEnter(Sender: TObject);
  private
    iLastItemNO,iClientID:Integer;
    CdsFieldProPerty:TCKClientDataSet;
    BeforeProvNo,BeforeDepartNo:String;
    LocSetting: PLocSetting;
    bBrowDepart, CanAudit, CanRevert: Boolean;
    MoneyTotal : Double;
    dBalance: Double;//结余款(含预付款)
    SvrPurchPay,SvrCommon:TDispatchConnection;
    Procedure GetProvPayBalance;
    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(''PurchPay'',''PurchPayDtl'', ''Goodses'')';
  sFilter=' TableName =''%s'' and Requisite ';

var
  FmPurchPay: TFmPurchPay;

implementation
uses FieldsLayoutFrm,DataExportFrm,SelectArrearageFrm;

{$R *.dfm}

procedure TFmPurchPay.FormCreate(Sender: TObject);
begin
  inherited;
  dBalance := 0; 
  bBrowDepart := True;
  CdsFieldProPerty:=TCKClientDataSet.Create(Self);
  LocSetting := IFmMain.IFmMainEx.GetLocSetting;
  CdsFieldProPerty.ProviderName:='DspTemp';
  SetGressHint('正在登录到采购付款服务器...');
  CanAudit := ActAudit.Enabled;
  CanRevert:= ActCancel.Enabled;
  iClientID:=LogonInfo^.ClientID;
  SvrPurchPay:=IFmMain.GetConnection(Handle,'','CKPurchInBase.PurchInRDM');

  sBillNoList.Text := SvrPurchPay.AppServer.GetCurrMonthBills(iClientID, 'PurchPay');

  CdsPurchPay.RemoteServer:=SvrPurchPay;
  SetGressHint('正在连接到公用信息服务器...');
  SvrCommon:=IFmMain.GetConnection(Handle,'','CommonSvr.CommonRDM');
  CdsFieldProPerty.RemoteServer:=SvrCommon;
  SetGressHint('读取用户操作权限...');
  IFmMain.SetActionStatus(ActionList1, hInstance, self.ClassName);
  SetLength(FDetailDataSets, 1);
  FDetailDataSets[0] := CdsPurchPayDtl;
  RepDataSetNames := '采购付款;采购付款明细';
  sRepSection := '采购付款';
  MasterDataSet:=CdsPurchPay;
  dbgPurchPayDtl.SetAutoSort(''); 
end;

procedure TFmPurchPay.FormShow(Sender: TObject);
Begin
  LoadFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name, [dbgPurchPayDtl]);
  SetGressHint('初始化本地环境...');
  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFmPurchPay.Xml');
  SetFieldProperty(CdsFieldProPerty,CdsPurchPay, 'PurchPay');
  SetFieldProperty(CdsFieldProPerty,CdsPurchPayDtl, 'PurchPayDtl,Goodses');
  SetGressHint('读取历史单据...');
  SetCurrBillIdx(0);
  inherited;
  FreeGressForm;
End;

procedure TFmPurchPay.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
    CdsPurchPayPayKind.Value := iIndex;
  If CdsPurchPayPayKind.Value=1 Then Begin  //保存预付款
    CdsPurchPayPrePay.Value := CdsPurchPayCurrPay.Value;
    If edProvNo.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);
  CdsPurchPayPaidUp.Value := edUsableTotal.Value-dOverPlus;
  If CkPrePay.Checked Then
    CdsPurchPayPrePay.Value := edUsableTotal.Value-dOverPlus-CdsPurchPayCurrPay.Value;
  If CdsPurchPayDtl.IsEmpty Then Begin
    MessageBox(Handle,Pchar('付款单的明细不能为空...'),'提示',64);
    Exit;
  End;
  SumMoney;
  If MoneyTotal < 0 Then Begin
    Messagebox(Handle,Pchar('[可用总金额]不足以付清应付款'),'提示',64);
    Exit;
  End;
  IF CdsPurchPayDtl.State In dsEditModes Then
    CdsPurchPayDtl.Post;
  Inherited;
End;

procedure TFmPurchPay.ActAddSubItemExecute(Sender: TObject);
begin
  If FEditMode=0 Then Exit;
  if edProvNo.Text ='' Then Begin
    Messagebox(Handle,Pchar('供应厂商不能为空...'),'提示',64);
    edProvNo.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;
  CdsPurchPayDtl.Append;
  SelectArrearage(CdsPurchPayDtl,'',True,True);
  if cdsPurchPayDtl.FieldByName('PItemNo').Value = null then
    cdsPurchPayDtl.Cancel;
end;

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

procedure TFmPurchPay.CdsPurchPayAfterScroll(DataSet: TDataSet);
Var
  iIndex:Integer;
  dPrePay,dCurrpay: Double;
begin
  iIndex:=CdsPurchPayPayKind.Value;
  if iIndex=-1 Then Exit;
  cbPayModes.ItemIndex:=iIndex;
  If CdsPurchPayTransfer.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 CdsPurchPayPayKind.Value=0 Then Begin
    dCurrPay:= CdsPurchPayCurrPay.AsFloat;
    If CdsPurchPayUsePrePay.Value Then Begin
      dPrePay := CdsPurchPayPrePay.AsFloat;
    End Else
      dPrePay := 0.00;
    edUsableTotal.Value := dCurrPay+dPrePay;
    edOverPlus.Caption := FloatToStr(dCurrPay+dPrePay-CdsPurchPayPaidUp.AsFloat);
  End;
End;

procedure TFmPurchPay.CdsPurchPayNewRecord(DataSet: TDataSet);
Var  sProvNo,sProvName,DepartNo,DepartName : string;
  iDepartID : Integer;
begin
//  edProvName.Button.Click;
  CdsPurchPayBillNo.Value := BuildBillNo('PurchPay');
  CdsPurchPayCreater.Value := LogonInfo^.UserID;
  CdsPurchPayGrup.Value := LogonInfo^.UserGrupID;
  CdsPurchPayFDate.Value:=Date;
  CdsPurchPayCurrPay.Value := 0;
  CdsPurchPayPaidUp.Value := 0;
  CdsPurchPayPayKind.Value := 0;
  CdsPurchPayPrePay.Value := 0;
  dbgPurchPayDtl.SumList.Active := False;
  dbgPurchPayDtl.SumList.Active := True;
  If SelectProv(sProvNo,sProvName) Then Begin
    CdsPurchPayProvNo.Value := sProvNo;
    CdsPurchPayProvName.Value := sProvName;
  End;
  If SelectDepart(iDepartID,DepartNo,DepartName) Then Begin
    CdsPurchPayDepartID.Value := iDepartID;
    CdsPurchPayDepartNo.Value := DepartNo;
    CdsPurchPayDepartName.Value := DepartName;
  End;
end;

procedure TFmPurchPay.CdsPurchPayDtlNewRecord(DataSet: TDataSet);
begin
  CdsPurchPayDtlBILLNO.Value:=CdsPurchPayBillNO.Value;
  CdsPurchPayDtlItemNO.Value:=iLastItemNo+1;
  CdsPurchPayDtlPDate.Value:=Date;  
end;

procedure TFmPurchPay.CdsPurchPayDtlBeforeInsert(DataSet: TDataSet);
begin
  iLastItemNO:=GetFieldMaxInt(CdsPurchPayDtl,'ItemNO');
end;

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

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