selretdemandfrm.pas

医药连锁经营管理系统源码

  if (BeforeGoodsID=sGoodsID) Then Exit;
  BeforeGoodsID:=sGoodsID;
  sSetFields:= 'Name,Specs,Unit';
  FlagGoodsID:=GetGoodsInfo(CdsSelRetDemandDtl,'OPrice',sGoodsID,sSetFields,'','P',1);
  If FlagGoodsID='' Then Begin
    Messagebox(Handle,'无效药品编号',nil,16);
    Abort;
  End Else Begin
    if sGoodsID<>FlagGoodsID then
      CdsSelRetDemandDtl.FieldByName('GoodsID').AsString:=FlagGoodsID
    Else
      FlagGoodsID:='';
  End;
End;

procedure TFmSelRetDemand.dbgSelRetDemandDtlEditButtonClick(Sender: TObject);
Var sGoodsID, sField: String;
  dPrice : Double;
begin
  if FEditMode=0 then Exit;
  sField := '';
  sField := LowerCase(dbgSelRetDemandDtl.SelectedField.FieldName);
  if sField ='goodsid' then
    ParseGoodsInfo
  Else If sField='oprice' Then
  Begin
    dPrice := ViewGoodsPrice(CdsSelRetDemandDtlGoodsID.Value, CdsSelRetDemandDtlUnit.Value);
    If dPrice>=0 Then
    Begin
      CdsSelRetDemandDtl.Edit;
      CdsSelRetDemandDtlOprice.Value := dPrice;
    End;
  End;
end;

procedure TFmSelRetDemand.ActUpdateExecute(Sender: TObject);
begin
  If CdsSelRetDemandTransfer.Value  Then Begin
    Messagebox(Handle,Pchar('当前的销售退回申请单已审核，不能进行修改操作!'),nil,16);
    Exit;
  End;
  inherited;
  BeforeEmpNo :='';
  BeforeCustNo:='';
end;

procedure TFmSelRetDemand.CdsSelRetDemandAfterScroll(DataSet: TDataSet);
begin
  If CdsSelRetDemandTransfer.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 TFmSelRetDemand.ActAuditExecute(Sender: TObject);
Var
  sUserID,Str,BillNo,sToBillNo,MatchBillNo:String;
  sSysInfo : Variant;
begin
  Try
    If CdsSelRetDemand.IsEmpty Then Exit;
    If FEditMode>0 then Exit;
    If CdsSelRetDemandAbated.Value Then
    Begin
      Messagebox(Handle,PChar('当前单据已被废除，不能进行审核!'),'',16);
      Exit;
    End;
    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 CdsSelRetDemandFDate.Value<VarToDateTime(sSysInfo) Then Begin
        Messagebox(Handle,Pchar('该月已结算，不能操作已月结的单据！'),nil,16);
        Exit;
      End;
    End Else Begin
      Messagebox(Handle,Pchar('请先设置开帐日期...'),nil,16);
      Exit;
    End;
    BillNo := CdsSelRetDemandBillNo.Value;
    If BillNo='' Then Exit;
    sToBillNo := BuildBillNo('SelRetCheckIn');
    If SvrSelRetDemand.AppServer.BillTurn(iClientID, 'SelRetDemand', 'SelRetCheckIn', BillNo, sToBillNo,MatchBillNo) then begin
      ActAudit.Enabled:=False and CanAudit;
      ActRevert.Enabled:=True and CanRevert;
      Lab_State.Caption:='单据状态：已审核';
      Lab_State.Font.Color:=clRed;
      ActRefresh.Execute;
      str := BillNo+'号销退申请单已成功转出到['+MatchBillNo+']号销退登记单，要查看该单据吗？';
      if Application.MessageBox(PChar(str), '消息', MB_YESNO+MB_ICONINFORMATION)=IDYES then
        IFmMain.DoSome('SalesBase.bpl;TFmSelRetCheckIn', 'ViewBill', MatchBillNo);
    end Else
      Messagebox(Handle,Pchar('审核数据不成功！'),nil,16);
  Except
    On E:Exception Do
      Messagebox(Handle,Pchar(E.Message),nil,16);
  End;
End;

