stockteardownfrm.pas

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

PAS
588
字号
unit StockTeardownFrm;

interface

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

type
  TFmStockTeardown = class(TceBaseBillForm)
    Label1: TLabel;
    edBillNo: TRzDBEdit;
    edDepotName: TRzDBEdit;
    Label3: TLabel;
    edDepotNo: TRzDBButtonEdit;
    Label2: TLabel;
    edBerthNo: TRzDBButtonEdit;
    Label4: TLabel;
    edProvNo: TRzDBButtonEdit;
    edProvName: TRzDBEdit;
    Label5: TLabel;
    edGoodsName: TRzDBEdit;
    edGoodsID: TRzDBButtonEdit;
    Label6: TLabel;
    edQty: TRzDBEdit;
    edPrice: TRzDBEdit;
    Label7: TLabel;
    Label8: TLabel;
    edAmount: TRzDBEdit;
    edUnit: TRzDBComboBox;
    Label9: TLabel;
    edFDate: TRzDBDateTimePicker;
    dbgStockTeardownDtl: TxDBGridEh;
    Label14: TLabel;
    edAuditName: TRzDBEdit;
    Label12: TLabel;
    edEmpName: TRzDBEdit;
    Label13: TLabel;
    edEmpNo: TRzDBButtonEdit;
    lbStatus: TRzDBLabel;
    edCreater: TRzDBEdit;
    Label15: TLabel;
    edCreatTime: TRzDBEdit;
    Label16: TLabel;
    edRemark: TRzDBEdit;
    Label17: TLabel;
    edMender: TRzDBEdit;
    Label18: TLabel;
    edUpdateTime: TRzDBEdit;
    DCOMConnection1: TDCOMConnection;
    cdsStockTeardown: TckClientDataSet;
    cdsStockTeardownDtl: TckClientDataSet;
    dsStockTeardown: TDataSource;
    dsStockTeardownDtl: TDataSource;
    cdsStockTeardownBillNo: TStringField;
    cdsStockTeardownFDate: TDateTimeField;
    cdsStockTeardownDepotID: TIntegerField;
    cdsStockTeardownDepotNo: TStringField;
    cdsStockTeardownDepotName: TStringField;
    cdsStockTeardownBerthNo: TStringField;
    cdsStockTeardownProvNo: TStringField;
    cdsStockTeardownProvName: TStringField;
    cdsStockTeardownGoodsID: TStringField;
    cdsStockTeardownName: TStringField;
    cdsStockTeardownSpecs: TStringField;
    cdsStockTeardownMaker: TStringField;
    cdsStockTeardownPDCAddr: TStringField;
    cdsStockTeardownUnit: TStringField;
    cdsStockTeardownQty: TBCDField;
    cdsStockTeardownPrice: TFloatField;
    cdsStockTeardownAmount: TBCDField;
    cdsStockTeardownBatchNo: TStringField;
    cdsStockTeardownEmpNo: TStringField;
    cdsStockTeardownEmpName: TStringField;
    cdsStockTeardownAudit: TStringField;
    cdsStockTeardownAuditName: TStringField;
    cdsStockTeardownTransfer: TBooleanField;
    cdsStockTeardownStatuText: TStringField;
    cdsStockTeardownRemark: TStringField;
    cdsStockTeardownCreater: TStringField;
    cdsStockTeardownCreatTime: TDateTimeField;
    cdsStockTeardownMender: TStringField;
    cdsStockTeardownUpdateTime: TDateTimeField;
    cdsStockTeardownGrup: TIntegerField;
    cdsStockTeardownadsStockTeardownDtl: TDataSetField;
    cdsStockTeardownDtlBillNo: TStringField;
    cdsStockTeardownDtlItemNo: TIntegerField;
    cdsStockTeardownDtlBerthNo: TStringField;
    cdsStockTeardownDtlGoodsID: TStringField;
    cdsStockTeardownDtlName: TStringField;
    cdsStockTeardownDtlSpecs: TStringField;
    cdsStockTeardownDtlQty: TBCDField;
    cdsStockTeardownDtlUnit: TStringField;
    cdsStockTeardownDtlPrice: TFloatField;
    cdsStockTeardownDtlAmount: TBCDField;
    cdsStockTeardownDtlBatchNo: TStringField;
    cdsStockTeardownDtlValidDate: TDateTimeField;
    cdsStockTeardownDtlMaker: TStringField;
    cdsStockTeardownDtlPdcAddr: TStringField;
    cdsStockTeardownDtlRemark: TStringField;
    Label11: TLabel;
    edBatchNo: TRzDBButtonEdit;
    Bevel1: TBevel;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
    procedure cdsStockTeardownNewRecord(DataSet: TDataSet);
    procedure cdsStockTeardownDtlNewRecord(DataSet: TDataSet);
    procedure cdsStockTeardownDtlAfterPost(DataSet: TDataSet);
    procedure cdsStockTeardownDtlAfterCancel(DataSet: TDataSet);
    procedure cdsStockTeardownAfterScroll(DataSet: TDataSet);
    procedure cdsStockTeardownAfterOpen(DataSet: TDataSet);
    procedure cdsStockTeardownDtlQtyChange(Sender: TField);
    procedure cdsStockTeardownQtyChange(Sender: TField);
    procedure cdsStockTeardownDtlGoodsIDChange(Sender: TField);
    procedure cdsStockTeardownGoodsIDChange(Sender: TField);
    procedure dbgStockTeardownDtlEditButtonClick(Sender: TObject);
    procedure edDepotNoButtonClick(Sender: TObject);
    procedure edDepotNoKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure edGoodsIDButtonClick(Sender: TObject);
    procedure edGoodsIDKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure edBerthNoButtonClick(Sender: TObject);
    procedure edProvNoButtonClick(Sender: TObject);
    procedure edBerthNoKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure edProvNoKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure edEmpNoButtonClick(Sender: TObject);
    procedure edEmpNoKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ActAuditExecute(Sender: TObject);
    procedure ActRevertExecute(Sender: TObject);
    procedure ActFieldLayoutExecute(Sender: TObject);
    procedure ActDataExportExecute(Sender: TObject);
    procedure ActUpdateExecute(Sender: TObject);
    procedure edBatchNoButtonClick(Sender: TObject);
    procedure edUnitKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure edBatchNoKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ActQueryExecute(Sender: TObject);
  private
    { Private declarations }
    FMaxItemNo: integer;
    CdsFieldProPerty:TCkClientDataSet;
    LocSetting: PLocSetting;
    iClientID:Integer;
    SvrStockTeardown,SvrCommon:TDispatchConnection;
  public
    { Public declarations }
  end;

