stockoutfm.~pas

来自「群星医药系统源码」· ~PAS 代码 · 共 675 行 · 第 1/2 页

begin
  ParseGoodsInfo;
End;

procedure TFmStockOut.dbgStockOutDtlEditButtonClick(Sender: TObject);
var sField, sBerthNo: String;
    iDepotID: integer;
begin
  if FEditMode=0 then Exit;
  sField := LowerCase(dbgStockOutDtl.SelectedField.FieldName);
  if StrIComp(PChar(sField), 'GoodsId')=0 then
    ParseGoodsInfo
  else if (StrIComp(PChar(sField), 'Qty')=0)or(StrIComp(PChar(sField), 'BatchNo')=0) then
  begin
    if cdsStockOutDepotID.IsNull then
    begin
      Application.MessageBox('请先指定出货仓库', '消息', MB_ICONINFORMATION);
      Exit;
    end;
    cdsStockOutDtl.Edit;
    if ViewGoodsBatch(cdsStockOutDepotID.Value, cdsStockOutDtlGoodsID.Value, cdsStockOutDtlUnit.Value, '.') then
    begin
      cdsStockOutDtlQty.Value := FmSelectBatchNo.edOutTotal.Value;
      cdsStockOutDtlBatchNo.Value := FmSelectBatchNo.cdsStock.FieldByName('BatchNo').AsString;
    end;
  end
  else if sField = 'berthno' then
  begin
    iDepotID := CdsStockOut.fieldbyname('DepotID').AsInteger;
    if iDepotID = 0 then
    begin
      Application.MessageBox('请先指定出货仓库！','提示',MB_OK+MB_ICONINFORMATION);
      exit;
    end;
    If SelectBerth(iDepotID,sBerthNo) Then
    begin
      CdsStockOutDtl.Edit;
      CdsStockOutDtlBerthNo.Value := sBerthNO;
    end;
  end;
end;


procedure TFmStockOut.CdsStockOutCustNOChange(Sender: TField);
Var
  sCustNo,sCustName,LogText:String;
begin
  IF FEditMode=0 Then Exit;
  sCustNo:=CdsStockOutCustNo.Value;
  If sCustNo='' Then Exit;
  if sCustNo=BeforeCustNo Then Exit;
  BeforeCustNo:=sCustNO;
  sCustName:=VarToStr(SvrCommon.AppServer.GetCustInfo(iClientID,sCustNo,1,'CustName',LogText));
  CdsStockOutCustName.Value:=sCustName;
  If LogText<>'' Then Begin
    Messagebox(Handle,Pchar(LogText),nil,16);
    RzDBEdit2.SetFocus;
    Abort;
  End;
end;

procedure TFmStockOut.CdsStockOutEmpNoChange(Sender: TField);
Var
  sEmpNo,sEmpName,LogText:String;
begin
  IF FEditMode=0 Then Exit;
  sEmpNo:=CdsStockOutEmpNo.Value;
  If sEmpNo='' Then Exit;
  if sEmpNo=BeforeEmpNo Then Exit;
  BeforeEmpNo:=sEmpNO;
  sEmpName:=VarToStr(SvrCommon.AppServer.GetEmpInfo(iClientID,sEmpNo,1,'Name',LogText));
  CdsStockOutName.Value:=sEmpName;
  If LogText<>'' Then Begin
    Messagebox(Handle,Pchar(LogText),nil,16);
    RzDBEdit5.SetFocus;
    Abort;
  End;
end;

procedure TFmStockOut.CdsStockOutShipperChange(Sender: TField);
Var
  sShipper,sShipName,LogText:String;
begin
  IF FEditMode=0 Then Exit;
  sShipper:=CdsStockOutShipper.Value;
  If sShipper='' Then Exit;
  if sShipper=BeforeShipper Then Exit;
  BeforeShipper:=sShipper;
  sShipName:=VarToStr(SvrCommon.AppServer.GetEmpInfo(iClientID,sShipper,1,'Name',LogText));
  CdsStockOutShipName.Value:=sShipName;
  If LogText<>'' Then Begin
    Messagebox(Handle,Pchar(LogText),nil,16);
    RzDBEdit6.SetFocus;
    Abort;
  End;
end;

