selretcheckinfrm.~pas

群星医药系统源码

    try
      First;
      while not Eof do
      begin
        dGoodsQty := dGoodsQty+FieldByname('Qty').AsFloat;
        dGoodsSum := dGoodsSum+FieldByName('GoodsSum').AsFloat;
        dTaxSum   := dTaxSum + FieldByname('TaxSum').AsFloat;
        dAmount   := dAmount + FieldByName('Amount').AsFloat;
        Next;
      end;
      CdsSelRetCheckInGoodsQty.Value := dGoodsQty;
      CdsSelRetCheckInGoodsSum.Value := dGoodsSum;
      CdsSelRetCheckInTaxSum.Value   := dTaxSum;
      CdsSelRetCheckInAmount.Value   := dAmount;
    finally
      GotoBookmark(Mark1);
      FreeBookmark(Mark1);
      EnableControls;
    end;
  end;
end;

procedure TFmSelRetCheckIn.RzDBButtonEdit4ButtonClick(Sender: TObject);
Var sEmpNo,sEmpName:String;
begin
  If FEditMode=0 Then Exit;
  sEmpNo := CdsSelRetCheckInEmpNO.Value;
  If SelectEmp(sEmpNo,sEmpName) Then begin
    CdsSelRetCheckInEmpNO.Value := sEmpNo;
    CdsSelRetCheckInName.Value := sEmpName;
  End;
end;

procedure TFmSelRetCheckIn.CdsSelRetCheckInReconcileError(
  DataSet: TCustomClientDataSet; E: EReconcileError;
  UpdateKind: TUpdateKind; var Action: TReconcileAction);
begin
  Action:=RaAbort;
end;

procedure TFmSelRetCheckIn.edCustNameButtonClick(Sender: TObject);
Var sCustNo,sCustName,sEmpNo,sPayModeNo:String;
begin
  If FEditMode=0 Then Exit;
  sCustNo := CdsSelRetCheckInCustNo.Value;
  If SelectCust(sCustNo,sCustName,sEmpNo,sPayModeNo) Then Begin
    CdsSelRetCheckInCustNO.Value := sCustNo;
    CdsSelRetCheckInCustName.Value := sCustName;
    CdsSelRetCheckInEmpNO.Value := sEmpNo;
  End;
End;

procedure TFmSelRetCheckIn.CdsSelRetCheckInNewRecord(DataSet: TDataSet);
begin
  edCustName.Button.Click;
  cdsSelRetCheckInBillNo.Value := BuildBillNo('SelRetCheckIn');
  CdsSelRetCheckInCreater.Value := LogonInfo^.UserID;
  CdsSelRetCheckInGrup.Value := LogonInfo^.UserGrupID;
  CdsSelRetCheckInFDate.Value := date;
  CdsSelRetCheckInGoodsQty.Value := 0;
  CdsSelRetCheckInGoodsSum.Value := 0;
  CdsSelRetCheckInTaxSum.Value := 0;
  CdsSelRetCheckInAmount.Value := 0;
end;

procedure TFmSelRetCheckIn.ActRefershExecute(Sender: TObject);
begin
  inherited;
  CdsSelRetCheckIn.MergeChangeLog;
//  CdsSelRetCheckIn.Active := False;
//  CdsSelRetCheckIn.Active := True;
end;

procedure TFmSelRetCheckIn.CdsSelRetCheckInDtlQtyChange(Sender: TField);
var dRebate: Double;
    str: String;
begin
  if (CdsSelRetCheckInDtlEligibleQty.value<0) or (CdsSelRetCheckInDtlQty.value<0) then
    MessageBox(handle,'数值不能小于0!','提示',MB_ICONWARNING+MB_OK);
  if CdsSelRetCheckInDtlEligibleQty.value>CdsSelRetCheckInDtlQty.value then
    MessageBox(handle,'合数品数量大于实际数量！','提示',MB_ICONWARNING+MB_OK);

  //实际单价 = 单价 * 折扣
  str := LowerCase(dbgSelRetCheckInDtl.SelectedField.FieldName);
  if (str='goodsid')or(str='oprice')or(str='rebate') then
  begin
    dRebate := CdsSelRetCheckInDtlRebate.AsFloat;
    if dRebate=0 then dRebate:=100;
    CdsSelRetCheckInDtlPrice.AsFloat := CdsSelRetCheckInDtlOPrice.AsFloat * (dRebate/100);
    CdsSelRetCheckInDtlUnTaxPrice.AsFloat := CdsSelRetCheckInDtlPrice.AsFloat / (1 +  self.cdsSelRetCheckInDtlTaxRate.AsFloat/ 100);
  end;

  //货款 = 数量 * 未税单价    合计 = 数量 * 单价    税款 = 合计 - 货款
  CdsSelRetCheckInDtlGoodsSum.AsFloat := CdsSelRetCheckInDtlQty.AsFloat * CdsSelRetCheckInDtlUnTaxPrice.AsFloat;
  CdsSelRetCheckInDtlAmount.AsFloat := CdsSelRetCheckInDtlQty.AsFloat * CdsSelRetCheckInDtlPrice.AsFloat;
  CdsSelRetCheckInDtlTaxSum.AsFloat := CdsSelRetCheckInDtlAmount.AsFloat - CdsSelRetCheckInDtlGoodsSum.AsFloat;
