stockoutfm.~pas

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

unit StockOutFm;

interface

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

type
  TFmStockOut = class(TceBaseBillForm)
    Label3: TLabel;
    Label1: TLabel;
    Label2: TLabel;
    Label7: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Lab_State: TLabel;
    edBillID: TRzDBEdit;
    edDate: TRzDBDateTimePicker;
    edEmpID: TRzDBButtonEdit;
    edDepot: TRzDBButtonEdit;
    edDepart: TRzDBButtonEdit;
    cbInOutKind: TRzComboBox;
    RzDBEdit2: TRzDBEdit;
    RzDBEdit3: TRzDBEdit;
    RzDBEdit5: TRzDBEdit;
    RzDBEdit1: TRzDBEdit;
    dbgStockOutDtl: TxDBGridEh;
    Label22: TLabel;
    Label9: TLabel;
    RzDBEdit10: TRzDBEdit;
    RzDBEdit4: TRzDBEdit;
    CdsStockOut: TckClientDataSet;
    DsStockOut: TDataSource;
    DsStockOutDtl: TDataSource;
    CdsStockOutDtl: TckClientDataSet;
    Label8: TLabel;
    RzDBEdit6: TRzDBEdit;
    RzDBButtonEdit1: TRzDBButtonEdit;
    DComConn: TDCOMConnection;
    CdsStockOutBillNo: TStringField;
    CdsStockOutFDate: TDateTimeField;
    CdsStockOutDepotID: TIntegerField;
    CdsStockOutDepotNo: TStringField;
    CdsStockOutDepotName: TStringField;
    CdsStockOutCustNO: TStringField;
    CdsStockOutCustName: TStringField;
    CdsStockOutInOutKind: TIntegerField;
    CdsStockOutGoodsQty: TBCDField;
    CdsStockOutGoodsSum: TBCDField;
    CdsStockOutEmpNo: TStringField;
    CdsStockOutName: TStringField;
    CdsStockOutShipper: TStringField;
    CdsStockOutShipName: TStringField;
    CdsStockOutAudit: TStringField;
    CdsStockOutTransfer: TBooleanField;
    CdsStockOutRemark: TStringField;
    CdsStockOutAdsStockOutDtl: TDataSetField;
    CdsStockOutDtlBillNo: TStringField;
    CdsStockOutDtlItemNo: TIntegerField;
    CdsStockOutDtlGoodsID: TStringField;
    CdsStockOutDtlUnit: TStringField;
    CdsStockOutDtlQty: TBCDField;
    CdsStockOutDtlCost: TBCDField;
    CdsStockOutDtlGroupNo: TIntegerField;
    CdsStockOutDtlBatchNo: TStringField;
    CdsStockOutDtlValidDate: TDateTimeField;
    CdsStockOutDtlPBillNo: TStringField;
    CdsStockOutDtlPItemNo: TIntegerField;
    CdsStockOutDtlName: TStringField;
    CdsStockOutDtlSpecs: TStringField;
    CdsStockOutDtlPrice: TFloatField;
    CdsStockOutDtlAmount: TBCDField;
    CdsStockOutDtlBerthNo: TStringField;
    Label10: TLabel;
    RzDBEdit7: TRzDBEdit;
    CdsStockOutCostSum: TBCDField;
    CdsStockOutPBillNo: TStringField;
    CdsStockOutCreater: TStringField;
    CdsStockOutMender: TStringField;
    CdsStockOutGrup: TIntegerField;
    CdsStockOutCreatTime: TDateTimeField;
    SpeedButton1: TSpeedButton;
    procedure CdsStockOutNewRecord(DataSet: TDataSet);
    procedure CdsStockOutDtlBeforeInsert(DataSet: TDataSet);
    procedure CdsStockOutDtlNewRecord(DataSet: TDataSet);
    procedure ActAddSubItemExecute(Sender: TObject);
    procedure ActDelSubItemExecute(Sender: TObject);
    procedure ActSaveExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure CdsStockOutReconcileError(DataSet: TCustomClientDataSet;
      E: EReconcileError; UpdateKind: TUpdateKind;
      var Action: TReconcileAction);
    procedure CdsStockOutAfterScroll(DataSet: TDataSet);
    procedure ActDeleteExecute(Sender: TObject);
    procedure CdsStockOutDtlGoodsIDChange(Sender: TField);
    procedure dbgStockOutDtlEditButtonClick(Sender: TObject);
    procedure CdsStockOutCustNOChange(Sender: TField);
    procedure CdsStockOutEmpNoChange(Sender: TField);
    procedure CdsStockOutShipperChange(Sender: TField);
    procedure CdsStockOutDepotNoChange(Sender: TField);
    procedure CdsStockOutDtlAfterPost(DataSet: TDataSet);
    procedure ActUpdateExecute(Sender: TObject);
    procedure ActAuditExecute(Sender: TObject);
    procedure ActRevertExecute(Sender: TObject);
    procedure ActFieldLayoutExecute(Sender: TObject);
    procedure ActDataExportExecute(Sender: TObject);
    procedure edDepotButtonClick(Sender: TObject);
    procedure edEmpIDButtonClick(Sender: TObject);
    procedure RzDBButtonEdit1ButtonClick(Sender: TObject);
    procedure edDepartButtonClick(Sender: TObject);
    procedure ActInsertExecute(Sender: TObject);
    procedure ActQueryExecute(Sender: TObject);
  private
    iLastItemNO,iClientID:Integer;
    slInOutKinds:TStrings;
    bBrowGoods, CanAudit, CanRevert:Boolean;
    LocSetting: PLocSetting;
    BeforeGoodsID,FlagGoodsID,BeforeCustNo,BeforeEmpNo,BeforeShipper,BeforeDepotNo:String;
    CdsFieldProPerty:TCkClientDataSet;
    SvrStockOut,SvrCommon:TDispatchConnection;
    Procedure GetInOut;
    procedure ParseGoodsInfo;
  public
    iAppendInOut:Integer;   //iappendInOut 检测是否有新增出库方式>0表示有
  protected
    Function DoSome(cType: PChar; Values: Variant): Variant; override;   
  end;

