stocksinglecheckfrm.pas
来自「群星医药系统源码」· PAS 代码 · 共 629 行 · 第 1/2 页
PAS
629 行
edGoodsID.Text := B.Strings[0];
if B.Strings[1]<>'' then
edUnits.Add(B.Strings[1]);
if B.Strings[2]<>'' then
edUnits.Add(B.Strings[2]);
if cdsStockSingleCheck.Active and (edUnits.Count >0) and (cdsStockSingleCheck.State in dsEditModes) then
edUnits.Field.AsString := edUnits.Items.Strings[0];
if cdsStockSingleCheck.State in dsEditModes then
cdsStockSingleCheckGoodsID.Value := edGoodsID.Text;
end;
finally
A.Free;
B.Free;
end;
end;
procedure TFmStockSingleCheck.ActInsertExecute(Sender: TObject);
begin
if not cdsStockSingleCheck.Active then exit;
if not chkDefDepot.Checked then edDepotNo.Text := '';
if not chkDefBerth.Checked then edBerthNo.Text := '';
if not chkDefGoods.Checked then edGoodsID.Text := '';
with cdsStockSingleCheck do
begin
FCanInsert := true;
Insert;
if edDepotNo.Text <> '' then
cdsStockSingleCheckDepotID.Value := edDepotNo.Tag;
if edBerthNo.Text <> '' then
cdsStockSingleCheckBerthNo.Value := edBerthNo.Text;
if edGoodsID.Text <> '' then
cdsStockSingleCheckGoodsID.Value := edGoodsID.Text;
cdsStockSingleCheckFDATE.Value := Date;
FieldByName('GroupNo').AsInteger := 0;
end;
end;
procedure TFmStockSingleCheck.btnSaveClick(Sender: TObject);
begin
if actQuery.Enabled and ActInsert.Enabled then
with cdsStockSingleCheck do
if not Active then
exit
else
if ApplyUpdates(0)>0 then
MessageBox(Handle,'提交错误出错!',nil,MB_ICONHAND);
end;
procedure TFmStockSingleCheck.btnCancelClick(Sender: TObject);
begin
with cdsStockSingleCheck do
begin
if not Active then exit;
if ChangeCount>0 then
if MessageBox(Handle,'确定要取消所有更改吗?','提示',MB_YESNO or MB_ICONQUESTION)=IDNO then exit;
CancelUpdates;
end;
end;
procedure TFmStockSingleCheck.btnRefreshClick(Sender: TObject);
begin
if actQuery.Enabled and ActInsert.Enabled then
with cdsStockSingleCheck do
begin
if not Active then
exit
else
if ApplyUpdates(0)>0 then
begin
MessageBox(Handle,'试图提交未保存的数据时失败!请检查数据并保存或取消后再刷新。','警告',MB_ICONEXCLAMATION);
exit;
end;
Refresh;
end;
end;
procedure TFmStockSingleCheck.ActDeleteExecute(Sender: TObject);
begin
with cdsStockSingleCheck do
if not Active then
exit
else
Delete;
end;
procedure TFmStockSingleCheck.cdsStockSingleCheckBeforeDelete(
DataSet: TDataSet);
begin
if DataSet.FieldByName('Posted').AsInteger =1 then Abort;
if MessageBox(Handle,'你确定要删除当前记录吗?','提示',MB_ICONQUESTION or MB_YESNO)=IDNO then
Abort;
end;
procedure TFmStockSingleCheck.cbFilterClick(Sender: TObject);
begin
if not actQuery.Enabled then exit;
with cdsStockSingleCheck do
begin
close;
Params[0].AsInteger := cbFilter.ItemIndex;
Open;
end;
end;
procedure TFmStockSingleCheck.ActAuditExecute(Sender: TObject);
var
iDepotID,iBranchID,iMachineId: integer;
sFlagStr,sBillNo: string;
begin
if cdsStockSingleCheck.IsEmpty then exit;
iDepotID := edDepotNo.Tag;
if iDepotID = 0 then
begin
MessageBox(Handle,'请选择一个要结算的仓库!','警告',MB_ICONEXCLAMATION);
exit;
end;
iBranchID := IFmMain.IFmMainEx.GetLocSetting^.BranchNo;
iMachineId := IFmMain.IFmMainEx.GetLocSetting^.MachineNo;
sFlagStr := FormatFloat('000',iBranchID)+FormatFloat('00',iMachineID);
sBillNo := SvrStockSingleCheck.AppServer.CompleteStockSingleCheck(iClientID,iDepotID,sFlagStr,0);
if sBillNo <> '' then
begin
if MessageBox(Handle,PChar('结算完成!系统已自动生成['+sBillNo+']号盘点盈亏单。'#13'要查看吗?'),'提示',MB_ICONINFORMATION or MB_YESNO)=IDNO then exit;
IFmMain.DoSome(ActViewBill.ModuleFile, 'ViewBill', sBillNo);
end;
end;
procedure TFmStockSingleCheck.cdsStockSingleCheckBeforePost(
DataSet: TDataSet);
begin
with DataSet do
begin
if FieldByName('DepotID').AsString = '' then
FieldByName('DepotID').AsInteger := edDepotNo.Tag;
if FieldByName('BerthNo').AsString = '' then
FieldByName('BerthNo').AsString := edBerthNo.Text;
if FieldByName('GoodsID').AsString = '' then
FieldByName('GoodsID').AsString := edGoodsID.Text;
end;
end;
procedure TFmStockSingleCheck.cdsStockSingleCheckAfterCancel(
DataSet: TDataSet);
begin
FCanInsert := false;
end;
procedure TFmStockSingleCheck.cdsStockSingleCheckAfterPost(
DataSet: TDataSet);
begin
FCanInsert := false;
end;
procedure TFmStockSingleCheck.cdsStockSingleCheckAfterOpen(
DataSet: TDataSet);
begin
FCanInsert := false;
end;
procedure TFmStockSingleCheck.cdsStockSingleCheckBeforeInsert(
DataSet: TDataSet);
begin
if not FCanInsert then Abort;
end;
procedure TFmStockSingleCheck.edBatchNoButtonClick(Sender: TObject);
begin
if ViewGoodsBatch(edDepotNo.Tag, edGoodsID.Text, edUnits.Text, '.') then
begin
edBatchNo.text := FmSelectBatchNo.cdsStock.FieldByName('BatchNo').AsString;
if cdsStockSingleCheck.State in dsEditModes then
cdsStockSingleCheckBatchNo.Value := edBatchNo.Text;
end;
end;
procedure TFmStockSingleCheck.edDepotNoChange(Sender: TObject);
begin
if edDepotNo.Text = '' then
edDepotNo.Tag := 0;
end;
procedure TFmStockSingleCheck.btnPreviewClick(Sender: TObject);
var
i: integer;
begin
if edDepotNo.Tag =0 then
begin
MessageBox(Handle,'请先选择一个仓库!','警告',MB_ICONEXCLAMATION);
exit;
end;
with cdsPreview do
try
case MessageBox(Handle,'要忽略预览结果中盈亏总数相等的商品吗?','提示',MB_ICONQUESTION or MB_YESNO) of
IDNO: i := 1;
IDYES: i := 0;
end;
Screen.Cursor := crHourGlass;
Close;
CommandText := Format(sPreviewCmdText,[edDepotNo.Tag, i, 0]);
Open;
dbgPreview.ReadOnly := true;
ResetColumnWidthForPreview;
stPreview.RestoreHotSpot;
finally
Screen.Cursor := crDefault;
end;
end;
procedure TFmStockSingleCheck.ResetColumnWidthForPreview;
var
i,w,MaxW: integer;
bk,s: string;
begin
with cdsPreview do
begin
if (not Active)or IsEmpty then exit;
bk := Bookmark;
DisableControls;
for i:=0 to Fields.Count -1 do
begin
MaxW := 0;
if i > dbgPreview.Columns.Count -1 then break;
w := dbgPreview.Canvas.TextWidth(dbgPreview.Columns[i].Title.Caption)+4;
if MaxW < w then MaxW :=w;
First;
while not eof do
begin
if not Fields[i].IsNull then
begin
w := dbgPreview.Canvas.TextWidth(Fields[i].AsString)+4;
if MaxW < w then MaxW :=w;
end;
Next;
end;
dbgPreview.Columns[i].Width := MaxW;
end;
Bookmark := bk;
EnableControls;
end;
end;
procedure TFmStockSingleCheck.ActPrintExecute(Sender: TObject);
var DataSets:array of TDataSet;
begin
SetLength(DataSets, 1);
DataSets[0] := cdsStockSingleCheck;
SelRepPrint(Name, DataSets, '单品抽盘', ActDesignReport.Enabled);
end;
procedure TFmStockSingleCheck.cdsStockSingleCheckBeforeEdit(
DataSet: TDataSet);
begin
if cdsStockSingleCheckPosted.Value then Abort;
end;
procedure TFmStockSingleCheck.dbgStockSingleCheckEditButtonClick(
Sender: TObject);
var
Field: TField;
fn: string;
begin
if cdsStockSingleCheckPosted.Value then exit;
Field := dbgStockSingleCheck.SelectedField;
if Field = nil then exit;
fn := LowerCase(Field.FieldName);
if not (cdsStockSingleCheck.State in dsEditModes) then
cdsStockSingleCheck.Edit;
if fn='depotno' then
edDepotNoButtonClick(nil);
if fn='berthno' then
edBerthNoButtonClick(nil);
if fn='goodsid' then
SelectGoods(cdsStockSingleCheck,Field,cdsStockSingleCheckUnit,true,false,false);
if fn='batchno' then
edBatchNoButtonClick(nil);
end;
procedure TFmStockSingleCheck.cdsStockSingleCheckGoodsIDChange(
Sender: TField);
const
bShow: boolean=false;
begin
if bShow then exit;
bShow := true;
try
if not SelectGoods(cdsStockSingleCheck,cdsStockSingleCheckGoodsID,cdsStockSingleCheckUnit,true,false,false) then
Abort;
finally
bShow := false;
end;
end;
procedure TFmStockSingleCheck.cdsStockSingleCheckAfterScroll(
DataSet: TDataSet);
begin
if not chkDefDepot.Checked then
begin
edDepotNo.Text := cdsStockSingleCheckDepotNo.Value;
edDepotNo.Tag := cdsStockSingleCheckDepotID.Value;
end;
if not chkDefBerth.Checked then
edBerthNo.Text := cdsStockSingleCheckBerthNo.Value;
if not chkDefGoods.Checked then
edGoodsID.Text := cdsStockSingleCheckGoodsID.Value;
end;
initialization
RegisterClass(TFmStockSingleCheck);
finalization
UnRegisterClass(TFmStockSingleCheck);
end.
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?