end;

procedure TFmSelRetCheckIn.CdsSelRetCheckInDtlPriceChange(Sender: TField);
var dRebate: Double;
begin
  if dbgSelRetCheckInDtl.SelectedField.FieldName = Sender.FieldName then
  begin
    dRebate := CdsSelRetCheckInDtlRebate.AsFloat;
    if dRebate=0 then dRebate:=100;
    CdsSelRetCheckInDtlOPrice.AsFloat := CdsSelRetCheckInDtlPrice.AsFloat / (dRebate/100);
    CdsSelRetCheckInDtlUnTaxPrice.AsFloat := CdsSelRetCheckInDtlPrice.AsFloat / ( 1 + CdsSelRetCheckInDtlTaxRate.AsFloat / 100 );
    CdsSelRetCheckInDtlGoodsSum.AsFloat := cdsSelRetCheckInDtlQty.AsFloat*CdsSelRetCheckInDtlUnTaxPrice.AsFloat;
    CdsSelRetCheckInDtlAmount.AsFloat := cdsSelRetCheckInDtlQty.AsFloat*cdsSelRetCheckInDtlPrice.AsFloat;
    CdsSelRetCheckInDtlTaxSum.AsFloat := CdsSelRetCheckInDtlAmount.AsFloat-CdsSelRetCheckInDtlGoodsSum.AsFloat;
  end;
end;

procedure TFmSelRetCheckIn.CdsSelRetCheckInDtlTaxRateChange(Sender: TField);
begin
  if dbgSelRetCheckInDtl.SelectedField.FieldName = Sender.FieldName then
  begin
    CdsSelRetCheckInDtlUnTaxPrice.AsFloat := CdsSelRetCheckInDtlPrice.AsFloat / ( 1 + CdsSelRetCheckInDtlTaxRate.AsFloat / 100 );
    CdsSelRetCheckInDtlGoodsSum.AsFloat := cdsSelRetCheckInDtlQty.AsFloat*CdsSelRetCheckInDtlUnTaxPrice.AsFloat;
    CdsSelRetCheckInDtlTaxSum.AsFloat := CdsSelRetCheckInDtlAmount.AsFloat-CdsSelRetCheckInDtlGoodsSum.AsFloat;
  end;
end;

procedure TFmSelRetCheckIn.CdsSelRetCheckInDtlUnTaxPriceChange(Sender: TField);
var dRebate: Double;
begin
  if dbgSelRetCheckInDtl.SelectedField.FieldName = Sender.FieldName then
  begin
    dRebate := CdsSelRetCheckInDtlRebate.AsFloat;
    if dRebate=0 then dRebate:=100;
    CdsSelRetCheckInDtlPrice.AsFloat   := Sender.AsFloat * ( 1 + CdsSelRetCheckInDtlTaxRate.AsFloat / 100 );
    cdsSelRetCheckInDtlOprice.AsFloat  := CdsSelRetCheckInDtlPrice.AsFloat / (dRebate/100);
    CdsSelRetCheckInDtlGoodsSum.AsFloat:= cdsSelRetCheckInDtlQty.AsFloat * CdsSelRetCheckInDtlUnTaxPrice.AsFloat;
    CdsSelRetCheckInDtlAmount.AsFloat := cdsSelRetCheckInDtlQty.AsFloat*cdsSelRetCheckInDtlPrice.AsFloat;
    CdsSelRetCheckInDtlTaxSum.AsFloat  := CdsSelRetCheckInDtlAmount.AsFloat - CdsSelRetCheckInDtlGoodsSum.AsFloat;
  end;
end;

procedure TFmSelRetCheckIn.CdsSelRetCheckInDtlProdDateChange(Sender: TField);
var sGoodsID: String;
    vDate: Variant;
begin
  if bDateChanging then Exit;
  sGoodsID := cdsSelRetCheckInDtlGoodsID.AsString;
  //这里响应了ProdDate和ValidDate两个字段的OnChange事件，所以要用Sender来代替确切的字段对象
  if (sGoodsID<>'')and not Sender.IsNull then
  begin
    bDateChanging := true;
    try
      if Sender=CdsSelRetCheckInDtlProdDate then
      begin
        vDate := SvrCommon.AppServer.GetUsefulLife(iClientID, sGoodsID, cdsSelRetCheckInDtlProdDate.Value);
        if vDate<>null then
          cdsSelRetCheckInDtlValidDate.AsVariant := vDate;
      end
      else if Sender=cdsSelRetCheckInDtlValidDate then
      begin
        vDate := SvrCommon.AppServer.GetUsefulLife(iClientID, '-'+sGoodsID, cdsSelRetCheckInDtlValidDate.Value);
        if vDate<>null then
         cdsSelRetCheckInDtlProdDate.AsVariant := vDate;
      end;
    finally
      bDateChanging := false;
    end;
  end;
