selectbatchnofrm.~pas

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

~PAS
481
字号

procedure TFmSelectBatchNo.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Action := caHide;
end;

procedure TFmSelectBatchNo.GetGoodsInfo(sGoodsID: String);
begin
  if sGoodsID=FGoodsID then Exit;
  //取得商品名称等信息
  FGoodsID := sGoodsID;
end;

procedure TFmSelectBatchNo.SetDepotGoods(DepotID: Integer; GoodsID, GUnit, ByBerth: String);
const
  sqStr = 'select * from BatchPartStock where GoodsID=''%s'' ';
var sGoodsInfo: String;
    i, k: integer;
    sList: TStrings;
    aNode: TTreeNode;
begin
  sGoodsInfo := '.';//约定了如果传入空值则不返回药品信息
  cdsStock.Data := SvrCommon.AppServer.QueryStock(iClientID, DepotID, GoodsID, sGoodsInfo, ByBerth);
  FGoodsInfo.GoodsID := GoodsID;
  if sGoodsInfo='' then
  begin
    FGoodsInfo.Name := '';
    FGoodsInfo.Specs := '';
    FGoodsInfo.Unit1 := '';
    FGoodsInfo.Unit2 := '';
    FGoodsInfo.ConvRate1 := 0;
    FGoodsInfo.ConvRate2 := 0;
    FGoodsInfo.PdcAddr := '';
    FGoodsInfo.maker := '';
    FGoodsInfo.MakerName := '';
  end else
  begin
    sList := TStringList.Create;
    sList.Text := sGoodsInfo;
    FGoodsInfo.Name  := sList[0];
    FGoodsInfo.Specs := sList[1];
    FGoodsInfo.Unit1 := sList[2];
    FGoodsInfo.Unit2 := sList[3];
    FGoodsInfo.ConvRate1 := StrToInt(sList[4]);
    FGoodsInfo.ConvRate2 := StrToInt(sList[5]);
    FGoodsInfo.PdcAddr   := sList[6];
    FGoodsInfo.maker     := sList[7];
    FGoodsInfo.MakerName := sList[8];
    sList.Free;
  end;
  colBerth.Visible := ByBerth<>'';
  bUseUnit2 := GUnit=FGoodsInfo.Unit2;
  if bUseUnit2 then
  begin
    colQty.Field := cdsStockFullQty2;
    colPrice.Field := cdsStockPrice2;
    colUsable.Field := cdsStockUsableQty2;
  end else
  begin
    colQty.Field := cdsStockFullQty0;
    colPrice.Field := cdsStockPrice1;
    colUsable.Field := cdsStockUsableQty0;
  end;
  lbName.Caption := FGoodsInfo.Name;
  lbSpecs.Caption:= FGoodsInfo.Specs;
  lbUnit.Caption := GUnit;
  lbPdcAddr.Caption := FGoodsInfo.PdcAddr;
  lbMaker.Caption   := FGoodsInfo.MakerName;
  tvDepots.Enabled := DepotID<=0;
  if DepotID<=0 then
    tvDepots.TopItem.Selected := true
  else begin
    k := tvDepots.Items.Count;
    for i:=0 to k-1 do
    begin
      aNode := tvDepots.Items[i];
      if Integer(aNode.Data)=DepotID then
      begin
        aNode.Selected := true;
        Break;
      end;
    end;
  end;
{  if DepotID>0 then
    sw := ' and DepotID='+IntToStr(DepotID);
  sw := Format(sqStr, [GoodsID])+sw;
  with cdsStock do begin
    Close;
    CommandText := sw;
    Open;
  end;
  GetGoodsInfo(GoodsID);}
end;

procedure TFmSelectBatchNo.BtnOkClick(Sender: TObject);
begin
  if cdsStock.IsEmpty then Exit;
  ModalResult := mrOk;
end;

function TFmSelectBatchNo.GetLevel(sFormat, sCode: String): Integer;
var i,Level,iLen:Integer;
begin
  Level:=-1;//如果代码不符合标准,则返回-1
  iLen:=0;
  if (sFormat<>'')and(sCode<>'')then
    for i:=1 to Length(sFormat) do begin
      iLen := iLen+StrToInt(sFormat[i]);
      if Length(sCode)=iLen then begin
        Level:=i;
        Break;
      end;
    end;
  Result:=Level;
end;
//上面函数的功能是返回一代码的级数

