selsendoutfrm.pas

群星医药系统源码

Unit SelSendOutFrm;
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,SelectCustFrm,SelectEmpFrm,SelectDepotFrm,iMainFrm,
  RzDBLbl, RzLabel,SelectCustLinkManFrm;

type
  TFmSelSendOut = class(TceBaseBillForm)
    DComConn: TDCOMConnection;
    CdsSelSendOut: TckClientDataSet;
    DsSelSendOut: TDataSource;
    Label1: TLabel;
    Label2: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    edBillNo: 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;
    Lab_State: TLabel;
    edProvName: TRzDBButtonEdit;
    DsSelSendOutDtl: TDataSource;
    CdsSelSendOutDtl: TckClientDataSet;
    cbPayModes: TRzComboBox;
    RzDBButtonEdit1: TRzDBButtonEdit;
    DBEdit2: TRzDBDateTimePicker;
    dbgSelSendOutDtl: TxDBGridEh;
    CdsSelSendOutBillNo: TStringField;
    CdsSelSendOutFDate: TDateTimeField;
    CdsSelSendOutInOutKind: TSmallintField;
    CdsSelSendOutRefBillNo: TStringField;
    CdsSelSendOutEmpNo: TStringField;
    CdsSelSendOutEmpName: TStringField;
    CdsSelSendOutAudit: TStringField;
    CdsSelSendOutCustNo: TStringField;
    CdsSelSendOutCustName: TStringField;
    CdsSelSendOutLinkMan: TStringField;
    CdsSelSendOutGoodsQty: TBCDField;
    CdsSelSendOutGoodsSum: TBCDField;
    CdsSelSendOutTaxSum: TBCDField;
    CdsSelSendOutAmount: TBCDField;
    CdsSelSendOutPayModeNo: TStringField;
    CdsSelSendOutPayDate: TDateTimeField;
    CdsSelSendOutRemark: TStringField;
    CdsSelSendOutFungible: TBooleanField;
    CdsSelSendOutTransfer: TBooleanField;
    CdsSelSendOutCreater: TStringField;
    CdsSelSendOutMender: TStringField;
    CdsSelSendOutGrup: TIntegerField;
    CdsSelSendOutAdsSelSendOutDtl: TDataSetField;
    CdsSelSendOutDtlBillNo: TStringField;
    CdsSelSendOutDtlItemNo: TIntegerField;
    CdsSelSendOutDtlGoodsID: TStringField;
    CdsSelSendOutDtlName: TStringField;
    CdsSelSendOutDtlSpecs: TStringField;
    CdsSelSendOutDtlUnit: TStringField;
    CdsSelSendOutDtlPrice: TFloatField;
    CdsSelSendOutDtlTaxRate: TBCDField;
    CdsSelSendOutDtlUnTaxPrice: TFloatField;
    CdsSelSendOutDtlGoodsSum: TBCDField;
    CdsSelSendOutDtlTaxSum: TBCDField;
    CdsSelSendOutDtlAmount: TBCDField;
    CdsSelSendOutDtlBatchNo: TStringField;
    CdsSelSendOutDtlProdDate: TDateTimeField;
    CdsSelSendOutDtlValidDate: TDateTimeField;
    CdsSelSendOutDtlDepotID: TIntegerField;
    CdsSelSendOutDtlDepotNo: TStringField;
    CdsSelSendOutDtlDepotName: TStringField;
    CdsSelSendOutDtlPBillNo: TStringField;
    CdsSelSendOutDtlPItemNo: TIntegerField;
    CdsSelSendOutDtlPaidUp: TBCDField;
    CdsSelSendOutDtlCustGoodsID: TStringField;
    CdsSelSendOutDtlQty: TBCDField;
    RzLabel7: TRzLabel;
    RzDBLabel1: TRzDBLabel;
    RzLabel16: TRzLabel;
    RzDBLabel2: TRzDBLabel;
    CdsSelSendOutCreatTime: TDateTimeField;
    RzDBButtonEdit2: TRzDBButtonEdit;
    procedure ActUpdateExecute(Sender: TObject);
    procedure ActDeleteExecute(Sender: TObject);
    procedure ActSaveExecute(Sender: TObject);
    procedure ActAddSubItemExecute(Sender: TObject);
    procedure ActDelSubItemExecute(Sender: TObject);
    procedure CdsSelSendOutAfterScroll(DataSet: TDataSet);
    procedure FormCreate(Sender: TObject);
    procedure CdsSelSendOutNewRecord(DataSet: TDataSet);
    procedure CdsSelSendOutDtlNewRecord(DataSet: TDataSet);
    procedure CdsSelSendOutDtlBeforeInsert(DataSet: TDataSet);
    procedure CdsSelSendOutReconcileError(DataSet: TCustomClientDataSet;
      E: EReconcileError; UpdateKind: TUpdateKind;
      var Action: TReconcileAction);
    procedure CdsSelSendOutDtlpriceChange(Sender: TField);
    procedure CdsSelSendOutDtlAfterPost(DataSet: TDataSet);
    procedure edProvNameButtonClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure RzDBButtonEdit1ButtonClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure dbgSelSendOutDtlEditButtonClick(Sender: TObject);
    procedure CdsSelSendOutDtlGoodsIDChange(Sender: TField);
    procedure CdsSelSendOutEmpNoChange(Sender: TField);
    procedure CdsSelSendOutCustNoChange(Sender: TField);
    procedure CdsSelSendOutDtlDepotNoChange(Sender: TField);
    procedure ActAuditExecute(Sender: TObject);
    procedure ActRevertExecute(Sender: TObject);
    procedure ActFieldLayoutExecute(Sender: TObject);
    procedure ActDataExportExecute(Sender: TObject);
    procedure RzDBButtonEdit2ButtonClick(Sender: TObject);
    procedure ActQueryExecute(Sender: TObject);
  private
    bBrowGoods,CanAudit, CanRevert: Boolean;
    iLastItemNO,iClientID:Integer;
    slPayModes:TStrings;
    LocSetting: PLocSetting;
    BeforeDepotNo,FlagGoodsID,BeforeGoodsID,BeforeEmpNo,BeforeCustNo:String;
    SvrSelSendOut,SvrCommon:TDispatchConnection;
    CdsFieldProPerty:TCKClientDataSet;
    Procedure SumCount;
    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(''SelSendOut'', ''SelSendOutDtl'', ''Goodses'',''Depots'')';

