pchreceivefrm.pas

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

unit PchReceiveFrm;

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,TransComp,uGlobal,ShowProGress,
  uDataTypes,ceGlobal,SelectProvFrm,SelectEmpFrm,SelectDepotFrm,iMainFrm,
  RzDBLbl, RzLabel,SelectProvLinkManFrm;

type
  TFmPchReceive = class(TceBaseBillForm)
    DComConn: TDCOMConnection;
    CdsPchReceive: TckClientDataSet;
    DsPchReceive: TDataSource;
    Label1: TLabel;
    Label2: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    DBEdit1: TRzDBEdit;
    DBEdit4: TRzDBEdit;
    DBEdit5: TRzDBEdit;
    DBEdit6: TRzDBEdit;
    DBEdit7: TRzDBEdit;
    DBEdit15: TRzDBDateTimePicker;
    DBCheckBox1: TRzDBCheckBox;
    Label17: TLabel;
    RzDBEdit1: TRzDBEdit;
    Label18: TLabel;
    RzDBEdit2: TRzDBEdit;
    Label12: TLabel;
    DBEdit12: TRzDBEdit;
    Label13: TLabel;
    DBEdit13: TRzDBEdit;
    Label16: TLabel;
    DBEdit16: TRzDBEdit;
    Label19: TLabel;
    RzDBEdit3: TRzDBEdit;
    Lab_State: TLabel;
    edProvName: TRzDBButtonEdit;
    DsPchReceiveDtl: TDataSource;
    CdsPchReceiveDtl: TckClientDataSet;
    CdsPchExpense: TckClientDataSet;
    DsPchExpense: TDataSource;
    PgC1: TRzPageControl;
    TabSelExportDtl: TRzTabSheet;
    TabSelExpense: TRzTabSheet;
    dbgPchExpense: TxDBGridEh;
    dbgPchReceiveDtl: TxDBGridEh;
    cbPayModes: TRzComboBox;
    RzDBButtonEdit1: TRzDBButtonEdit;
    CdsPchExpenseBillNo: TStringField;
    CdsPchExpenseExpenseType: TStringField;
    CdsPchExpenseAmount: TBCDField;
    CdsPchExpenseRemark: TStringField;
    CdsPchReceiveDtlBillNo: TStringField;
    CdsPchReceiveDtlItemNo: TIntegerField;
    CdsPchReceiveDtlGoodsID: TStringField;
    CdsPchReceiveDtlName: TStringField;
    CdsPchReceiveDtlSpecs: TStringField;
    CdsPchReceiveDtlUnit: TStringField;
    CdsPchReceiveDtlQty: TBCDField;
    CdsPchReceiveDtlprice: TFloatField;
    CdsPchReceiveDtlTaxRate: TBCDField;
    CdsPchReceiveDtlUnTaxprice: TFloatField;
    CdsPchReceiveDtlGoodsSum: TBCDField;
    CdsPchReceiveDtlTaxSum: TBCDField;
    CdsPchReceiveDtlAmount: TBCDField;
    CdsPchReceiveDtlBatchNo: TStringField;
    CdsPchReceiveDtlProdDate: TDateTimeField;
    CdsPchReceiveDtlValidDate: TDateTimeField;
    CdsPchReceiveDtlDepotID: TIntegerField;
    CdsPchReceiveDtlPBillNo: TStringField;
    CdsPchReceiveDtlPItemNo: TIntegerField;
    CdsPchReceiveDtlPaidUp: TBCDField;
    CdsPchReceiveDtlProvGoodsID: TStringField;
    CdsPchReceiveDtlDepotNo: TStringField;
    CdsPchReceiveDtlDepotName: TStringField;
    DBEdit2: TRzDBDateTimePicker;
    CdsPchReceiveFDate: TDateTimeField;
    CdsPchReceiveRefBillNo: TStringField;
    CdsPchReceiveEmpNo: TStringField;
    CdsPchReceiveName: TStringField;
    CdsPchReceiveAudit: TStringField;
    CdsPchReceiveProvNo: TStringField;
    CdsPchReceiveProvName: TStringField;
    CdsPchReceiveLinkMan: TStringField;
    CdsPchReceiveGoodsQty: TBCDField;
    CdsPchReceiveGoodsSum: TBCDField;
    CdsPchReceiveTaxRate: TBCDField;
    CdsPchReceiveTaxSum: TBCDField;
    CdsPchReceiveAmount: TBCDField;
    CdsPchReceivePayModeNo: TStringField;
    CdsPchReceivePayDate: TDateTimeField;
    CdsPchReceiveRemark: TStringField;
    CdsPchReceiveFungible: TBooleanField;
    CdsPchReceiveTransfer: TBooleanField;
    CdsPchReceiveGrup: TIntegerField;
    CdsPchReceiveInOutKind: TSmallintField;
    CdsPchReceiveCreater: TStringField;
    CdsPchReceiveMender: TStringField;
    CdsPchReceiveAdsPchExpense: TDataSetField;
    CdsPchReceiveAdsPchReceiveDtl: TDataSetField;
    CdsPchReceiveBillNo: TStringField;
    CdsTemp: TckClientDataSet;
    RzLabel7: TRzLabel;
    RzDBLabel1: TRzDBLabel;
    RzLabel16: TRzLabel;
    RzDBLabel2: TRzDBLabel;
    CdsPchReceiveCreatTime: TDateTimeField;
    RzDBButtonEdit2: TRzDBButtonEdit;
    CdsPchReceiveDtlWholeDepot: TIntegerField;
    CdsPchReceiveDtlWholeDepotNo: TStringField;
    CdsPchReceiveDtlWholeDepotName: TStringField;
    CdsPchReceiveDtlMidPackQty: TBCDField;
    CdsPchReceiveDtlBigPackQty: TBCDField;
    procedure ActInsertExecute(Sender: TObject);
    procedure ActUpdateExecute(Sender: TObject);
    procedure ActDeleteExecute(Sender: TObject);
    procedure ActSaveExecute(Sender: TObject);
    procedure ActAddSubItemExecute(Sender: TObject);
    procedure ActDelSubItemExecute(Sender: TObject);
    procedure CdsPchReceiveAfterScroll(DataSet: TDataSet);
    procedure FormCreate(Sender: TObject);
    procedure CdsPchReceiveNewRecord(DataSet: TDataSet);
    procedure CdsPchReceiveDtlNewRecord(DataSet: TDataSet);
    procedure CdsPchReceiveDtlBeforeInsert(DataSet: TDataSet);
    procedure CdsPchExpenseNewRecord(DataSet: TDataSet);
    procedure CdsPchReceiveReconcileError(DataSet: TCustomClientDataSet;
      E: EReconcileError; UpdateKind: TUpdateKind;
      var Action: TReconcileAction);
    procedure CdsPchReceiveDtlQTYChange(Sender: TField);
    procedure CdsPchReceiveDtlAfterPost(DataSet: TDataSet);
    procedure edProvNameButtonClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure RzDBButtonEdit1ButtonClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure dbgPchReceiveDtlEditButtonClick(Sender: TObject);
    procedure CdsPchReceiveDtlGoodsIDChange(Sender: TField);
    procedure CdsPchReceiveEmpNoChange(Sender: TField);
    procedure CdsPchReceiveProvNoChange(Sender: TField);
    procedure CdsPchReceiveDtlDepotNoChange(Sender: TField);
    procedure ActAuditExecute(Sender: TObject);
    procedure ActRevertExecute(Sender: TObject);
    procedure ActFieldLayoutExecute(Sender: TObject);
    procedure ActDataExportExecute(Sender: TObject);
    procedure RzDBButtonEdit2ButtonClick(Sender: TObject);
    procedure CdsPchReceiveDtlAfterOpen(DataSet: TDataSet);
    procedure CdsPchReceiveDtlProdDateChange(Sender: TField);
    procedure CdsPchReceiveDtlUnTaxpriceChange(Sender: TField);
    procedure CdsPchReceiveDtlTaxRateChange(Sender: TField);
    procedure CdsPchReceiveDtlpriceChange(Sender: TField);
  private
    bBrowGoods, bDateChanging, CanAudit, CanRevert: Boolean;
    iLastItemNO,iClientID:Integer;
    slPayModes:TStrings;
    LocSetting: PLocSetting;
    BeforeDepotNo,BeforeGoodsID,BeforeEmpNo,BeforeProvNo:String;
    SvrPchReceive,SvrCommon:TDispatchConnection;
    CdsFieldProPerty:TCKClientDataSet;
    Procedure ShowPayModes;  //显示结算方式
    procedure ParseGoodsInfo;
  public
    { Public declarations }
  protected
    Function DoSome(cType: PChar; Values: Variant): Variant; override;   
  end;