procedure TFmStockOut.CdsStockOutDepotNoChange(Sender: TField);
Var
  sDepotNo,LogText:String;
  A:Variant;
begin
  Try
    IF FEditMode=0 Then Exit;
    sDepotNo:=CdsStockOutDepotNo.Value;
    If sDepotNo='' Then Exit;
    if sDepotNo=BeforeDepotNo Then Exit;
    BeforeDepotNo:=sDepotNo;
    A := SvrCommon.AppServer.GetDepotInfo(iClientID,sDepotNo,2,'DepotID,DepotName',LogText);
    CdsStockOutDepotID.Value  := A[0];
    CdsStockOutDepotName.Value:= A[1];
    If LogText<>'' Then Begin
      Messagebox(Handle,Pchar('无效的仓库编号...'),nil,16);
      RzDBEdit3.SetFocus;
      Abort;
    End;
  Except
    Messagebox(Handle,Pchar('无效的仓库编号...'),nil,16);
    RzDBEdit3.SetFocus;
  End;
end;
procedure TFmStockOut.CdsStockOutDtlAfterPost(DataSet: TDataSet);
Var
  dQty:Double;
  AbK:TBookMark;
begin
  BeforeGoodsID:='';
  with CdsStockOutDtl Do Begin
    dQty:=0;
    Try
      AbK:=GetBookmark;
      DisableControls;
      First;
      While Not Eof Do Begin
        dQty:=dQty+CdsStockOutDtlQty.Value;
        Next;
      End;
      CdsStockOutGoodsQty.Value:=dQty;
    Finally
      GotoBookmark(Abk);
      FreeBookmark(Abk);
      EnableControls;
    End;
  End;
end;

procedure TFmStockOut.ActUpdateExecute(Sender: TObject);
begin
  If CdsStockOut.IsEmpty Then Exit;
  If CdsStockOutTransfer.Value  Then Begin
    Messagebox(Handle,Pchar('当前的出库单已审核，不能进行修改操作!'),nil,16);
    Exit;
  End;
  inherited;
  BeforeDepotNo :='';
  BeforeCustNo  :='';
  BeforeEmpNo   :='';
  BeforeShipper :='';
end;

procedure TFmStockOut.ActAuditExecute(Sender: TObject);
Var Str : String;
    sSysInfo : Variant;
begin
  if FEditMode>0 then Exit;
  if cdsStockOut.IsEmpty Then Exit;
  if Application.MessageBox('单据审核后将不允许修改，确实要审核当前数据吗？','提示',4+32)<>6 then Exit;
  str := 'CurrMonth';
  sSysInfo := SvrCommon.AppServer.GetSysInfo(iClientID,Str,1);
  If Not(VarIsNull(sSysInfo)) Then Begin
    If CdsStockOutFDate.Value<VarToDateTime(sSysInfo) Then Begin
      Messagebox(Handle,Pchar('该月已结算，不能操作已月结的单据！'),nil,16);
      Exit;
    End;
  End Else Begin
    Messagebox(Handle,Pchar('请先设置开帐日期...'),nil,16);
    Exit;
  End;
  if not SvrStockOut.AppServer.BillAudit(iClientID, 'StockOut', cdsStockOutbillNo.Value) then begin
      Messagebox(Handle,Pchar('复核数据不成功！'),nil,16);
  end else begin
    cdsStockOut.Refresh;
    ActAudit.Enabled:=False and CanAudit;
    ActRevert.Enabled:=True and CanRevert;
    Lab_State.Caption:='单据状态：已审核';
    Lab_State.Font.Color:=clRed;
    ActRefreshExecute(NIl);
  End;
End;

procedure TFmStockOut.ActRevertExecute(Sender: TObject);
begin
  if FEditMode>0 then Exit;
  if cdsStockOut.IsEmpty then Exit;
  if Application.MessageBox('确实要还原当前已审核过的数据吗？','提示',4+32)<>6 then
    Exit;
  if not SvrStockOut.AppServer.BillRevert(iClientID, 'StockOut', cdsStockOutbillNo.Value) then begin
      Messagebox(Handle,Pchar('还原数据不成功！'),nil,16)
  end else Begin
    cdsStockOut.Refresh;
    ActAudit.Enabled:=True and CanAudit;
    ActRevert.Enabled:=False and CanRevert;
    Lab_State.Caption:='单据状态：未审核';
    Lab_State.Font.Color:=clHotLight;
    ActRefreshExecute(NIL);
  end;
