stockmovefm.~pas

来自「群星医药系统源码」· ~PAS 代码 · 共 665 行 · 第 1/2 页

unit StockMoveFm;

interface

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

type
  TFmStockMove = class(TceBaseBillForm)
    Label1: TLabel;
    Label2: TLabel;
    Label7: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Lab_State: TLabel;
    edBillID: TRzDBEdit;
    edDate: TRzDBDateTimePicker;
    RzDBEdit1: TRzDBEdit;
    dbgStockInDtl: TxDBGridEh;
    Label11: TLabel;
    Label22: TLabel;
    Label9: TLabel;
    RzDBEdit21: TRzDBEdit;
    RzDBEdit10: TRzDBEdit;
    RzDBEdit4: TRzDBEdit;
    Label8: TLabel;
    Label12: TLabel;
    edDepot: TRzDBButtonEdit;
    RzDBEdit3: TRzDBEdit;
    RzDBEdit5: TRzDBEdit;
    edEmpID: TRzDBButtonEdit;
    RzDBButtonEdit1: TRzDBButtonEdit;
    RzDBEdit2: TRzDBEdit;
    RzDBEdit6: TRzDBEdit;
    RzDBButtonEdit2: TRzDBButtonEdit;
    DComConn: TDCOMConnection;
    CdsStockMove: TckClientDataSet;
    DsStockMove: TDataSource;
    DsStockMoveDtl: TDataSource;
    CdsStockMoveBillNo: TStringField;
    CdsStockMoveFDate: TDateTimeField;
    CdsStockMoveDepotID: TIntegerField;
    CdsStockMoveDepotNo: TStringField;
    CdsStockMoveDepotName: TStringField;
    CdsStockMoveToDepotID: TIntegerField;
    CdsStockMoveToDepotNo: TStringField;
    CdsStockMoveToDepotName: TStringField;
    CdsStockMoveEmpNo: TStringField;
    CdsStockMoveName: TStringField;
    CdsStockMoveShipper: TStringField;
    CdsStockMoveShipperName: TStringField;
    CdsStockMoveAudit: TStringField;
    CdsStockMoveTotal: TBCDField;
    CdsStockMoveNumCount: TBCDField;
    CdsStockMoveTransfer: TBooleanField;
    CdsStockMoveRemark: TStringField;
    CdsStockMoveCreater: TStringField;
    CdsStockMoveCreatTime: TDateTimeField;
    CdsStockMoveMender: TStringField;
    CdsStockMoveGrup: TIntegerField;
    CdsStockMoveAdsStockMoveDtl: TDataSetField;
    CdsStockMoveDtl: TckClientDataSet;
    CdsStockMoveDtlBillNo: TStringField;
    CdsStockMoveDtlItemNo: TIntegerField;
    CdsStockMoveDtlGoodsID: TStringField;
    CdsStockMoveDtlName: TStringField;
    CdsStockMoveDtlSpecs: TStringField;
    CdsStockMoveDtlUnit: TStringField;
    CdsStockMoveDtlQty: TBCDField;
    CdsStockMoveDtlAmount: TBCDField;
    CdsStockMoveDtlBatchNo: TStringField;
    CdsStockMoveDtlValidDate: TDateTimeField;
    CdsStockMoveUpdateTime: TDateTimeField;
    CdsStockMoveDtlBerthNo: TStringField;
    CdsStockMoveDtlToBerth: TStringField;
    CdsStockMoveDtlPrice: TFloatField;
    procedure CdsStockMoveDepotNoChange(Sender: TField);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure CdsStockMoveToDepotNoChange(Sender: TField);
    procedure CdsStockMoveEmpNoChange(Sender: TField);
    procedure CdsStockMoveShipperChange(Sender: TField);
    procedure ActUpdateExecute(Sender: TObject);
    procedure ActDeleteExecute(Sender: TObject);
    procedure ActAuditExecute(Sender: TObject);
    procedure CdsStockMoveDtlGoodsIDChange(Sender: TField);
    procedure CdsStockMoveAfterScroll(DataSet: TDataSet);
    procedure CdsStockMoveNewRecord(DataSet: TDataSet);
    procedure CdsStockMoveReconcileError(DataSet: TCustomClientDataSet;
      E: EReconcileError; UpdateKind: TUpdateKind;
      var Action: TReconcileAction);
    procedure CdsStockMoveDtlBeforeInsert(DataSet: TDataSet);
    procedure CdsStockMoveDtlNewRecord(DataSet: TDataSet);
    procedure CdsStockMoveDtlAfterPost(DataSet: TDataSet);
    procedure CdsStockMoveDtlQtyChange(Sender: TField);
    procedure ActRevertExecute(Sender: TObject);
    procedure ActFieldLayoutExecute(Sender: TObject);
    procedure ActDataExportExecute(Sender: TObject);
    procedure ActAddSubItemExecute(Sender: TObject);
    procedure ActDelSubItemExecute(Sender: TObject);
    procedure dbgStockInDtlEditButtonClick(Sender: TObject);
    procedure RzDBButtonEdit2ButtonClick(Sender: TObject);
    procedure edEmpIDButtonClick(Sender: TObject);
    procedure RzDBButtonEdit1ButtonClick(Sender: TObject);
    procedure edDepotButtonClick(Sender: TObject);
    procedure ActInsertExecute(Sender: TObject);
    procedure ActQueryExecute(Sender: TObject);
  private
    { Private declarations }
    CdsFieldProPerty:TCkClientDataSet;
    BeforeDepotNo,BeforeToDepotNo,BeforeEmpNo,BeforeShipper,
    BeforeGoodsID:String;
    LocSetting: PLocSetting;
    iClientID,iLastItemNo:Integer;
    bBrowGoods,CanAudit, CanRevert:Boolean;    
    SvrStockMove,SvrCommon:TDispatchConnection;
    procedure ParseGoodsInfo;
  public
    { Public declarations }
  protected
    Function DoSome(cType: PChar; Values: Variant): Variant; override;   
  end;
  