Const
  sPayModes='Select PayModeNo,PayModename,TimeLimit From PayModes order By PayModeNO';
  sFieldProPerty='Select * From SysFieldProPerty '+
      ' Where TableName In (''PchReceive'', ''PchReceiveDtl'', ''Goodses'',''PchExpense'')';

var
  FmPchReceive: TFmPchReceive;

implementation

uses SelectGoodsFrm,FieldsLayoutFrm,DataExportFrm,ViewGoodsPriceFrm;

{$R *.dfm}

procedure TFmPchReceive.FormCreate(Sender: TObject);
begin
  inherited;
  CdsFieldProPerty:=TCKClientDataSet.Create(Self);
  slPayModes:=TStringList.Create;
  LocSetting := IFmMain.IFmMainEx.GetLocSetting;
  SetGressHint('正在登录到入库通知单服务器...');
  CanAudit := ActAudit.Enabled;
  CanRevert:= ActCancel.Enabled;
  iClientID:=LogonInfo^.ClientID;
  SvrPchReceive:=IFmMain.GetConnection(Handle,'','CKPurchInBase.PurchInRDM');
  sBillNoList.Text := SvrPchReceive.AppServer.GetCurrMonthBills(iClientID, 'PchReceive');

  SetGressHint('正在连接到公用信息服务器...');
  SvrCommon:=IFmMain.GetConnection(Handle,'','CommonSvr.CommonRDM');
  CdsFieldProPerty.ProviderName:='DspTemp';
  CdsFieldProPerty.RemoteServer:=SvrCommon;
  SetGressHint('读取用户操作权限...');
  IFmMain.SetActionStatus(ActionList1, hInstance, self.ClassName);
  CdsPchReceive.RemoteServer:=SvrPchReceive;
  SetLength(FDetailDataSets, 2);
  BillType :='PchReceive';
  FDetailDataSets[0] := CdsPchReceiveDtl;
  FDetailDataSets[1] := CdsPchExpense;
  RepDataSetNames := '入库通知单;入库通知明细;入库通知费用';
  sRepSection := '入库通知单';
  MasterDataSet:=CdsPchReceive;
  dbgPchReceiveDtl.SetAutoSort('');
  dbgPchExpense.SetAutoSort('');  