Const
  sFieldProPerty='Select * From SysFieldProPerty '+
      ' Where TableName in(''StockTeardown'', ''StockTeardownDtl'',''Goodses'')';

var
  FmStockTeardown: TFmStockTeardown;

implementation
uses SelectGoodsFrm,FieldsLayoutFrm,DataExportFrm,ViewGoodsPriceFrm,
      SelectEmpFrm,SelectDepotFrm,SelectBerthFrm, ShowProGress,
      SelectProvFrm, SelectBatchNoFrm;

{$R *.dfm}

procedure TFmStockTeardown.FormCreate(Sender: TObject);
begin
  inherited;
  IFmMain.SetActionStatus(ActionList1, hInstance, self.ClassName);
  CdsFieldProPerty:=TCKClientDataSet.Create(Self);
  LocSetting := IFmMain.IFmMainEx.GetLocSetting;
  SetGressHint('正在连接仓库服务器...');
  iClientID:=IFmMain.IFmMainEx.ClientID;
  SvrStockTeardown := IFmMain.GetConnection(Handle,'','CkStockSvr.Stock');
  sBillNoList.Text := SvrStockTeardown.AppServer.GetCurrMonthBills(iClientID, 'StockTeardown');
  cdsStockTeardown.RemoteServer:=SvrStockTeardown;
  SetGressHint('正在连接到公用信息服务器...');
  SvrCommon:=IFmMain.GetConnection(Handle,'','CommonSvr.CommonRDM');
  CdsFieldProPerty.ProviderName:='DspTemp';
  CdsFieldProPerty.RemoteServer:=SvrCommon;
  SetGressHint('正在读取用户操作权限...');
  RepDataSetNames := '药品拆卸加工单;药品拆卸加工明细';
  sRepSection := '药品拆卸加工单';
  MasterDataSet:=cdsStockTeardown;
  SetLength(FDetailDataSets, 1);
  FDetailDataSets[0] := cdsStockTeardownDtl;
