.#pchinretfrm.pas.1.38

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

38
765
字号
unit PchInRetFrm;

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,SelectProvFrm,SelectEmpFrm,SelectDepotFrm, RzDBLbl, RzLabel,
  SelectProvLinkManFrm;

type
  TFmPchInRet = class(TceBaseBillForm)
    DComConn: TDCOMConnection;
    CdsPchInRet: TckClientDataSet;
    DsPchInRet: 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;
    DBEdit2: TRzDBDateTimePicker;
    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;
    DsPchInRetDtl: TDataSource;
    CdsPchInRetDtl: TckClientDataSet;
    CdsPchInRetExpense: TckClientDataSet;
    DsPchInRetExpense: TDataSource;
    PgC1: TRzPageControl;
    TabSelExportDtl: TRzTabSheet;
    TabSelExpense: TRzTabSheet;
    dbgPchInRetExpense: TxDBGridEh;
    dbgPchInRetDtl: TxDBGridEh;
    cbPayModes: TRzComboBox;
    RzDBButtonEdit1: TRzDBButtonEdit;
    CdsPchInRetBillNo: TStringField;
    CdsPchInRetFDate: TDateTimeField;
    CdsPchInRetRefBillNo: TStringField;
    CdsPchInRetEmpNo: TStringField;
    CdsPchInRetName: TStringField;
    CdsPchInRetAudit: TStringField;
    CdsPchInRetProvNo: TStringField;
    CdsPchInRetProvName: TStringField;
    CdsPchInRetLinkMan: TStringField;
    CdsPchInRetGoodsQty: TBCDField;
    CdsPchInRetGoodsSum: TBCDField;
    CdsPchInRetTaxRate: TBCDField;
    CdsPchInRetTaxSum: TBCDField;
    CdsPchInRetAmount: TBCDField;
    CdsPchInRetPayModeNo: TStringField;
    CdsPchInRetPayDate: TDateTimeField;
    CdsPchInRetRemark: TStringField;
    CdsPchInRetFungible: TBooleanField;
    CdsPchInRetTransfer: TBooleanField;
    CdsPchInRetGrup: TIntegerField;
    CdsPchInRetInOutKind: TSmallintField;
    CdsPchInRetDtlBillNo: TStringField;
    CdsPchInRetDtlItemNo: TIntegerField;
    CdsPchInRetDtlGoodsID: TStringField;
    CdsPchInRetDtlName: TStringField;
    CdsPchInRetDtlSpecs: TStringField;
    CdsPchInRetDtlUnit: TStringField;
    CdsPchInRetDtlQty: TBCDField;
    CdsPchInRetDtlprice: TFloatField;
    CdsPchInRetDtlTaxRate: TBCDField;
    CdsPchInRetDtlUnTaxprice: TFloatField;
    CdsPchInRetDtlGoodsSum: TBCDField;
    CdsPchInRetDtlTaxSum: TBCDField;
    CdsPchInRetDtlAmount: TBCDField;
    CdsPchInRetDtlBatchNo: TStringField;
    CdsPchInRetDtlProdDate: TDateTimeField;
    CdsPchInRetDtlValidDate: TDateTimeField;
    CdsPchInRetDtlDepotID: TIntegerField;
    CdsPchInRetDtlPBillNo: TStringField;
    CdsPchInRetDtlPItemNo: TIntegerField;
    CdsPchInRetDtlPaidUp: TBCDField;
    CdsPchInRetDtlProvGoodsID: TStringField;
    CdsPchInRetExpenseBillNo: TStringField;
    CdsPchInRetExpenseExpenseType: TStringField;
    CdsPchInRetExpenseAmount: TBCDField;
    CdsPchInRetExpenseRemark: TStringField;
    CdsPchInRetAdsPchInRetExpense: TDataSetField;
    CdsPchInRetAdsPchInRetDtl: TDataSetField;
    CdsPchInRetDtlDepotNo: TStringField;
    CdsPchInRetDtlDepotName: TStringField;
    RzLabel7: TRzLabel;
    RzDBLabel1: TRzDBLabel;
    RzLabel16: TRzLabel;
    RzDBLabel2: TRzDBLabel;
    CdsPchInRetCreater: TStringField;
    CdsPchInRetCreatTime: TDateTimeField;
    RzDBButtonEdit2: TRzDBButtonEdit;
    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 CdsPchInRetAfterScroll(DataSet: TDataSet);
    procedure FormCreate(Sender: TObject);
    procedure CdsPchInRetNewRecord(DataSet: TDataSet);
    procedure CdsPchInRetDtlNewRecord(DataSet: TDataSet);
    procedure CdsPchInRetDtlBeforeInsert(DataSet: TDataSet);
    procedure CdsPchInRetExpenseNewRecord(DataSet: TDataSet);
    procedure CdsPchInRetReconcileError(DataSet: TCustomClientDataSet;
      E: EReconcileError; UpdateKind: TUpdateKind;
      var Action: TReconcileAction);
    procedure CdsPchInRetDtlQtyChange(Sender: TField);
    procedure CdsPchInRetDtlAfterPost(DataSet: TDataSet);
    procedure edProvNameButtonClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure RzDBButtonEdit1ButtonClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure CdsPchInRetDtlGoodsIDChange(Sender: TField);
    procedure CdsPchInRetDtlBeforeEdit(DataSet: TDataSet);
    procedure CdsPchInRetEmpNoChange(Sender: TField);
    procedure CdsPchInRetProvNoChange(Sender: TField);
    procedure dbgPchInRetDtlEditButtonClick(Sender: TObject);
    procedure CdsPchInRetDtlDepotNoChange(Sender: TField);
    procedure ActAuditExecute(Sender: TObject);
    procedure ActRevertExecute(Sender: TObject);
    procedure ActFieldLayoutExecute(Sender: TObject);
    procedure ActDataExportExecute(Sender: TObject);
    procedure RzDBButtonEdit2ButtonClick(Sender: TObject);
    procedure CdsPchInRetDtlUnTaxpriceChange(Sender: TField);
    procedure CdsPchInRetDtlAfterOpen(DataSet: TDataSet);
    procedure CdsPchInRetDtlpriceChange(Sender: TField);
    procedure CdsPchInRetDtlTaxRateChange(Sender: TField);
  private
    iLastItemNO,iClientID:Integer;
    slPayModes:TStrings;
    LocSetting: PLocSetting;
    BeforeDepotNo, BeforeGoodsID, BeforeEmpNo, BeforeProvNo:String;
    SvrPchReceive,SvrCommon:TDispatchConnection;
    CdsFieldProPerty:TCKClientDataSet;
    bBrowGoods, CanAudit, CanRevert:Boolean;
    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 (''PchReceiveDtl'', ''Goodses'',''PchExpense'')';
  sFilter=' TableName =''%s'' and Requisite ';