Const
  sFieldProPerty='Select * From SysFieldProPerty '+
      ' Where TableName in(''StockMove'', ''StockMoveDtl'', ''Goodses'')';

var
  FmStockMove: TFmStockMove;

implementation

uses SelectGoodsFrm,FieldsLayoutFrm,DataExportFrm,ViewGoodsPriceFrm,
      SelectEmpFrm,SelectDepotFrm,SelectBerthFrm,SelectBatchNoFrm;

{$R *.dfm}
procedure TFmStockMove.CdsStockMoveDepotNoChange(Sender: TField);
Var
  sDepotNo,LogText:String;
  A:Variant;
begin
  Try
    IF FEditMode=0 Then Exit;
    sDepotNo:=CdsStockMoveDepotNo.Value;
    If sDepotNo='' Then Exit;
    if sDepotNo=BeforeDepotNo Then Exit;
    BeforeDepotNo:=sDepotNo;
    A := SvrCommon.AppServer.GetDepotInfo(iClientID,sDepotNo,2,'DepotID,DepotName',LogText);
    CdsStockMoveDepotID.Value  := A[0];
    CdsStockMoveDepotName.Value:= A[1];
    If LogText<>'' Then Begin
      Messagebox(Handle,Pchar('无效的仓库编号...'),nil,16);
      RzDBEdit2.SetFocus;
      Abort;
    End;
  Except
    Messagebox(Handle,Pchar('无效的仓库编号...'),nil,16);
    RzDBEdit2.SetFocus;
  End;
end;

procedure TFmStockMove.FormCreate(Sender: TObject);
begin
  Inherited;
  IFmMain.SetActionStatus(ActionList1, hInstance, self.ClassName);
  CdsFieldProPerty:=TCKClientDataSet.Create(Self);
  LocSetting := IFmMain.IFmMainEx.GetLocSetting;
  SetGressHint('正在连接药品移库(位)服务器...');
  CanAudit := ActAudit.Enabled;
  CanRevert:= ActCancel.Enabled;
  iClientID:=IFmMain.IFmMainEx.ClientID;
  SvrStockMove:=IFmMain.GetConnection(Handle,'','CkStockSvr.Stock');
  sBillNoList.Text := SvrStockMove.AppServer.GetCurrMonthBills(iClientID, 'StockMove');
  CdsStockMove.RemoteServer:=SvrStockMove;
  SetGressHint('正在连接到公用信息服务器...');
  SvrCommon:=IFmMain.GetConnection(Handle,'','CommonSvr.CommonRDM');
  CdsFieldProPerty.ProviderName:='DspTemp';
  CdsFieldProPerty.RemoteServer:=SvrCommon;
  SetGressHint('正在读取用户操作权限...');
  RepDataSetNames := '药品移库(位);药品移库(位)明细';
  sRepSection := '药品移库(位)单';
  MasterDataSet:=CdsStockMove;
  SetLength(FDetailDataSets, 1);
  FDetailDataSets[0] := CdsStockMoveDtl;
end;

procedure TFmStockMove.FormShow(Sender: TObject);
begin
  SetGressHint('初始化本地环境...');
  SetGridEhColor(dbgStockInDtl);
  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFmStockMove.Xml');
  SetFieldProperty(CdsFieldProPerty,CdsStockMove, 'StockMove');
  SetFieldProperty(CdsFieldProPerty,CdsStockMoveDtl, 'StockMoveDtl,Goodses');
  SetGressHint('读取历史单据...');
  SetCurrBillIdx(0);
  inherited;
  FreeGressForm;
end;

procedure TFmStockMove.CdsStockMoveToDepotNoChange(Sender: TField);
Var
  sDepotNo,LogText:String;
  A:Variant;