End;

procedure TFmStockOut.ActFieldLayoutExecute(Sender: TObject);
begin
  SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name,
                  [dbgStockOutDtl],'药品出库明细');
end;

procedure TFmStockOut.ActDataExportExecute(Sender: TObject);
begin
	ExportData([CdsStockOut, CdsStockOutDtl],'药品出库单;药品出库明细', '');
end;

procedure TFmStockOut.edDepotButtonClick(Sender: TObject);
var iDepotID: Integer;
    DepotNo,DepotName: string;
begin
  If FEditMode=0 Then Exit;
  iDepotID := CdsStockOutDepotID.Value;
  If SelectDepot(iDepotID,DepotNo,DepotName) Then Begin
    CdsStockOutDepotID.Value := iDepotID;
    CdsStockOutDepotNo.Value := DepotNo;
    CdsStockOutDepotName.Value := DepotName;
  End;
end;

procedure TFmStockOut.edEmpIDButtonClick(Sender: TObject);
Var sEmpNo,sEmpName:String;
begin
  If FEditMode=0 Then Exit;
  sEmpNo := CdsStockOutEmpNo.Value;
  If SelectEmp(sEmpNo,sEmpName) Then begin
    CdsStockOutEmpNo.Value := sEmpNo;
    CdsStockOutName.Value := sEmpName;
  End;
end;

procedure TFmStockOut.RzDBButtonEdit1ButtonClick(Sender: TObject);
Var sEmpNo,sEmpName:String;
begin
  If FEditMode=0 Then Exit;
  sEmpNo := CdsStockOutShipper.Value;
  If SelectEmp(sEmpNo,sEmpName) Then begin
    CdsStockOutShipper.Value := sEmpNo;
    CdsStockOutShipName.Value := sEmpName;
  End;
end;

procedure TFmStockOut.edDepartButtonClick(Sender: TObject);
Var sCustNo,sCustName:String;
begin
  If FEditMode=0 Then Exit;
  sCustNo := CdsStockOutCustNO.Value;
  If SelectCust(sCustNo,sCustName) Then Begin
    CdsStockOutCustNO.Value := sCustNo;
    CdsStockOutCustName.Value := sCustName;
  End;
end;

function TFmStockOut.DoSome(cType: PChar; Values: Variant): Variant;
const
  cTypes = 'viewbill'#13'query';
  //       查看某单     查询
var sTypes, sBillList: TStrings;
    b1: Boolean;
    i: integer;
    str, str2: String;
begin
  sBillList := TStringList.Create;
  sTypes := TStringList.Create;
  sTypes.Text := cTypes;
  i := sTypes.IndexOf(cType);
  case i of
    0: begin//ViewBill
      b1 := VarIsArray(Values);
      if b1 then begin
        str := Values[0];
        str2:= Values[1];
      end else begin
        str := Values;
        str2:= '';
      end;
      sBillList.Text := Str;
      if not b1 then begin
        if sBillNoList.IndexOf(sBillList[0])<0 then
          sBillNoList.AddStrings(sBillList);
      end else
        sBillNoList.Text := str2;
      self.BringToFront;
      SetCurrBillNo(sBillList[0]);
    end;
  end;
end;

procedure TFmStockOut.ActInsertExecute(Sender: TObject);
begin
  inherited;
  BeforeDepotNo :='';
  BeforeCustNo  :='';
  BeforeEmpNo   :='';
  BeforeShipper :='';     
end;

procedure TFmStockOut.ActQueryExecute(Sender: TObject);
begin
  IFmMain.OnAction(Sender);
end;

procedure TFmStockOut.ParseGoodsInfo;
var
  B1:boolean;
begin
  if FEditMode=0 then Exit;
  if bBrowGoods then Exit;
  bBrowGoods := true;
  try
    b1:=SelectGoods(CdsStockOutDtl, CdsStockOutDtlGoodsID, CdsStockOutDtlUnit, true, False, False);
    if not b1 then abort;
  finally
    bBrowGoods := false;
  end;
end;

initialization
  RegisterClass(TFmStockOut);

Finalization
  UnRegisterClass(TFmStockOut);
  
end.