procedure TFmSelRetDemand.ActRevertExecute(Sender: TObject);
begin
  Try
    If CdsSelRetDemand.IsEmpty Then Exit;
    If FEditMode>0 then Exit;
    If CdsSelRetDemandAbated.Value Then
    Begin
      Messagebox(Handle,PChar('当前单据已被废除，不能进行审核!'),'',16);
      Exit;
    End;
    If Application.MessageBox('确实要还原当前已审核过的数据吗？','提示',4+32)<>6 Then Exit;
    CdsSelRetDemand.Edit;
    CdsSelRetDemandTransfer.Value:=False;
    CdsSelRetDemandAudit.Value := '';
    try
      CdsSelRetDemand.Post;
    Except
      CdsSelRetDemand.Cancel;
      Raise;
    end;
    If CdsSelRetDemand.ApplyUpdates(0)>0 Then
      Messagebox(Handle,Pchar('还原数据不成功！'),nil,16)
    Else Begin
      CdsSelRetDemand.RefreshRecord;
      ActAudit.Enabled:=True and CanAudit;
      ActRevert.Enabled:=False and CanRevert;
      Lab_State.Caption:='单据状态：未审核';
      Lab_State.Font.Color:=clHotLight;
      ActRefreshExecute(NIL);
    End;
  Except
    On E:Exception Do
      Messagebox(Handle,Pchar(E.Message),nil,16);
  End;
End;

procedure TFmSelRetDemand.ActFieldLayoutExecute(Sender: TObject);
begin
  SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name,
                  [dbgSelRetDemandDtl],'销售退回申请明细');
end;

procedure TFmSelRetDemand.ActDataExportExecute(Sender: TObject);
begin
	ExportData([CdsSelRetDemand, CdsSelRetDemandDtl],'销售退回申请;销售退回申请明细', '');
end;

function TFmSelRetDemand.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 TFmSelRetDemand.RzDBButtonEdit2ButtonClick(Sender: TObject);
Var
  sCustNo,sLinkMan : String;
begin
  If FEditMode=0 Then Exit;
  If RzDBEdit1.Text='' Then Begin
    MessageBox(Handle,Pchar('请先指定供应厂商!'),nil,16);
    Exit;
  End;
  sCustNo := CdsSelRetDemandCustNo.Value;
  If SelectCustLinkMan(sCustNo,sLinkMan) Then
    CdsSelRetDemandLinkMan.Value := sLinkMan ;
end;

procedure TFmSelRetDemand.ActBillTurnExecute(Sender: TObject);
var sBillNo, sToBillNo, str,MatchBillNo: String;
begin
  if FEditMode>0 then Exit;
  if Application.MessageBox('确定要将当前的销售退回申请单作废吗？', '消息', MB_YESNO+MB_ICONQUESTION)=IDNO then
    Exit;
  CdsSelRetDemand.Edit;
  CdsSelRetDemandAbated.Value := True;
    try
      CdsSelRetDemand.Post;
    Except
      CdsSelRetDemand.Cancel;
      Raise;
    end;
  If CdsSelRetDemand.ApplyUpdates(0)>0 Then
  Begin
    Messagebox(Handle,Pchar('将单据作废提交失败！'),'',16);
    Exit;
  End;
  ActRefresh.Execute;
end;

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

procedure TFmSelRetDemand.CdsSelRetDemandCustNoChange(Sender: TField);
Var
  sCustNo,sCustName,LogText:String;
begin
  IF FEditMode=0 Then Exit;
  sCustNo:=CdsSelRetDemandCustNo.Value;
  If sCustNo='' Then Exit;
  if sCustNo=BeforeCustNo Then Exit;
  BeforeCustNo:=sCustNO;
  sCustName:=VarToStr(SvrCommon.AppServer.GetCustInfo(iClientID,sCustNo,1,'CustName',LogText));
  CdsSelRetDemandCustName.Value:=sCustName;
  cdsSelRetDemandLinkman.Clear;
  If LogText<>'' Then Begin
    Messagebox(Handle,Pchar(LogText),nil,16);
    RzDBEdit1.SetFocus;
    Abort;
  End;
end;


procedure TFmSelRetDemand.ParseGoodsInfo;
var sUnit,sCustNo,sField,sGoodsID:string;
    dPrice : Double;
    b1: Boolean;
begin
  if FEditMode=0 then Exit;
  if bBrowGoods then Exit;
  bBrowGoods := true;
  try
    b1:=SelectGoods(CdsSelRetDemandDtl, CdsSelRetDemandDtlGoodsID, CdsSelRetDemandDtlUnit, true, False, False);
    if not b1 then abort;
    sGoodsID := CdsSelRetDemandDtlGoodsID.Value;
    sCustNo := CdsSelRetDemandCustNo.Value;
    sUnit := CdsSelRetDemandDtlUnit.Value;
    If (sGoodsID<>'') And (sUnit<>'') Then
    Begin
      dPrice := SvrCommon.AppServer.GetGoodsPrice(IClientID,'S',sCustNo,sGoodsID,sUnit);
      if dPrice<>0 Then
        CdsSelRetDemandDtlOprice.Value := dPrice;
    End;
  finally
    bBrowGoods := false;
  end;
end;

procedure TFmSelRetDemand.CdsSelRetDemandDtlQtyChange(Sender: TField);
var dRebate: Double;
    str: String;
