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