begin
  Try
    IF FEditMode=0 Then Exit;
    sDepotNo:=CdsStockMoveToDepotNo.Value;
    If sDepotNo='' Then Exit;
    if sDepotNo=BeforeToDepotNo Then Exit;
    BeforeToDepotNo:=sDepotNo;
    A := SvrCommon.AppServer.GetDepotInfo(iClientID,sDepotNo,2,'DepotID,DepotName',LogText);
    CdsStockMoveToDepotID.Value  := A[0];
    CdsStockMoveToDepotName.Value:= A[1];
    If LogText<>'' Then Begin
      Messagebox(Handle,Pchar('无效的仓库编号...'),nil,16);
      RzDBEdit2.SetFocus;
      Abort;
    End;
  Except
    Messagebox(Handle,Pchar('无效的仓库编号...'),nil,16);
    RzDBEdit2.SetFocus;
  End;
end;

procedure TFmStockMove.CdsStockMoveEmpNoChange(Sender: TField);
Var
  sEmpNo,sEmpName,LogText:String;
begin
  IF FEditMode=0 Then Exit;
  sEmpNo:=CdsStockMoveEmpNo.Value;
  If sEmpNo='' Then Exit;
  if sEmpNo=BeforeEmpNo Then Exit;
  BeforeEmpNo:=sEmpNO;
  sEmpName:=VarToStr(SvrCommon.AppServer.GetEmpInfo(iClientID,sEmpNo,1,'Name',LogText));
  CdsStockMoveName.Value:=sEmpName;
  If LogText<>'' Then Begin
    Messagebox(Handle,Pchar(LogText),nil,16);
    RzDBEdit6.SetFocus;
    Abort;
  End;
end;

procedure TFmStockMove.CdsStockMoveShipperChange(Sender: TField);
Var
  sShipper,sShipperName,LogText:String;
begin
  IF FEditMode=0 Then Exit;
  sShipper:=CdsStockMoveShipper.Value;
  If sShipper='' Then Exit;
  if sShipper=BeforeShipper Then Exit;
  BeforeShipper:=sShipper;
  sShipperName:=VarToStr(SvrCommon.AppServer.GetEmpInfo(iClientID,sShipper,1,'Name',LogText));
  CdsStockMoveShipperName.Value:=sShipperName;
  If LogText<>'' Then Begin
    Messagebox(Handle,Pchar(LogText),nil,16);
    RzDBEdit5.SetFocus;
    Abort;
  End;
End;

procedure TFmStockMove.ActUpdateExecute(Sender: TObject);
begin
  If CdsStockMoveTransfer.Value  Then Begin
    Messagebox(Handle,Pchar('当前单据已[审核]，不能进行修改操作!'),nil,16);
    Exit;
  End;
  inherited;
  BeforeDepotNo := '';
  BeforeToDepotNo:='';  
end;

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

procedure TFmStockMove.ActAuditExecute(Sender: TObject);
Var
  Str:String;
  sSysInfo : Variant;
begin
  Try
    if FEditMode>0 then Exit;
    if CdsStockMove.IsEmpty Then Exit;
    Inherited;
    if Application.MessageBox('单据审核后将不允许修改，确实要审核当前数据吗？','提示',4+32)<>6 then Exit;
    str := 'CurrMonth';
    sSysInfo := SvrCommon.AppServer.GetSysInfo(iClientID,Str,1);
    If Not(VarIsNull(sSysInfo)) Then Begin
      If CdsStockMoveFDate.Value<VarToDateTime(sSysInfo) Then Begin
        Messagebox(Handle,Pchar('该月已结算，不能操作已月结的单据！'),nil,16);
        Exit;
      End;
    End Else Begin
      Messagebox(Handle,Pchar('请先设置开帐日期...'),nil,16);
      Exit;
    End;
    if not SvrStockMove.AppServer.BillAudit(iClientID, 'StockMove', cdsStockMoveBillNo.Value) then begin
        Messagebox(Handle,Pchar('复核数据不成功！'),nil,16);
    end else begin
      ActAudit.Enabled:=False and CanAudit;
      ActRevert.Enabled:=True and CanRevert;
      Lab_State.Caption:='单据状态：已审核';
      Lab_State.Font.Color:=clRed;
      ActRefreshExecute(NIL);
    End;
  Except
    On E:Exception Do
      Messagebox(Handle,Pchar(E.Message),nil,16);
  End;
End;

procedure TFmStockMove.CdsStockMoveDtlGoodsIDChange(Sender: TField);
{Var
  LogText,Flag,sGoodsID,sSetFields:String;
Begin
  IF FEditMode=0 Then Exit;
  IF FlagGoodsID<>'' Then Begin
    FlagGoodsID:='';
    Exit;
  End;
  If bBrowGoods then Exit;
  sGoodsID:=CdsStockMoveDtlGoodsID.AsString;
  If sGoodsID='' Then Exit;