end;

procedure TFmPchReceive.FormShow(Sender: TObject);
Begin
  LoadFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name, [dbgPchReceiveDtl,dbgPchExpense]);
  SetGressHint('初始化本地环境...');
  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFmPchReceive.Xml');
  SetFieldProperty(CdsFieldProPerty, CdsPchReceive, 'PchReceive');
  SetFieldProperty(CdsFieldProPerty, CdsPchReceiveDtl, 'PchReceiveDtl,Goodses');
  SetFieldProperty(CdsFieldProPerty, CdsPchExpense, 'PchExpense');
  SetGressHint('读取历史单据...');
  ShowPayModes;
  SetCurrBillIdx(0);
  FreeGressForm;
  inherited;
End;

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

procedure TFmPchReceive.ActUpdateExecute(Sender: TObject);
begin
  If CdsPchReceiveTransfer.Value  Then Begin
    Messagebox(Handle,Pchar('当前单据已[审核]，不能进行编辑操作!'),nil,16);
    Exit;
  End;
  inherited;
  BeforeProvNo:='';
  BeforeEmpNo :='';
end;

procedure TFmPchReceive.ActDeleteExecute(Sender: TObject);
begin
  Try
    If CdsPchReceiveTransfer.Value Then Begin
      Messagebox(Handle,Pchar('当前单据已[复核]，不能执行删除操作！'),'警告:',64);
      Exit;
    End;
    inherited;
  Except
    On E:Exception Do
      Messagebox(Handle,Pchar(E.Message),'',16);
  End;
End;

procedure TFmPchReceive.ActSaveExecute(Sender: TObject);
Var iIndex:Integer;
begin
  Try
    If  FEditMode=0 Then Exit;
    iIndex:=cbPayModes.ItemIndex;
    if iIndex<>-1 Then
    Begin
      CdsPchReceivePayModeNo.Value:=slPayModes[iIndex];
    End;
    edProvName.SetFocus;
    IF CdsPchReceiveDtl.State In dsEditModes Then
      CdsPchreceiveDtl.Post;
    If CdsPchExpense.State in dsEditModes Then
      CdsPchExpense.Post;
    Inherited;
  Except
    On E:Exception Do
      Application.MessageBox(Pchar(E.Message),'',16);
  End;
End;

procedure TFmPchReceive.ActAddSubItemExecute(Sender: TObject);
begin
  If FEditMode=0 Then Exit;
  If Not(CdsPchReceive.State In dsEditModes) Then Exit;
  If Pgc1.ActivePageIndex=0 Then
    CdsPchReceiveDtl.Append
  Else
    CdsPchExpense.Append;
end;

procedure TFmPchReceive.ActDelSubItemExecute(Sender: TObject);
begin
  If FEditMode=0 Then Exit;
  IF PgC1.ActivePageIndex=0 Then Begin
	  if CdsPchReceiveDtl.IsEmpty then Exit;
    CdsPchReceiveDtl.Delete;
  End Else Begin
  	if CdsPchExpense.IsEmpty then Exit;
    CdsPchExpense.Delete;
  End;
end;

procedure TFmPchReceive.CdsPchReceiveAfterScroll(DataSet: TDataSet);
Var sModeNo:String;
    iIndex:Integer;