end;

procedure TFmSelRetCheckIn.CdsSelRetCheckInDtlGoodsIDChange(Sender: TField);
Begin
  ParseGoodsInfo;
End;

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

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

procedure TFmSelRetCheckIn.dbgSelRetCheckInDtlEditButtonClick(Sender: TObject);
Var
  sGoodsID,sCustNo,sUnit:String;
  dPrice : Double;
begin
  if FEditMode=0 then Exit;
  if LowerCase(dbgSelRetCheckInDtl.SelectedField.FieldName)='goodsid' then Begin
    ParseGoodsInfo;
  End;
end;

procedure TFmSelRetCheckIn.CdsSelRetCheckInAfterScroll(DataSet: TDataSet);
begin
  If CdsSelRetCheckInTransfer.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 TFmSelRetCheckIn.ActUpdateExecute(Sender: TObject);
Var BillNo,RetStr : String;
begin
  If CdsSelRetCheckInTransfer.Value  Then Begin
    Messagebox(Handle,Pchar('当前单据已[审核]，不能进行修改操作!'),nil,16);
    Exit;
  End;
  BillNo := CdsSelRetCheckInBillNo.Value;
  If Not(SvrSelRetCheckin.AppServer.CanDoAction(iClientID,'GoodsCheckAccept',BillNo,'',RetStr)) Then Begin
    Messagebox(Handle,Pchar(RetStr+'不能进行修改操作...'),nil,16);
    Exit;
  End;
  inherited;
end;

procedure TFmSelRetCheckIn.ActFieldLayoutExecute(Sender: TObject);
begin
  SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name,
                  [dbgSelRetCheckInDtl],'来货登记明细');
end;

procedure TFmSelRetCheckIn.ActDataExportExecute(Sender: TObject);
begin
	ExportData([CdsSelRetCheckIn, CdsSelRetCheckInDtl],'来货登记;来货登记明细', '');
end;

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

procedure TFmSelRetCheckIn.RzDBButtonEdit1ButtonClick(Sender: TObject);
Var
  sCustNo,sLinkMan : String;
begin
  If FEditMode=0 Then Exit;
  If RzDBEdit4.Text='' Then Begin
    MessageBox(Handle,Pchar('请先指定供应厂商!'),nil,16);
    Exit;
  End;
  sCustNo := CdsSelRetCheckInCustNo.Value;
  If SelectCustLinkMan(sCustNo,sLinkMan) Then
    CdsSelRetCheckInLinkMan.Value := sLinkMan ;
end;

procedure TFmSelRetCheckIn.CdsSelRetCheckInDtlAfterOpen(DataSet: TDataSet);
begin
  inherited;
  TNumericField(DataSet.FieldByName('UnTaxPrice')).DisplayFormat :='##.000000';
  TNumericField(DataSet.FieldByName('OPrice')).DisplayFormat :='##.000000';
  TNumericField(DataSet.FieldByName('Price')).DisplayFormat :='##.000000';
end;

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

procedure TFmSelRetCheckIn.ParseGoodsInfo;
var sGoodsID,sCustNo,sUnit:String;
    dPrice : Double;
    b1: Boolean;
begin
  if FEditMode=0 then Exit;
  if bBrowGoods then Exit;
  bBrowGoods := true;
  try
    b1:=SelectGoods(CdsSelRetCheckInDtl, CdsSelRetCheckInDtlGoodsID, CdsSelRetCheckInDtlUnit, true, False, False);
    if not b1 then Abort;
    sGoodsID := CdsSelRetCheckInDtlGoodsID.Value;
    sCustNo := CdsSelRetCheckInCustNo.Value;
    sUnit := CdsSelRetCheckInDtlUnit.Value;
    if (sGoodsID<>'') And (sUnit<>'') Then
    begin
      dPrice := SvrCommon.AppServer.GetGoodsPrice(IClientID,'P',sCustNo,sGoodsID,sUnit);
      if dPrice<>0 Then
        CdsSelRetCheckInDtlOPrice.Value := dPrice;
    end;
    cdsSelRetCheckInDtlProdDateChange(cdsSelRetCheckInDtlProdDate);
  finally
    bBrowGoods := false;
  end;
end;

initialization
  RegisterClass(TFmSelRetCheckIn);

finalization
  UnRegisterClass(TFmSelRetCheckIn);

end.