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 + -
显示快捷键?