var
  FmSelSendOut: TFmSelSendOut;

implementation

uses SelectGoodsFrm,FieldsLayoutFrm,DataExportFrm,ViewGoodsPriceFrm;

{$R *.dfm}

procedure TFmSelSendOut.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;
  SvrSelSendOut := IFmMain.GetConnection(Handle,'','ckSalesBase.SalesBase');

  sBillNoList.Text := SvrSelSendOut.AppServer.GetCurrMonthBills(iClientID, 'SelSendOut');

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

procedure TFmSelSendOut.FormShow(Sender: TObject);
Begin
  LoadFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name, [dbgSelSendOutDtl]);
  SetGressHint('初始化本地环境...');
  SetGridEhColor(dbgSelSendOutDtl);
  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFmSelSendOut.Xml');
  SetFieldProperty(CdsFieldProPerty,CdsSelSendOut, 'SelSendOut');
  SetFieldProperty(CdsFieldProPerty,CdsSelSendOutDtl, 'SelSendOutDtl,Goodses,Depots');
  SetGressHint('读取历史单据...');
  ShowPayModes;
  SetCurrBillIdx(0);
  inherited;
  FreeGressForm;
End;

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

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

procedure TFmSelSendOut.ActSaveExecute(Sender: TObject);
Var iIndex:Integer;
begin
  If  FEditMode=0 Then Exit;
  iIndex:=cbPayModes.ItemIndex;
  if iIndex<>-1 Then
  Begin
    CdsSelSendOutPayModeNo.Value:=slPayModes[iIndex];
  End;
  edBillNo.SetFocus;
  Inherited;
End;