var
  FmPchInRet: TFmPchInRet;

implementation

uses SelectGoodsFrm,FieldsLayoutFrm,DataExportFrm,ViewGoodsPriceFrm;

{$R *.dfm}

procedure TFmPchInRet.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;
  CdsFieldProPerty.ProviderName:='DspTemp';
  SvrPchReceive:=IFmMain.GetConnection(Handle,'','CKPurchInBase.PurchInRDM');
  sBillNoList.Text := SvrPchReceive.AppServer.GetCurrMonthBills(iClientID, 'PchInRet');

  CdsPchInRet.RemoteServer:=SvrPchReceive;
  SetGressHint('正在连接到公用信息服务器...');
  SvrCommon:=IFmMain.GetConnection(Handle,'','CommonSvr.CommonRDM');
  CdsFieldProPerty.RemoteServer:=SvrCommon;
  SetGressHint('读取用户操作权限...');
  IFmMain.SetActionStatus(ActionList1, hInstance, self.ClassName);
  SetLength(FDetailDataSets, 2);
  FDetailDataSets[0] := CdsPchInRetDtl;
  FDetailDataSets[1] := CdsPchInRetExpense;
  BillType := 'PchInRet';
  RepDataSetNames := '药品购进退回;药品购进退回明细;药品购进退回费用';
  sRepSection := '药品购进退回';
  MasterDataSet:=CdsPchInRet;
  dbgPchInRetDtl.SetAutoSort('');
  dbgPchInRetExpense.SetAutoSort('');
end;

procedure TFmPchInRet.FormShow(Sender: TObject);
Var
  sTableNames:String;
Begin
  inherited;
  LoadFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name, [dbgPchInRetDtl,dbgPchInRetExpense]);
  SetGressHint('初始化本地环境...');
  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFmPchReceive.Xml');
  sTableNames:='PchReceiveDtl';
  SetFieldProperty(CdsFieldProPerty,CdsPchInRetDtl,sTableNames);
  sTableNames:='PchExpense';
  SetFieldProperty(CdsFieldProPerty,CdsPchInRetExpense,sTableNames);
  SetGressHint('读取历史单据...');
  ShowPayModes;
  SetCurrBillIdx(0);
  FreeGressForm;
End;

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

procedure TFmPchInRet.ActUpdateExecute(Sender: TObject);
begin
  If CdsPchInRet.IsEmpty Then Exit;
  If CdsPchInRetTransfer.Value  Then Begin
    Messagebox(Handle,Pchar('当前单据已[审核],不能进行修改操作!'),'错误:',16);
    Exit;
  End;
  inherited;
  BeforeEmpNo :='';
  BeforeProvNo:='';
end;

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

