selspeer.~pas

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

  BeforeEmpNo :='';
  BeforeCustNo:='';
  edProvName.Button.Click;
  CdsSelSpeerBillNo.Value := BuildBillNo('SelSpeer');
  CdsSelSpeerCreater.Value := LogonInfo^.UserID;
  CdsSelSpeerGrup.Value := LogonInfo^.UserGrupID;
  CdsSelSpeerFDate.Value:=Date;
  CdsSelSpeerValidDate.Value:=Date;
end;

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

procedure TFmSelSpeer.CdsSelSpeerCustNoChange(Sender: TField);
Var
  sCustNo,sCustName,LogText:String;
begin
  IF FEditMode=0 Then Exit;
  sCustNo:=CdsSelSpeerCustNo.Value;
  If sCustNo='' Then Exit;
  if sCustNo=BeforeCustNo Then Exit;
  BeforeCustNo:=sCustNO;
  sCustName:=VarToStr(SvrCommon.AppServer.GetCustInfo(iClientID,sCustNo,1,'CustName',LogText));
  CdsSelSpeerCustName.Value:=sCustName;
  cdsSelSpeerLinkMan.Clear;
  If LogText<>'' Then Begin
    Messagebox(Handle,Pchar(LogText),'错误',16);
    Abort;
  End;
end;

procedure TFmSelSpeer.CdsSelSpeerDtlGoodsIDChange(Sender: TField);
Begin
  ParseGoodsInfo;
End;

procedure TFmSelSpeer.dbgSelSpeerDtlEditButtonClick(Sender: TObject);
Var
  sField,sGoodsID,sCustNo,sUnit:String;
  dPrice:Double;
Begin
  If FEditMode=0 Then Exit;
  sField :='';
  sField := Trim(LowerCase(dbgSelSpeerDtl.SelectedField.FieldName));
  if sField='goodsid' then
    ParseGoodsInfo
  else if sField='oprice' then
  begin
    dPrice := ViewGoodsPrice(CdsSelSpeerDtlGoodsID.Value, CdsSelSpeerDtlUnit.Value);
    if dPrice>=0 then
    begin
      CdsSelSpeerDtl.Edit;
      CdsSelSpeerDtlOprice.Value := dPrice;
    end;
  end;
end;

procedure TFmSelSpeer.SumCount;
Var
  dOPrice,dRebate,dTaxRate,dQty,
  dUnTaxPrice,dPrice,dGoodsSum,dAmount:Double;
begin
  //基本的只须标准售价、折扣，税率、数量;
  dQty    := CdsSelSpeerDtlQty.Value;          //数量
  dOprice := CdsSelSpeerDtlOPrice.Value;       //标准单价
  If CdsSelSpeerDtlRebate.IsNull Then
    dRebate := 1
  Else
    dRebate := CdsSelSpeerDtlRebate.Value/100;  //折扣
  dPrice  := dOPrice*dRebate;                   //实际售价=标准售价*折扣
  CdsSelSpeerDtlPrice.Value := dPrice;         //保存实际售价
  
  dTaxRate:= CdsSelSpeerDtlTaxRate.Value;      //税率
  dUnTaxPrice := dPrice/(1+dTaxRate/100);         //未税单价(实际单价/1+(税率)%)
  CdsSelSpeerDtlUnTaxPrice.Value := dUnTaxPrice;  //保存未税单价

  dGoodsSum := dQty*dUnTaxPrice;                  //计算货款=数量*未税单价
  CdsSelSpeerDtlGoodsSum.Value := dGoodsSum;      //保存货款

  dAmount := dQty*dPrice;                         //计算合计=数量*实际单价
  CdsSelSpeerDtlAmount.Value := dAmount;          //保存合计
  CdsSelSpeerDtlTaxSum.Value := dAmount-dGoodsSum;   //税款=合计-货款
End;

procedure TFmSelSpeer.CdsSelSpeerDtlRebateChange(Sender: TField);
begin
  SumCount;
end;

procedure TFmSelSpeer.CdsSelSpeerAfterScroll(DataSet: TDataSet);
Var
  iIndex:Integer;
  sModeNO:String;
begin
  sModeNo:= CdsSelSpeerPayModeNO.Value;
  iIndex := slPayModes.IndexOf(sModeNO);
  cbPayModes.ItemIndex:=iIndex;
  If CdsSelSpeerTransfer.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 TFmSelSpeer.ActAuditExecute(Sender: TObject);
Var
  sUserID,Str:String;
  sSysInfo : Variant;
begin
  Try
    If CdsSelSpeer.IsEmpty Then Exit;
    If FEditMode>0 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 CdsSelSpeerFDate.Value<VarToDateTime(sSysInfo) Then Begin
        Messagebox(Handle,Pchar('单据日期不对，系统已对该月做过月结...'),'错误',16);
        Exit;
      End;
    End Else Begin
      Messagebox(Handle,Pchar('请先设置开帐日期...'),'错误',16);
      Exit;
    End;
    CdsSelSpeer.Edit;
    CdsSelSpeerTransfer.Value:=True;
    sUserID := iFmMain.IFmMainEx.LogonInfo^.UserID;
    CdsSelSpeerAudit.Value := sUserID;
    try
      CdsSelSpeer.Post;
    Except
      CdsSelSpeer.Cancel;
      Raise;
    end;
    If CdsSelSpeer.ApplyUpdates(0)>0 Then
      Messagebox(Handle,Pchar('审核数据不成功！'),'错误',16)
    Else Begin
      ActAudit.Enabled  := False and CanAudit;
      ActRevert.Enabled := True and CanRevert;
      Lab_State.Caption:='单据状态：已审核';
      Lab_State.Font.Color:=clRed;
      ActRefreshExecute(NIl);
    End;
  Except
    On E:Exception Do
      Messagebox(Handle,Pchar(E.Message),'错误',16);
  End;
