selectbatchnofrm.~pas

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

unit SelectBatchNoFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, DBClient, MConnect, Grids, DBGridEh, DbUtilsEh, EhLibCDS, xEhLibCtl,
  StdCtrls, Mask, RzEdit, Buttons, ExtCtrls, RzPanel, RzButton, ComCtrls, RzTreeVw,
  RzBtnEdt, RzRadChk,
  xBaseFrm, IMainFrm, ckDBClient;

type
  TGoodsInfo = record
    GoodsID:String[16];
    Name:   string[24];
    Specs:  String[20];
    Unit1:  String[8];
    Unit2:  String[8];
    ConvRate1: Integer;
    ConvRate2: Integer;
    PdcAddr: String[12];
    maker:   string[12];
    MakerName: String[40];
  end;

  TFmSelectBatchNo = class(TxBaseForm)
    DCOMConn: TDCOMConnection;
    cdsStock: TckClientDataSet;
    dsStock: TDataSource;
    RzPanel1: TRzPanel;
    Label2: TLabel;
    BtnOk: TRzBitBtn;
    BtnCancel: TRzBitBtn;
    edOutTotal: TRzNumericEdit;
    Panel1: TPanel;
    tvDepots: TRzTreeView;
    Panel2: TPanel;
    dbgStock: TxDBGridEh;
    Panel3: TPanel;
    cdsDepots: TckClientDataSet;
    cdsTemp: TckClientDataSet;
    Label3: TLabel;
    lbName: TLabel;
    Label5: TLabel;
    lbSpecs: TLabel;
    Label1: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    lbPdcAddr: TLabel;
    lbMaker: TLabel;
    cdsStockDepotID: TIntegerField;
    cdsStockDepotNo: TStringField;
    cdsStockDepotName: TStringField;
    cdsStockBerthNo: TStringField;
    cdsStockPrice1: TBCDField;
    cdsStockPrice2: TBCDField;
    cdsStockAmount: TBCDField;
    cdsStockBatchNo: TStringField;
    cdsStockValidDate: TDateTimeField;
    cdsStockFullQty2: TBCDField;
    Label4: TLabel;
    lbUnit: TLabel;
    Panel4: TPanel;
    cdsStockFullQty0: TBCDField;
    cdsStockUsableQty0: TBCDField;
    cdsStockUsableQty2: TBCDField;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure BtnOkClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure tvDepotsCollapsing(Sender: TObject; Node: TTreeNode;
      var AllowCollapse: Boolean);
    procedure tvDepotsChanging(Sender: TObject; Node: TTreeNode;
      var AllowChange: Boolean);
    procedure edOutTotalKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    IFmMain: IMainForm;
    iClientID: Integer;
    SvrCommon: TDispatchConnection;
    FGoodsID: String;
    FGoodsInfo: TGoodsInfo;
    bUseUnit2: Boolean;
    ColQty, ColPrice, colUsable, colBerth: TColumnEh;//数量、单价列
    procedure GetGoodsInfo(sGoodsID: String);
    function  GetLevel(sFormat,sCode:String):Integer;
    Procedure FillDepotList;
  public
    procedure SetDepotGoods(DepotID: Integer; GoodsID, GUnit, ByBerth: String);
  end;

var
  FmSelectBatchNo: TFmSelectBatchNo;
  bBatchSelecting: Boolean=false;

procedure SelectGoodsBatch(DataSet: TDataSet; DepotID: Integer; ByBerth: String; sFields: String='');
Function ViewGoodsBatch(DepotID: Integer; GoodsID, GUnit, ByBerth: String): Boolean;

implementation

{$R *.dfm}

{参数说明：
DataSet:要选择输入商品批号的数据表，
DepotID:指定查看库存的仓库编码，如果为负数时则查看所有仓库
ByBerth:是否同显示货位并按货位分组统计库存，为空时不显示货位，当为'.'时按货位分组统计库存并显示货位，当为其它字符串时则按库位统计并仅显示该货位的库存
sFields:以#13分隔的字段列表，依次为商品代码、单位、数量、单价、批号、有效日期、仓库编码、仓库编号、仓库名称字段
}
procedure selectGoodsBatch(DataSet: TDataSet; DepotID: Integer; ByBerth, sFields: String);
const
  cFields = 'GoodsID'#13'Unit'#13'Qty'#13'OPrice'#13'BatchNo'#13'ValidDate'#13'DepotID'#13'DepotNo'#13'DepotName'#13'BerthNo';
var sGoodsID, sUnit: String;
		dQty, dUsable, dWillOut, dPrice: Double;
    j: Integer;
    sFldList: TStrings;
    fldGoodsID, fldUnit, fldQty, fldPrice, fldBatchNo, fldValidDate,
    fldDepotID, fldDepotNO, fldDepotName, fldBerthNo: TField;
