overflowfrm.~pas

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

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

procedure TFmOverflow.cdsOverflowAfterScroll(DataSet: TDataSet);
begin
  If cdsOverflowTransfer.Value Then Begin
    ActAudit.Enabled:=False And CanAudit;
    ActRevert.Enabled:=True And CanRevert;
    Lab_State.Caption:='单据状态：已审核';
    Lab_State.Font.Color:=clRed;
  End Else Begin
    ActAudit.Enabled:=True And CanAudit;
    ActRevert.Enabled:=False And CanRevert;
    Lab_State.Caption:='单据状态：未审核';
    Lab_State.Font.Color:=clHotLight;
  End;
end;

procedure TFmOverflow.cdsOverflowDtlBeforeInsert(DataSet: TDataSet);
begin
  iLastItemNO := GetFieldMaxInt(CdsOverflowDtl, 'ItemNo')+1;
end;

procedure TFmOverflow.cdsOverflowDtlNewRecord(DataSet: TDataSet);
begin
  inherited;
  BeforeGoodsID:='';
  CdsOverflowDtlItemNo.Value:=iLastItemNO;
  CdsOverflowDtlBillNo.Value:=CdsOverflowBillNo.Value;
  CdsOverflowDtlValidDate.Value:=IncMonth(Date,12);
end;

procedure TFmOverflow.cdsOverflowReconcileError(
  DataSet: TCustomClientDataSet; E: EReconcileError;
  UpdateKind: TUpdateKind; var Action: TReconcileAction);
begin
  MessageBox(Handle,Pchar(E.Message),'',16);
  Action:=raAbort;
end;

procedure TFmOverflow.cdsOverflowNewRecord(DataSet: TDataSet);
var sBillNo : string;
begin
  cdsOverflowFDate.Value := Date;
  sBillNo := BuildBillNo('Overflow');
  CdsOverflowBillNo.Value :=sBillNo;
  cdsOverflowCreater.Value := LogonInfo^.UserID;
  cdsOverflowGrup.Value := LogonInfo^.UserGrupID;
end;

procedure TFmOverflow.dbgOverflowDtlEditButtonClick(Sender: TObject);
Var
  sField,sBerthNo,sProvNo:String;
  dPrice:Double;
  iDepotID : Integer;
Begin
  If FEditMode=0 Then Exit;
  sField :='';
  sField := Trim(LowerCase(dbgOverflowDtl.SelectedField.FieldName));
  If sField='goodsid' Then Begin
    ParseGoodsInfo;
  end else if sField='provno' then
  begin
    sProvNo := cdsOverflowDtlProvNo.Value;
    if SelectProv(sProvNo) then
    begin
      cdsOverflowDtl.Edit;
      cdsOverflowDtlProvNo.Value := sProvNo;
    end;
  end 
  else begin
    if sField='price' then
    begin
      dPrice := ViewGoodsPrice(CdsOverflowDtlGoodsID.Value, CdsOverflowDtlUnit.Value);
      If dPrice>=0 then begin
        CdsOverflowDtl.Edit;
        CdsOverflowDtlprice.Value := dPrice;
      end;
    end 
    else Begin
      if sField='berthno' then
      begin
        if RzDBEdit3.Text='' then begin
          MessageBox(Handle,Pchar('请先指定报溢仓库!'),nil,16);
          Exit;
        end;
        iDepotID := CdsOverflowDepotID.Value;
        If SelectBerth(iDepotID,sBerthNo) then
        begin
          cdsOverflowDtl.Edit;
          CdsOverflowDtlBerthNo.Value := sBerthNo;
        end;
      end
      else
      if sField='batchno' then
      begin
        if ViewGoodsBatch(cdsOverflowDepotID.Value, cdsOverflowDtlGoodsID.Value,cdsOverflowDtlUnit.Value, '.') then
        begin
          cdsOverflowDtl.Edit;
          cdsOverflowDtlBatchNo.Value := FmSelectBatchNo.cdsStock.FieldByName('BatchNo').AsString;
        end;
      end;
    End;
  End;
end;