end;

procedure TFmStockTeardown.FormShow(Sender: TObject);
begin
  SetGressHint('初始化本地环境...');
  SetGridEhColor(dbgStockTeardownDtl);
  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFmStockTeardownDtl.Xml');
  SetFieldProperty(CdsFieldProPerty,CdsStockTeardown, 'StockTeardown');
  SetFieldProperty(CdsFieldProPerty,CdsStockTeardownDtl, 'StockTeardownDtl,Goodses');
  SetGressHint('读取历史单据...');
  SetCurrBillIdx(0);
  inherited;
  FreeGressForm;
end;

procedure TFmStockTeardown.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  inherited;
  //
end;

procedure TFmStockTeardown.FormDestroy(Sender: TObject);
begin
  CdsFieldProPerty.Free;
  inherited;
end;

procedure TFmStockTeardown.cdsStockTeardownNewRecord(DataSet: TDataSet);
begin
  cdsStockTeardownEmpNo.Value := LogonInfo^.UserID;
  cdsStockTeardownCreater.Value := LogonInfo^.UserID;
  cdsStockTeardownGrup.Value := LogonInfo^.UserGrupID;
  cdsStockTeardownFDate.Value :=Date;
  cdsStockTeardownBillNo.Value := BuildBillNo('StockTeardown');
end;

procedure TFmStockTeardown.cdsStockTeardownDtlNewRecord(DataSet: TDataSet);
begin
  FMaxItemNo := FMaxItemNo + 1;
  cdsStockTeardownDtlItemNo.Value := FMaxItemNo;
  cdsStockTeardownDtlBillNo.Value := edBillNo.Text;
  DataSet.Tag := -1; //新增标志,如果用户取消操作,则根据些标志减FMaxItemNo
end;

procedure TFmStockTeardown.cdsStockTeardownDtlAfterPost(DataSet: TDataSet);
begin
  DataSet.Tag := 0;
end;

procedure TFmStockTeardown.cdsStockTeardownDtlAfterCancel(DataSet: TDataSet);
begin
  if DataSet.Tag <> 0 then
    Dec(FMaxItemNo);
  DataSet.Tag := 0;
end;

procedure TFmStockTeardown.cdsStockTeardownAfterScroll(DataSet: TDataSet);
var
  i: integer;
  bk: string;
begin
  //改变单据状态文字颜色
  if cdsStockTeardownTransfer.Value then
    lbStatus.Font.Color := clBlue
  else
    lbStatus.Font.Color := clRed;
  //取得最大项次。本来可以直接取DBGRID的行数加1,但
  //考虑到用户可能删除位于中间的行;也可以以ITEMNO排序取得最大,
  //但可能以其他列排序,所以要这样取得最大项次
  FMaxItemNo := 0;
  with cdsStockTeardownDtl do
  begin
    bk := Bookmark;
    DisableControls;
    First;
    for i:=0 to RecordCount-1 do
    begin
      if FieldByName('ItemNo').AsInteger > FMaxItemNo then
        FMaxItemNo := FieldByName('ItemNo').AsInteger;
      Next;
    end;
    Bookmark := bk;
    EnableControls;
  end;
end;

procedure TFmStockTeardown.cdsStockTeardownAfterOpen(DataSet: TDataSet);
begin
  cdsStockTeardownAfterScroll(DataSet);
end;

procedure TFmStockTeardown.cdsStockTeardownDtlQtyChange(Sender: TField);
var
  dAmount: Double;
begin
  dAmount := cdsStockTeardownDtlQty.Value;
  dAmount := dAmount * cdsStockTeardownDtlPrice.Value;
  cdsStockTeardownDtlAmount.Value := dAmount;
end;

⌨️ 快捷键说明

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