stockinfm.~pas

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

    RzDBEdit5.SetFocus;
    Abort;
  End;
end;

procedure TFmStockIn.dbgStockInDtlEditButtonClick(Sender: TObject);
Var
  sField,sBerthNo:String;
  dPrice:Double;
  iDepotID : Integer;
Begin
  If FEditMode=0 Then Exit;
  sField :='';
  sField := Trim(LowerCase(dbgStockInDtl.SelectedField.FieldName));
  If sField='goodsid' Then Begin
    ParseGoodsInfo;
  End Else
  Begin
    If sField='price' Then Begin
      dPrice := ViewGoodsPrice(CdsStockInDtlGoodsID.Value, CdsStockInDtlUnit.Value);
      If dPrice>=0 Then Begin
        CdsStockInDtl.Edit;
        CdsStockInDtlprice.Value := dPrice;
      End;
    End Else
    Begin
      If sField='berthno' Then Begin
        If RzDBEdit3.Text='' Then Begin
          MessageBox(Handle,Pchar('请先指定存货仓库!'),'错误:',16);
          Exit;
        End;
        iDepotID := CdsStockInDepotID.Value;
        If SelectBerth(iDepotID,sBerthNo) Then
        begin
          cdsStockInDtl.Edit;
          cdsStockInDtlBerthNo.Value := sBerthNo;
        end;
      End;
    End;
  End;
End;

procedure TFmStockIn.CdsStockInDtlGoodsIDChange(Sender: TField);
{Var
  LogText,Flag,sGoodsID,sSetFields,sProvNo:String;
Begin
  IF FEditMode=0 Then Exit;
  IF FlagGoodsID<>'' Then Begin
    FlagGoodsID:='';
    Exit;
  End;
  If bBrowGoods then Exit;
  sGoodsID:=CdsStockInDtlGoodsID.AsString;
  If sGoodsID='' Then Exit;
  if (BeforeGoodsID=sGoodsID) Then Exit;
  BeforeGoodsID:=sGoodsID;
  sSetFields:= 'Name,Specs,Unit';
  sProvNo := CdsStockInProvNo.Value;
  FlagGoodsID:=GetGoodsInfo(CdsStockInDtl,'Price',sGoodsID,sSetFields,sProvNo,'P',1);
  If FlagGoodsID='' Then Begin
    Messagebox(Handle,'无效药品编号','错误:',16);
    Abort;
  End Else Begin
    if sGoodsID<>FlagGoodsID then
      CdsStockInDtl.FieldByName('GoodsID').AsString:=FlagGoodsID
    Else
      FlagGoodsID:='';
  End;}
begin
  ParseGoodsInfo;
End;

procedure TFmStockIn.CdsStockInDtlAfterPost(DataSet: TDataSet);
Var
  D,dAmount:Double;
  Abk:TBookMark;
begin
  BeforeGoodsID:='';
  With CdsStockInDtl Do Begin
    D:=0;
    dAmount:=0;
    Try
      Abk:=GetBookmark;
      DisableControls;
      First;
      while Not Eof Do Begin
        D:=D+CdsStockInDtlQty.Value;
        dAmount:=dAmount+CdsStockInDtlAmount.Value;
        Next;
      End;
      CdsStockInGoodsQty.Value:=D;
      CdsStockInGoodsSum.Value:=dAmount;
    Finally
      GotoBookmark(Abk);
      FreeBookmark(Abk);
      EnableControls;
    End;
  End;
End;

procedure TFmStockIn.CdsStockInDtlQtyChange(Sender: TField);
Var dQty,dPrice:Double;
begin
  dQty:=CdsStockInDtlQty.Value;
  dPrice:=CdsStockInDtlPrice.Value;
  CdsStockInDtlAmount.Value:=dQty*dPrice;
end;

procedure TFmStockIn.CdsStockInAfterScroll(DataSet: TDataSet);
Var iIndex:integer;
begin
  iIndex:=CdsStockInInOutKind.Value;
  if iIndex=-1 Then Exit;
  cbInOutKind.ItemIndex:=slInOutKinds.IndexOf(IntToStr(iIndex));
  If CdsStockInTransfer.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 TFmStockIn.CdsStockInDepotNoChange(Sender: TField);