procedure TFmSelSendOut.ActAddSubItemExecute(Sender: TObject);
begin
  If FEditMode=0 Then Exit;
  If Not(CdsSelSendOut.State In dsEditModes) Then Exit;
    CdsSelSendOutDtl.Append
end;

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

procedure TFmSelSendOut.CdsSelSendOutAfterScroll(DataSet: TDataSet);
Var sModeNo:String;
    iIndex:Integer;
begin
  sModeNo:=CdsSelSendOutPayModeNo.Value;
  iIndex:=slPayModes.IndexOf(sModeNO);
  cbPayModes.ItemIndex:=iIndex;
  If CdsSelSendOutTransfer.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 TFmSelSendOut.CdsSelSendOutNewRecord(DataSet: TDataSet);
begin
  BeforeCustNo:='';
  BeforeEmpNo :='';
  edProvName.Button.Click;
  CdsSelSendOutBillNo.Value:= BuildBillNo('SelSendOut');
  CdsSelSendOutCreater.Value := LogonInfo^.UserID;
  CdsSelSendOutGrup.Value := LogonInfo^.UserGrupID;
  CdsSelSendOutInOutKind.Value:=0;
  CdsSelSendOutFDate.Value:=Date;
  CdsSelSendOutPayDate.Value:=Date;
end;

procedure TFmSelSendOut.CdsSelSendOutDtlNewRecord(DataSet: TDataSet);
begin
  BeforeGoodsID:='';
  BeforeDepotNo:='';
  CdsSelSendOutDtlBILLNO.Value:=CdsSelSendOutBillNO.Value;
  CdsSelSendOutDtlItemNO.Value:=iLastItemNO+1;
  CdsSelSendOutDtlPRODDATE.Value:=Date;
  CdsSelSendOutDtlVALIDDATE.Value:=IncMonth(Date,12);
end;

procedure TFmSelSendOut.CdsSelSendOutDtlBeforeInsert(DataSet: TDataSet);
begin
  iLastItemNO:=GetFieldMaxInt(CdsSelSendOutDtl,'ItemNO');
end;

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

procedure TFmSelSendOut.CdsSelSendOutDtlpriceChange(Sender: TField);
Begin
  SumCount;
end;

procedure TFmSelSendOut.SumCount;
Var
  dQty,dUnTaxPrice,dPrice,dTaxRate,dGoodsSum,dAmount:Double;
begin
//基本的只须实际单价、税率、数量;
  dPrice:=CdsSelSendOutDtlPRICE.AsFloat;      //实际单价
  dTaxRate:=CdsSelSendOutDtlTaxRate.AsFloat;  //税率
  dUnTaxPrice:=dPrice/(1+dTaxRate/100);  //未税单价(实际单价/1+(税率)%)
  CdsSelSendOutDtlUNTAXPRICE.AsFloat:=dUnTaxPrice;   //保存未税单价

  dQty:=CdsSelSendOutDtlQTY.AsFloat;   //数量
  dGoodsSum:=dQty*dUnTaxPrice;         //计算货款=数量*未税单价
  CdsSelSendOutDtlGOODSSUM.Value:=dGoodsSum;     //保存货款

  dAmount:=dQty*dPrice;                 //计算合计=数量*实际单价
  CdsSelSendOutDtlAMOUNT.AsFloat:=dAmount;        //保存合计
  CdsSelSendOutDtlTaxSum.AsFloat:=dAmount-dGoodsSum;      //税款=合计-货款
end;


procedure TFmSelSendOut.CdsSelSendOutDtlAfterPost(DataSet: TDataSet);
var dQty,dGoodsSum,dTaxSum,dAmount:Double;
		mark1: TBookmark;
begin
  BeforeGoodsID:='';  
  dQty:=0;
  dGoodsSum:=0;
  dTaxSum:=0;
  dAmount:=0;
  with CdsSelSendOutDtl do begin
    Mark1 := GetBookmark;
    DisableControls;
    try
      First;
      while not Eof do begin
        dQty:=dQty+FieldByName('Qty').AsFloat;
        dGoodsSum := dGoodsSum+FieldbyName('GoodsSum').AsFloat;