End;

procedure TFmSelSpeer.ActRevertExecute(Sender: TObject);
begin
  Try
    If CdsSelSpeer.IsEmpty Then Exit;
    If FEditMode>0 then Exit;
    inherited;
    If Application.MessageBox('确实要还原当前已审核过的数据吗？','提示',4+32)<>6 Then Exit;
    CdsSelSpeer.Edit;
    CdsSelSpeerTransfer.Value:=False;
    CdsSelSpeerAudit.Value := '';
    try
      CdsSelSpeer.Post;
    Except
      CdsSelSpeer.Cancel;
      Raise;
    end;
    If CdsSelSpeer.ApplyUpdates(0)>0 Then
      Messagebox(Handle,Pchar('还原数据不成功！'),'错误',16)
    Else Begin
      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),'错误',16);
  End;
End;

procedure TFmSelSpeer.ActFieldLayoutExecute(Sender: TObject);
begin
  SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name,
                  [dbgSelSpeerDtl],'客户询价明细');
end;

procedure TFmSelSpeer.ActDataExportExecute(Sender: TObject);
begin
	ExportData([CdsSelSpeer, CdsSelSpeerDtl],'客户询价;客户询价明细', '');
end;

function TFmSelSpeer.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 TFmSelSpeer.ActBillTurnExecute(Sender: TObject);
var sBillNo, sToBillNo, str,MatchBillNo: String;
begin
  If FEditMode>0 then Exit;
  If Not(CdsSelSpeerTransFer.Value) Then Begin
    Messagebox(Handle,Pchar('当前单据尚没[审核],不能进行转单操作!'),'警告',64);
    Exit;
  End;
  sBillNo := cdsSelSpeerBillNo.AsString;
  if sBillNo='' then Exit;
  if Application.MessageBox('确定要将当前客户询价单转出到销售合同吗？', '消息', MB_YESNO+MB_ICONQUESTION)=IDNO then
    Exit;
  sToBillNo := BuildBillNo('SelOrder');
  If SvrSelSpeer.AppServer.BillTurn(iClientID, 'SelSpeer', 'SelOrder', sBillNo, sToBillNo,MatchBillNo) then begin
    ActRefresh.Execute;
    str := sBillNo+'号询价单已成功转出到['+MatchBillNo+']号销售合同，要查看该单据吗？';
    If Application.MessageBox(PChar(str), '消息', MB_YESNO+MB_ICONINFORMATION)=IDYES then
      IFmMain.DoSome(ActBillTurn.ModuleFile, 'ViewBill', MatchBillNo);
  end;
end;

procedure TFmSelSpeer.edProvNameButtonClick(Sender: TObject);
Var
  sCustNo,sCustName,sEmpNo,sPayModeNo : String;
begin
  If FEditMode=0 Then Exit;
  sCustNo := CdsSelSpeerCustNo.Value;
  If SelectCust(sCustNo,sCustName,sEmpNo,sPayModeNo) Then Begin
    CdsSelSpeerEmpNo.Value := sEmpNo;
    CdsSelSpeerPayModeNo.Value := sPayModeNo;
    cdsSelSpeerCustNo.Text := sCustNo;
    edProvName.text := sCustName;
  End;
End;

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

procedure TFmSelSpeer.RzDBButtonEdit2ButtonClick(Sender: TObject);
Var
  sCustNo,sLinkMan : String;
begin
  If FEditMode=0 Then Exit;
  If RzDBEdit9.Text='' Then Begin
    MessageBox(Handle,Pchar('请先指定客户单位!'),'错误:',16);
    Exit;
  End;
  sCustNo := CdsSelSpeerCustNo.Value;
  If SelectCustLinkMan(sCustNo,sLinkMan) Then
    CdsSelSpeerLinkMan.Value := sLinkMan ;
end;

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

procedure TFmSelSpeer.ParseGoodsInfo;
var sCustNo, sGoodsID, sUnit: String;
    dPrice: Double;
    b1: Boolean;
begin
  if FEditMode=0 then Exit;
  if bBrowGoods then Exit;
  bBrowGoods := true;
  try
    b1:=SelectGoods(CdsSelSpeerDtl, CdsSelSpeerDtlGoodsID, CdsSelSpeerDtlUnit, true, False, False);
    if not b1 then Abort;
    sGoodsID := CdsSelSpeerDtlGoodsID.Value;
    sCustNo := CdsSelSpeerCustNo.Value;
    sUnit := CdsSelSpeerDtlUnit.Value;
    if (sGoodsID<>'') And (sUnit<>'') Then Begin
      dPrice := SvrCommon.AppServer.GetGoodsPrice(IClientID,'S',sCustNo,sGoodsID,sUnit);
      if dPrice<>0 Then
        CdsSelSpeerDtlOprice.Value := dPrice;
    End;
  finally
    bBrowGoods := false;
  end;
end;

initialization
  RegisterClass(TFmSelSpeer);
finalization
  UnRegisterClass(TFmSelSpeer);

end.