begin
  //实际单价 = 单价 * 折扣
  str := LowerCase(dbgSelRetDemandDtl.SelectedField.FieldName);
  if (str='goodsid')or(str='oprice')or(str='rebate') then
  begin
    dRebate := CdsSelRetDemandDtlRebate.AsFloat;
    if dRebate=0 then dRebate:=100;
    CdsSelRetDemandDtlPrice.AsFloat := CdsSelRetDemandDtlOPrice.AsFloat * (dRebate/100);
    CdsSelRetDemandDtlUnTaxPrice.AsFloat := CdsSelRetDemandDtlPrice.AsFloat / (1 +  self.CdsSelRetDemandDtlTaxRate.AsFloat/ 100);
  end;
  //货款 = 数量 * 未税单价    合计 = 数量 * 单价    税款 = 合计 - 货款
  CdsSelRetDemandDtlGoodsSum.AsFloat := CdsSelRetDemandDtlQty.AsFloat * CdsSelRetDemandDtlUnTaxPrice.AsFloat;
  CdsSelRetDemandDtlAmount.AsFloat := CdsSelRetDemandDtlQty.AsFloat * CdsSelRetDemandDtlPrice.AsFloat;
  CdsSelRetDemandDtlTaxSum.AsFloat := CdsSelRetDemandDtlAmount.AsFloat - CdsSelRetDemandDtlGoodsSum.AsFloat;
  //SumCount;
end;


procedure TFmSelRetDemand.CdsSelRetDemandDtlPriceChange(Sender: TField);
var dRebate: Double;
begin
  if dbgSelRetDemandDtl.SelectedField.FieldName = Sender.FieldName then
  begin
    dRebate := CdsSelRetDemandDtlRebate.AsFloat;
    if dRebate=0 then dRebate:=100;
    CdsSelRetDemandDtlOPrice.AsFloat := CdsSelRetDemandDtlPrice.AsFloat / (dRebate/100);
    CdsSelRetDemandDtlUnTaxPrice.AsFloat := CdsSelRetDemandDtlPrice.AsFloat / ( 1 + CdsSelRetDemandDtlTaxRate.AsFloat / 100 );
    CdsSelRetDemandDtlGoodsSum.AsFloat := CdsSelRetDemandDtlQty.AsFloat*CdsSelRetDemandDtlUnTaxPrice.AsFloat;
    CdsSelRetDemandDtlAmount.AsFloat := CdsSelRetDemandDtlQty.AsFloat*CdsSelRetDemandDtlPrice.AsFloat;
    CdsSelRetDemandDtlTaxSum.AsFloat := CdsSelRetDemandDtlAmount.AsFloat-CdsSelRetDemandDtlGoodsSum.AsFloat;
  end;
end;

procedure TFmSelRetDemand.CdsSelRetDemandDtlTaxRateChange(Sender: TField);
Begin
  if dbgSelRetDemandDtl.SelectedField.FieldName = Sender.FieldName then
  begin
    CdsSelRetDemandDtlUnTaxPrice.AsFloat := CdsSelRetDemandDtlPrice.AsFloat / ( 1 + CdsSelRetDemandDtlTaxRate.AsFloat / 100 );
    CdsSelRetDemandDtlGoodsSum.AsFloat := CdsSelRetDemandDtlQty.AsFloat*CdsSelRetDemandDtlUnTaxPrice.AsFloat;
    CdsSelRetDemandDtlTaxSum.AsFloat := CdsSelRetDemandDtlAmount.AsFloat-CdsSelRetDemandDtlGoodsSum.AsFloat;
  end;
End;

procedure TFmSelRetDemand.CdsSelRetDemandDtlUnTaxPriceChange(
  Sender: TField);
var dRebate: Double;
begin
  if dbgSelRetDemandDtl.SelectedField.FieldName = Sender.FieldName then
  begin
    dRebate := CdsSelRetDemandDtlRebate.AsFloat;
    if dRebate=0 then dRebate:=100;
    CdsSelRetDemandDtlPrice.AsFloat   := Sender.AsFloat * ( 1 + CdsSelRetDemandDtlTaxRate.AsFloat / 100 );
    CdsSelRetDemandDtlOprice.AsFloat  := CdsSelRetDemandDtlPrice.AsFloat / (dRebate/100);
    CdsSelRetDemandDtlGoodsSum.AsFloat:= CdsSelRetDemandDtlQty.AsFloat * CdsSelRetDemandDtlUnTaxPrice.AsFloat;
    CdsSelRetDemandDtlAmount.AsFloat := CdsSelRetDemandDtlQty.AsFloat*CdsSelRetDemandDtlPrice.AsFloat;
    CdsSelRetDemandDtlTaxSum.AsFloat  := CdsSelRetDemandDtlAmount.AsFloat - CdsSelRetDemandDtlGoodsSum.AsFloat;
  end;
end;

Initialization
  RegisterClass(TFmSelRetDemand);
Finalization
  UnRegisterClass(TFmSelRetDemand);
end.