begin
  sModeNo:=CdsPchReceivePayModeNo.Value;
  iIndex:=slPayModes.IndexOf(sModeNO);
  cbPayModes.ItemIndex:=iIndex;
  If CdsPchReceiveTransfer.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;
End;

procedure TFmPchReceive.CdsPchReceiveNewRecord(DataSet: TDataSet);
begin
  edProvName.Button.Click;
  CdsPchReceiveBillNo.Value:= BuildBillNo('PchReceive');
  CdsPchReceiveCreater.Value := LogonInfo^.UserID;
  CdsPchReceiveGrup.Value := LogonInfo^.UserGrupID;
  CdsPchReceiveInOutKind.Value:=0;
  CdsPchReceiveFDate.Value:=Date;
  CdsPchReceivePayDate.Value:=Date;
  CdsPchReceiveGoodsQty.Value := 0;
  CdsPchReceiveGoodsSum.Value := 0;
  CdsPchReceiveTaxRate.Value := 0;
  CdsPchReceiveTaxSum.Value := 0;
  CdsPchReceiveAmount.Value := 0;
end;

procedure TFmPchReceive.CdsPchReceiveDtlNewRecord(DataSet: TDataSet);
begin
  BeforeGoodsID:='';
  CdsPchReceiveDtlBILLNO.Value:=CdsPchReceiveBillNO.Value;
  CdsPchReceiveDtlItemNO.Value:=iLastItemNO+1;
end;

procedure TFmPchReceive.CdsPchReceiveDtlBeforeInsert(DataSet: TDataSet);
begin
  iLastItemNO:=GetFieldMaxInt(CdsPchReceiveDtl,'ItemNO');
end;

procedure TFmPchReceive.CdsPchExpenseNewRecord(DataSet: TDataSet);
begin
  CdsPchExpenseBillNo.Value:=CdsPchReceiveBillNo.Value;
end;

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

procedure TFmPchReceive.CdsPchReceiveDtlQTYChange(Sender: TField);
var str: String;
begin
  //实际单价 = 单价 * 折扣
  str := LowerCase(dbgPchReceiveDtl.SelectedField.FieldName);
  if str='goodsid' then
    CdsPchReceiveDtlUnTaxprice.AsFloat := CdsPchReceiveDtlprice.AsFloat / (1 + cdsPchReceiveDtlTaxRate.AsFloat/ 100);

  //货款 = 数量 * 未税单价    合计 = 数量 * 单价    税款 = 合计 - 货款
  CdsPchReceiveDtlGoodsSum.AsFloat := CdsPchReceiveDtlQty.AsFloat * CdsPchReceiveDtlUnTaxPrice.AsFloat;
  CdsPchReceiveDtlAmount.AsFloat := CdsPchReceiveDtlQty.AsFloat * CdsPchReceiveDtlPrice.AsFloat;
  CdsPchReceiveDtlTaxSum.AsFloat := CdsPchReceiveDtlAmount.AsFloat - CdsPchReceiveDtlGoodsSum.AsFloat;
End;

procedure TFmPchReceive.CdsPchReceiveDtlUnTaxpriceChange(Sender: TField);
begin
  if dbgPchReceiveDtl.SelectedField.FieldName = Sender.FieldName then
  begin;
    CdsPchReceiveDtlPrice.AsFloat   := Sender.AsFloat * ( 1 + CdsPchReceiveDtlTaxRate.AsFloat / 100 );
    CdsPchReceiveDtlGoodsSum.AsFloat:= cdsPchReceiveDtlQty.AsFloat * CdsPchReceiveDtlUnTaxPrice.AsFloat;
    CdsPchReceiveDtlAmount.AsFloat := cdsPchReceiveDtlQty.AsFloat*cdsPchReceiveDtlPrice.AsFloat;
    CdsPchReceiveDtlTaxSum.AsFloat  := CdsPchReceiveDtlAmount.AsFloat - CdsPchReceiveDtlGoodsSum.AsFloat;
  end;
end;

procedure TFmPchReceive.CdsPchReceiveDtlTaxRateChange(Sender: TField);
begin
  if dbgPchReceiveDtl.SelectedField.FieldName = Sender.FieldName then
  begin
    CdsPchReceiveDtlUnTaxPrice.AsFloat := CdsPchReceiveDtlPrice.AsFloat / ( 1 + CdsPchReceiveDtlTaxRate.AsFloat / 100 );
    CdsPchReceiveDtlGoodsSum.AsFloat := cdsPchReceiveDtlQty.AsFloat*CdsPchReceiveDtlUnTaxPrice.AsFloat;
    CdsPchReceiveDtlTaxSum.AsFloat := CdsPchReceiveDtlAmount.AsFloat-CdsPchReceiveDtlGoodsSum.AsFloat;
  end;
end;