procedure TFmOverflow.edDepotButtonClick(Sender: TObject);
var iDepotID: Integer;
    DepotNo,DepotName: string;
begin
  If FEditMode=0 Then Exit;
  iDepotID := CdsOverflowDepotID.Value;
  If SelectDepot(iDepotID,DepotNo,DepotName) Then Begin
    CdsOverflowDepotID.Value := iDepotID;
    CdsOverflowDepotNo.Value := DepotNo;
    CdsOverflowDepotName.Value := DepotName;
  End;
end;

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

procedure TFmOverflow.cdsOverflowDtlAfterPost(DataSet: TDataSet);
Var
  D,dAmount:Double;
  Abk:TBookMark;
begin
  BeforeGoodsID:='';
  With CdsOverflowDtl Do Begin
    D:=0;
    dAmount:=0;
    Try
      Abk:=GetBookmark;
      DisableControls;
      First;
      while Not Eof Do Begin
        D:=D+cdsOverflowDtlQty.Value;
        dAmount:=dAmount+CdsOverflowDtlAmount.Value;
        Next;
      End;
      cdsOverflowGoodsQty.Value:=D;
      cdsOverflowGoodsSum.Value:=dAmount;
    Finally
      GotoBookmark(Abk);
      FreeBookmark(Abk);
      EnableControls;
    End;
  End;
end;

procedure TFmOverflow.cdsOverflowDtlPriceChange(Sender: TField);
Var dQty,dPrice:Double;
begin
  dQty:=CdsOverflowDtlQty.Value;
  dPrice:=CdsOverflowDtlPrice.Value;
  CdsOverflowDtlAmount.Value:=dQty*dPrice;
end;

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

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

procedure TFmOverflow.cdsOverflowDtlGoodsIDChange(Sender: TField);
{Var
  LogText,Flag,sGoodsID,sSetFields:String;
Begin
  if not (cdsOverflowDtl.State in dsEditModes) then exit;
  IF FlagGoodsID<>'' Then Begin
    FlagGoodsID:='';
    Exit;
  End;
  if bBrowGoods then Exit;
  sGoodsID:=cdsOverflowDtlGoodsID.AsString;
  If sGoodsID='' Then Exit;
  if (BeforeGoodsID=sGoodsID) Then Exit;
  BeforeGoodsID:=sGoodsID;
  sSetFields:= 'Name,Specs,Unit,pdcAddr,maker';
  FlagGoodsID:=GetGoodsInfo(cdsOverflowDtl,'Price',sGoodsID,sSetFields,'','S',1);
  If FlagGoodsID<>'' Then Begin
    Messagebox(Handle,'无效药品编号',nil,16);
    Abort;
  End Else Begin
    If sGoodsID<>FlagGoodsID then
      cdsOverflowDtl.FieldByName('GoodsID').AsString:=FlagGoodsID
    Else
      FlagGoodsID:='';
  End;}
begin
  ParseGoodsInfo;
end;

procedure TFmOverflow.ParseGoodsInfo;
var b1:Boolean;
begin
  if FEditMode=0 then Exit;
  if bBrowGoods then Exit;
  bBrowGoods := true;
  try
    b1:=SelectGoods(CdsOverflowDtl, CdsOverflowDtlGoodsID, CdsOverflowDtlUnit, true, False, False);
    if not b1 then abort;
  finally
    bBrowGoods := false;
  end;
end;

procedure TFmOverflow.ActDataExportExecute(Sender: TObject);
begin
  if not(cdsOverflow.Active and cdsOverflowDtl.Active) then exit;
  if cdsOverflow.IsEmpty then
  begin
    MessageBox(Handle,'没有可导出的数据！','警告',MB_ICONEXCLAMATION);
    exit;
  end;
	ExportData([cdsOverflow,cdsOverflowDtl],'药品报溢;药品报溢明细', '');
end;

procedure TFmOverflow.ActFieldLayoutExecute(Sender: TObject);
begin
  SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name,
                  [dbgOverflowDtl],'药品报溢');
end;

initialization
  RegisterClass(TFmOverflow);

finalization
  UnRegisterClass(TFmOverflow);

end.