Const
  sInOutKind='Select KindId,KindName From InOutKind Where InOut=1 Order By KindId';
  sFieldProPerty='Select * From SysFieldProPerty '+
      ' Where TableName in(''StockOut'', ''StockOutDtl'', ''Goodses'')';

var
  FmStockOut: TFmStockOut;

implementation

uses INOutKindFm,SelectGoodsFrm,FieldsLayoutFrm,DataExportFrm, SelectBerthFrm,
    SelectDepotFrm,SelectEmpFrm,SelectCustFrm, SelectBatchNoFrm;

{$R *.dfm}
procedure TFmStockOut.FormCreate(Sender: TObject);
begin
  inherited;
  iAppendInOut:=0;
  CdsFieldProPerty:=TCKClientDataSet.Create(Self);
  slInOutKinds:=TStringList.Create;
  LocSetting := IFmMain.IFmMainEx.GetLocSetting;
  SetGressHint('正在连接药品出库服务器...');
  iClientID:=IFmMain.IFmMainEx.ClientID;
  SvrStockOut:=IFmMain.GetConnection(Handle,'','CkStockSvr.Stock');
  sBillNoList.Text := SvrStockOut.AppServer.GetCurrMonthBills(iClientID, 'StockOut');
  CdsStockOut.RemoteServer:=SvrStockOut;
  SetGressHint('正在连接到公用信息服务器...');
  CanAudit := ActAudit.Enabled;
  CanRevert:= ActCancel.Enabled;
  SvrCommon:=IFmMain.GetConnection(Handle,'','CommonSvr.CommonRDM');
  CdsFieldProPerty.ProviderName:='DspTemp';
  CdsFieldProPerty.RemoteServer:=SvrCommon;
  SetGressHint('正在读取用户操作权限...');
  IFmMain.SetActionStatus(ActionList1, hInstance, self.ClassName);
  SetLength(FDetailDataSets, 1);
  FDetailDataSets[0] := CdsStockOutDtl;
  RepDataSetNames := '药品出库;药品出库明细';
  sRepSection := '药品出库单';
  MasterDataSet:=CdsStockOut;
end;

procedure TFmStockOut.FormShow(Sender: TObject);
Var sTableNames:String;
begin
  SetGressHint('初始化本地环境...');
  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFmStockOut.Xml');
  SetFieldProperty(CdsFieldProPerty,CdsStockOut, 'StockOut');
  SetFieldProperty(CdsFieldProPerty,CdsStockOutDtl, 'StockOutDtl,Goodses');
  SetGressHint('读取历史单据...');
  SetGridEhColor(dbgStockOutDtl);
  GetInOut;
  inherited;
  SetCurrBillIdx(0);
  FreeGressForm;
end;

procedure TFmStockOut.CdsStockOutNewRecord(DataSet: TDataSet);
Var sBillNo:String;
begin
  CdsStockOutFDate.Value:=Date;
  sBillNo := BuildBillNo('StockOut');
  CdsStockOutBillNo.Value :=sBillNo;