Var
  sDepotNo,LogText:String;
  A:Variant;
begin
  Try
    IF FEditMode=0 Then Exit;
    sDepotNo:=CdsStockInDepotNo.Value;
    If sDepotNo='' Then Exit;
    if sDepotNo=BeforeDepotNo Then Exit;
    BeforeDepotNo:=sDepotNo;
    A := SvrCommon.AppServer.GetDepotInfo(iClientID,sDepotNo,2,'DepotID,DepotName',LogText);
    CdsStockInDepotID.Value  := A[0];
    CdsStockInDepotName.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 TFmStockIn.ActUpdateExecute(Sender: TObject);
begin
  If CdsStockInTransfer.Value  Then Begin
    Messagebox(Handle,Pchar('当前的入库单已审核，不能进行修改操作!'),nil,16);
    Exit;
  End;
  inherited;
  BeforeDepotNo := '';
  BeforeProvNo  := '';
  BeforeEmpNo   := '';
end;

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

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

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

procedure TFmStockIn.ActDataExportExecute(Sender: TObject);
begin
	ExportData([CdsStockIn, CdsStockInDtl],'药品入库单;药品入库明细', '');
end;

procedure TFmStockIn.edDepotButtonClick(Sender: TObject);
var iDepotID: Integer;
    DepotNo,DepotName: string;
begin
  If FEditMode=0 Then Exit;
  iDepotID := CdsStockInDepotID.Value;
  If SelectDepot(iDepotID,DepotNo,DepotName) Then Begin
    CdsStockInDepotID.Value := iDepotID;
    CdsStockInDepotNo.Value := DepotNo;
    CdsStockInDepotName.Value := DepotName;
  End;
end;

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

procedure TFmStockIn.edDepartButtonClick(Sender: TObject);
Var sProvNo,sProvName:String;
begin
  If FEditMode=0 Then Exit;
  sProvNo := CdsStockInProvNo.Value;
  If SelectProv(sProvNo,sProvName) Then Begin
    CdsStockInProvNo.Value := sProvNo;
    CdsStockInProvName.Value := sProvName;
  End;
End;

procedure TFmStockIn.ActInsertExecute(Sender: TObject);
begin
  inherited;
  BeforeDepotNo := '';
  BeforeProvNo  := '';
  BeforeEmpNo   := '';
end;

function TFmStockIn.DoSome(cType: PChar; Values: Variant): Variant;
const
  cTypes = 'viewbill'#13'query';
  //       查看某单     查询
var sTypes, sBillList: TStrings;
    b1: Boolean;
    i, k: 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 TFmStockIn.ActQueryExecute(Sender: TObject);
begin
  IFmMain.OnAction(Sender);
end;

procedure TFmStockIn.ParseGoodsInfo;
var sGoodsID,sProvNo,sUnit:string;
    dPrice:Double;
    b1: Boolean;
begin
  if FEditMode=0 then Exit;
  if bBrowGoods then Exit;
  bBrowGoods := true;
  try
    b1:=SelectGoods(CdsStockInDtl, CdsStockInDtlGoodsID, CdsStockInDtlUnit, true, False, False);
    if not b1 then Abort;
    sGoodsID := CdsStockInDtlGoodsID.Value;
    sProvNo := CdsStockInProvNo.Value;
    sUnit := CdsStockInDtlUnit.Value;
    if (sGoodsID<>'') And (sUnit<>'') Then Begin
      dPrice := SvrCommon.AppServer.GetGoodsPrice(IClientID,'P',sProvNo,sGoodsID,sUnit);
      if dPrice<>0 Then
        CdsStockInDtlprice.Value := dPrice;
    End;
  finally
    bBrowGoods := false;
  end;
end;

initialization
  RegisterClass(TFmStockIn);
finalization
  UnRegisterClass(TFmStockIn);
end.