procedure TFmPchInRet.ActSaveExecute(Sender: TObject);
Var iIndex:Integer;
begin
  If  FEditMode=0 Then Exit;
  iIndex:=cbPayModes.ItemIndex;
  if iIndex<>-1 Then
  Begin
    CdsPchInRetPayModeNo.Value:=slPayModes[iIndex];
  End;
  IF CdsPchInRetDtl.State In dsEditModes Then
    CdsPchInRetDtl.Post;
  If CdsPchInRetExpense.State in dsEditModes Then
    CdsPchInRetExpense.Post;
  Inherited;
End;

procedure TFmPchInRet.ActAddSubItemExecute(Sender: TObject);
begin
  If FEditMode=0 Then Exit;
  If Not(CdsPchInRet.State In dsEditModes) Then Exit;
  If Pgc1.ActivePageIndex=0 Then
    CdsPchInRetDtl.Append
  Else
    CdsPchInRetExpense.Append;
end;

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

procedure TFmPchInRet.CdsPchInRetAfterScroll(DataSet: TDataSet);
Var sModeNo:String;
    iIndex:Integer;
begin
  sModeNo:=CdsPchInRetPayModeNo.Value;
  iIndex:=slPayModes.IndexOf(sModeNO);
  cbPayModes.ItemIndex:=iIndex;
  If CdsPchInRetTransfer.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 TFmPchInRet.CdsPchInRetNewRecord(DataSet: TDataSet);
begin
  edProvName.Button.Click;
  CdsPchInRetBillNo.Value := BuildBillNo('PchInRet');
  CdsPchInRetCreater.Value := LogonInfo^.UserID;
  CdsPchInRetGrup.Value := LogonInfo^.UserGrupID;
  CdsPchInRetInOutKind.Value:=1;
  CdsPchInRetFDate.Value:=Date;
  CdsPchInRetPayDate.Value:=Date;
  CdsPchInRetGoodsQty.Value := 0;
  CdsPchInRetGoodsSum.Value := 0;
  CdsPchInRetTaxRate.Value := 0;
  CdsPchInRetTaxSum.Value := 0;
  CdsPchInRetAmount.Value := 0;
end;

procedure TFmPchInRet.CdsPchInRetDtlNewRecord(DataSet: TDataSet);
begin
  BeforeGoodsID:='';
  CdsPchInRetDtlBILLNO.Value:=CdsPchInRetBillNO.Value;
  CdsPchInRetDtlItemNO.Value:=iLastItemNO+1;
end;

procedure TFmPchInRet.CdsPchInRetDtlBeforeInsert(DataSet: TDataSet);
begin
  iLastItemNO:=GetFieldMaxInt(CdsPchInRetDtl,'ItemNO');
end;

procedure TFmPchInRet.CdsPchInRetExpenseNewRecord(DataSet: TDataSet);
begin
  CdsPchInRetExpenseBillNo.Value:=CdsPchInRetBillNo.Value;
end;

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

procedure TFmPchInRet.CdsPchInRetDtlQtyChange(Sender: TField);
var str: String;
begin
  //实际单价 = 单价 * 折扣
  str := LowerCase(dbgPchInRetDtl.SelectedField.FieldName);
  if str='goodsid' then
    CdsPchInRetDtlUnTaxprice.AsFloat := CdsPchInRetDtlprice.AsFloat / (1 + cdsPchInRetDtlTaxRate.AsFloat/ 100);

  //货款 = 数量 * 未税单价    合计 = 数量 * 单价    税款 = 合计 - 货款
  CdsPchInRetDtlGoodsSum.AsFloat := CdsPchInRetDtlQty.AsFloat * CdsPchInRetDtlUnTaxPrice.AsFloat;
  CdsPchInRetDtlAmount.AsFloat := CdsPchInRetDtlQty.AsFloat * CdsPchInRetDtlPrice.AsFloat;
  CdsPchInRetDtlTaxSum.AsFloat := CdsPchInRetDtlAmount.AsFloat - CdsPchInRetDtlGoodsSum.AsFloat;
End;

procedure TFmPchInRet.CdsPchInRetDtlUnTaxpriceChange(Sender: TField);
begin
  if dbgPchInRetDtl.SelectedField.FieldName = Sender.FieldName then
  begin;
    CdsPchInRetDtlPrice.AsFloat   := Sender.AsFloat * ( 1 + CdsPchInRetDtlTaxRate.AsFloat / 100 );
    CdsPchInRetDtlGoodsSum.AsFloat:= cdsPchInRetDtlQty.AsFloat * CdsPchInRetDtlUnTaxPrice.AsFloat;
    CdsPchInRetDtlAmount.AsFloat := cdsPchInRetDtlQty.AsFloat*cdsPchInRetDtlPrice.AsFloat;
    CdsPchInRetDtlTaxSum.AsFloat  := CdsPchInRetDtlAmount.AsFloat - CdsPchInRetDtlGoodsSum.AsFloat;
  end;

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?