begin
	if bBatchSelecting or not DataSet.Active then Exit;
  if sFields='' then sFields := cFields;
  sFldList := TStringList.Create;
  sFldList.Text := sFields;
  j := sFldList.Count;
  if j<9 then
  begin
    sFldList.Free;
    Application.MessageBox('没有传入完整的字段信息！', '消息', MB_ICONINFORMATION);
    Exit;
  end;
  fldGoodsID := DataSet.FindField(sFldList[0]);
  fldUnit    := DataSet.FindField(sFldList[1]);
  fldQty     := DataSet.FindField(sFldList[2]);
  fldPrice   := DataSet.FindField(sFldList[3]);
  fldBatchNo := DataSet.FindField(sFldList[4]);
  fldValidDate:=DataSet.FindField(sFldList[5]);
  fldDepotID := DataSet.FindField(sFldList[6]);
  fldDepotNo := DataSet.FindField(sFldList[7]);
  fldDepotName:=DataSet.FindField(sFldList[8]);
  if j>9 then
    fldBerthNo := DataSet.FindField(sFldList[9]);
  sFldList.Free;
  if (fldGoodsID=nil)or(fldUnit=nil)or(fldQty=nil)or(fldBatchNo=nil) then
  begin
    Application.MessageBox('没有指定药品代码、单位、数量或批号字段信息！', '消息', MB_ICONWARNING);
    Exit;
  end;
  sGoodsID := fldGoodsID.AsString;
  sUnit    := fldUnit.AsString;
  if(sGoodsID='')or(sUnit='') then
  begin
    Application.MessageBox('请先输入药品代码及单位信息！', '警告', MB_ICONWARNING);
    Exit;
  end;
  bBatchSelecting := true;
  try
    dQty := fldQty.AsFloat;
    if fldPrice<>nil then
      dPrice := fldPrice.AsFloat;
    with FmSelectBatchNo do begin
      edOutTotal.Value := dQty;
      SetDepotGoods(DepotID, sGoodsID, sUnit, ByBerth);
      if ShowModal=mrOk then begin
        dWillOut := edOutTotal.Value;
        while (dWillOut>0)AND(not cdsStock.Eof) do begin
          dUsable := ColUsable.Field.AsFloat;
          if dUsable<=0 then
          begin
            cdsStock.Next;
            Continue;
          end;
          if fldGoodsID.AsString=sGoodsID then
            DataSet.Edit
          else
          begin
            fldGoodsID.AsString := sGoodsID;
            fldUnit.AsString    := sUnit;
            if fldPrice<>nil then
              fldPrice.AsFloat := dPrice;
          end;
          if dWillOut>dUsable then begin
            fldQty.AsFloat := dUsable;
            dWillOut := dWillOut-dUsable;
          end else
          begin
            fldQty.AsFloat := dWillOut;
            dWillOut := 0;
          end;
          fldBatchNo.AsString := cdsStockBatchNo.AsString;
          if fldValidDate<>nil then//有效期
            fldValidDate.AsVariant := cdsStockValidDate.AsVariant;
          if fldDepotID<>nil then//仓库编码
            fldDepotID.AsVariant := cdsStockDepotID.AsVariant;
          if fldDepotNo<>nil then//仓库编号
            fldDepotNo.AsVariant := cdsStockDepotNo.AsVariant;
          if fldDepotName<>nil then//仓库名称
            fldDepotName.AsVariant := cdsStockDepotName.AsVariant;
          if fldBerthNo<>nil then//库位
            fldBerthNo.AsVariant := cdsStockBerthNo.AsVariant;
          if dWillOut=0 then
            Break;
          DataSet.Post;
          DataSet.Append;
          cdsStock.Next;
        end;
      end;
    end;
  finally
    bBatchSelecting := false;
  end;
end;

Function ViewGoodsBatch(DepotID: Integer; GoodsID, GUnit, ByBerth: String): Boolean;
begin
  with FmSelectBatchNo do begin
    SetDepotGoods(DepotID, GoodsID, GUnit, ByBerth);
    Result := ShowModal=mrOK;
  end;
end;

procedure TFmSelectBatchNo.FormCreate(Sender: TObject);
begin
  Inherited;
  IFmMain := (Application.MainForm as IMainForm);
  iClientID := IFmMain.IFmMainEx.ClientID;
  SvrCommon := IFmMain.GetConnection(Handle,'','CommonSvr.CommonRDM');
  cdsStock.RemoteServer := SvrCommon;
  cdsDepots.RemoteServer := SvrCommon;
  cdsTemp.RemoteServer := SvrCommon;
  ColQty := dbgStock.FieldColumns['FullQty0'];
  ColPrice := dbgStock.FieldColumns['Price1'];
  ColUsable:= dbgStock.FieldColumns['UsableQty0'];
  colBerth := dbgStock.FieldColumns['BerthNo'];
  FillDepotList;
  dbgStock.SetAutoSort('');
end;

procedure TFmSelectBatchNo.FormShow(Sender: TObject);
begin
  Inherited;
  edOutTotal.SetFocus;
end;