end;

procedure TFmStockOut.CdsStockOutDtlBeforeInsert(DataSet: TDataSet);
begin
  iLastItemNO:=GetFieldMaxInt(CdsStockOutDtl, 'ItemNo')+1;
end;

procedure TFmStockOut.CdsStockOutDtlNewRecord(DataSet: TDataSet);
begin
  BeforeGoodsID:='';
  CdsStockOutDtlBillNo.Value:=CdsStockOutBillNo.Value;
  CdsStockOutDtlItemNo.Value:=iLastItemNo;
  CdsStockOutDtlValidDate.Value:=IncMonth(Date,12);
end;

procedure TFmStockOut.ActAddSubItemExecute(Sender: TObject);
Begin
  If FEditMode=0 Then Exit;
  IF Not(CdsStockOut.State In dsEditModes) Then Exit;
  CdsStockOutDtl.append;
End;

procedure TFmStockOut.ActDelSubItemExecute(Sender: TObject);
begin
  If FEditMode=0 Then Exit;
  If NOt(CdsStockOut.State In dsEditModes) Then Exit;
	if CdsStockOutDtl.IsEmpty then Exit;
  CdsStockOutDtl.Delete;
End;

procedure TFmStockOut.ActSaveExecute(Sender: TObject);
Var iIndex:Integer;
begin
  Try
    If  FEditMode=0 Then Exit;
    iIndex:=cbInOutKind.ItemIndex;
    if iIndex<>-1 Then
      CdsStockOutInOutKind.Value:=StrToInt(slInOutKinds[iIndex]);
    Inherited;
  Except
    On E:Exception Do
      Messagebox(Handle,Pchar(E.Message),nil,16);
  End;
End;

procedure TFmStockOut.GetInOut;
Var
  A:Variant;
  I, k:Integer;
begin
  //显示出库方式
  A:=SvrCommon.AppServer.GetNeedValue(iClientID,2,sInOutKind);
  If (Not VarIsNull(A)) And (VarIsArray(A)) Then
  Begin
    cbInOutKind.Items.Clear;
    slInOutKinds.Clear;
    k := VarArrayHighBound(A,2);
    for i:=VarArrayLowBound(A,2) to k do
    Begin
      slInOutKinds.Add(A[0,i]);
      cbInOutKind.Items.Add('['+A[0,i]+']'+A[1,i]);
    End;
  End;
end;

procedure TFmStockOut.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  inherited;
  Action:=CaFree;
end;

procedure TFmStockOut.CdsStockOutReconcileError(
  DataSet: TCustomClientDataSet; E: EReconcileError;
  UpdateKind: TUpdateKind; var Action: TReconcileAction);
begin
  Messagebox(Handle,Pchar(E.Message),'',16);
  Action:=raAbort;
end;

procedure TFmStockOut.CdsStockOutAfterScroll(DataSet: TDataSet);
Var
  sKindNo:String;
begin
  sKindNo:=CdsStockOutInOutKind.AsString;
  cbInOutKInd.ItemIndex:=slInOutKinds.IndexOf(sKindNo);
  If CdsStockOutTransfer.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 TFmStockOut.ActDeleteExecute(Sender: TObject);
begin
  Try
    if CdsStockOut.IsEmpty then exit;
    if IsEditing then Exit;
    If CdsStockOutTransfer.Value Then Begin
      Messagebox(Handle,Pchar('当前单据已[复核]，不能执行删除操作！'),'警告',64);
      Exit;
    End;
    If messagebox(Handle,'确实要删除当前数据吗？','提示',4+32)<>6 Then Exit;
      inherited;
  Except
    On E:Exception Do
      Messagebox(Handle,Pchar(E.Message),'',16);
  End;
End;

procedure TFmStockOut.CdsStockOutDtlGoodsIDChange(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:=CdsStockOutDtlGoodsID.AsString;
  If sGoodsID='' Then Exit;
  if (BeforeGoodsID=sGoodsID) Then Exit;
  BeforeGoodsID:=sGoodsID;
  sSetFields:= 'Name,Specs,Unit';
  FlagGoodsID:=GetGoodsInfo(CdsStockOutDtl,'OPrice',sGoodsID,sSetFields,'','S',1);
  If FlagGoodsID<>'' Then Begin
    Messagebox(Handle,'无效药品编号','错误',16);
    Abort;
  End Else Begin
    if sGoodsID<>FlagGoodsID then
      CdsStockOutDtl.FieldByName('GoodsID').AsString:=FlagGoodsID
    Else
      FlagGoodsID:='';
  End;}