procedure TFmSelectBatchNo.FillDepotList;
var sDepotNoFmt, sDepotNo, sDepotName, Str: String;
    h, Level, iDepotID:Integer;
    b1, b2: Boolean;
    vNodes:Array of TTreeNode; //保存各级节点
    aNode: TTreeNode;
begin
  if sDepotNoFmt='' then with cdsTemp do begin
    Close;
    CommandText := 'SELECT DepotNoFormat FROM SysSetting ';
    Open;
    sDepotNoFmt := Fields[0].AsString;
    if sDepotNoFmt='' then begin
      Application.MessageBox('请先设置仓库编码格式!', '消息', MB_ICONINFORMATION);
      Exit;
    end;
  end;
  with cdsDepots do begin
    Close;
    CommandText := 'select DepotID, DepotNo, DepotName, RankDepot, initialized, DefBerthNo from Depots order by DepotNo';
    Open;
    h := Length(sDepotNoFmt);
    SetLength(vNodes, h+1);
    Level := 0;
    tvDepots.Items.Clear;
    aNode := tvDepots.Items.AddChild(nil, '[所有仓库]');
    aNode.Data := nil;
    vNodes[Level] := aNode;
    First;
    while not eof do begin
      iDepotID := Fields[0].AsInteger;
      sDepotNo := Trim(Fields[1].AsString);
      sDepotName := Fields[2].AsString;
      b1 := Fields[3].AsBoolean;
      b2 := Fields[4].AsBoolean;
      Level:=GetLevel(sDepotNoFmt, sDepotNo);//返回代码的级数
      //以下是增加子项
      //以下用上一级节点为父节点添加子节点
      if Level>0 then begin//确保代码符合标准
        str := sDepotNo+'['+sDepotName+']';
        if not b1 then begin
          if not b2 then
            str := str+'*';
        end;
        aNode := tvDepots.Items.AddChild(vNodes[Level-1], str);
        aNode.Data := Pointer(iDepotID);
        vNodes[Level] := aNode;
      end;
      //以上是增加子项
      Next;
    end;
  end;
  tvDepots.FullExpand;
//  vNodes[0].Expanded := true;
end;

procedure TFmSelectBatchNo.tvDepotsCollapsing(Sender: TObject;
  Node: TTreeNode; var AllowCollapse: Boolean);
begin
  AllowCollapse := Node.Level>0;
end;

procedure TFmSelectBatchNo.tvDepotsChanging(Sender: TObject;
  Node: TTreeNode; var AllowChange: Boolean);
var iDepotID: Integer;
    sDepotNo, sDepotName: String;
    b1: Boolean;
begin
  iDepotID := integer(Node.Data);
  if iDepotID=0 then begin
    sDepotNo := '';
    sDepotName := '[所有仓库]';
    cdsStock.Filtered := false;
  end else begin
    if not cdsDepots.Locate('DepotID', iDepotID, []) then
      raise Exception.Create('找不到仓库记录');
    b1 := cdsDepots.FieldByName('RankDepot').AsBoolean;
    sDepotNo := cdsDepots.FieldByName('DepotNo').AsString;
    sDepotName := cdsDepots.FieldByName('DepotName').AsString;
    if b1 then
      cdsStock.Filter := 'DepotNo like '''+sDepotNo+'%'''
    else
      cdsStock.Filter := 'DepotNo='''+sDepotNo+'''';
    cdsStock.Filtered := true;
  end;
end;

{procedure TFmSelectBatchNo.cdsStockCalcFields(DataSet: TDataSet);
begin
  if bUseUnit2 then
  begin
    //cdsStockFullQty2.Value := cdsStockQty1.Value*FGoodsInfo.ConvRate2/FGoodsInfo.ConvRate1+cdsStockQty2.Value;
  end;
end;}

procedure TFmSelectBatchNo.edOutTotalKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
  if (key=VK_UP)or(key=VK_DOWN) then
  begin
    if Shift=[ssShift] then
      PostMessage(tvDepots.Handle,WM_KEYDOWN,Key,0)
    else
      PostMessage(dbgStock.Handle,WM_KEYDOWN,Key,0);
    key :=0;
  end;
end;

initialization
  RegisterClass(TFmSelectBatchNo);
  if not Assigned(FmSelectBatchNo) then begin
    if Application.MainForm.ClassName<>'TAppBuilder' then
      FmSelectBatchNo := TFmSelectBatchNo.Create(Application.MainForm);
  end;

finalization
  UnRegisterClass(TFmSelectBatchNo);
  if Assigned(FmSelectBatchNo) then
    FreeAndNil(FmSelectBatchNo);

end.

⌨️ 快捷键说明

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