selorderfrm.~pas

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

procedure TFmSelOrder.cdsSelOrderCustNoChange(Sender: TField);
Var
  sCustNo,sCustName,LogText:String;
begin
  IF FEditMode=0 Then Exit;
  sCustNo:=cdsSelOrderCustNo.Value;
  If sCustNo='' Then Exit;
  if sCustNo=BeforeCustNo Then Exit;
  BeforeCustNo:=sCustNO;
  sCustName:=VarToStr(SvrCommon.AppServer.GetCustInfo(iClientID,sCustNo,1,'CustName',LogText));
  cdsSelOrderCustName.Value:=sCustName;
  cdsSelOrderLinkman.Clear;
  If LogText<>'' Then Begin
    Messagebox(Handle,Pchar(LogText),nil,16);
    DBEdit3.SetFocus;
    Abort;
  End;
end;

procedure TFmSelOrder.cdsSelOrderDtlGoodsIDChange(Sender: TField);
{Var
  LogText,Flag,sGoodsID,sSetFields,sCustNo:String;
Begin
  if FEditMode=0 then Exit;
  if FlagGoodsID<>'' then begin
    FlagGoodsID:='';
    Exit;
  end;
  If bBrowGoods then Exit;
  sGoodsID:=cdsSelOrderDtlGoodsID.AsString;
  if sGoodsID='' then Exit;
  if (BeforeGoodsID=sGoodsID) then Exit;
  BeforeGoodsID:=sGoodsID;
  sSetFields:= 'Name,Specs,Unit';
  sCustNo := cdsSelOrderCustNo.Value;
  FlagGoodsID:=GetGoodsInfo(cdsSelOrderDtl,'OPrice',sGoodsID,sSetFields,sCustNo,'S',1);
  If FlagGoodsID='' Then Begin
    Messagebox(Handle,'无效药品编号',nil,16);
    Abort;
  end else begin
    If sGoodsID<>FlagGoodsID then
      cdsSelOrderDtl.FieldByName('GoodsID').AsString:=FlagGoodsID
    Else
      FlagGoodsID:='';
  end;}
begin
  ParseGoodsInfo;
end;

procedure TFmSelOrder.dbgSelOrderDtlEditButtonClick(Sender: TObject);
var sField,sGoodsID,sCustNo,sUnit:String;
    dPrice:Double;
begin
  if FEditMode=0 then Exit;
  sField :='';
  sField := Trim(LowerCase(dbgSelOrderDtl.SelectedField.FieldName));
  if sField='goodsid' then
  begin
    ParseGoodsInfo;
  end
  else if sField='oprice' then
  begin
    dPrice := ViewGoodsPrice(cdsSelOrderDtlGoodsID.Value, cdsSelOrderDtlUnit.Value);
    if dPrice>=0 then
    begin
      cdsSelOrderDtl.Edit;
      cdsSelOrderDtloprice.Value := dPrice;
    end;
  end
  else if sField='qty' then
  begin
    if cdsSelOrderDtlUnit.Value<>'' then
    begin
      FmSelectBatchNo.edOutTotal.Value := cdsSelOrderDtlQty.Value;
      if ViewGoodsBatch(-1, cdsSelOrderDtlGoodsID.Value, cdsSelOrderDtlUnit.Value, '') then
        cdsSelOrderDtlQty.Value := FmSelectBatchNo.edOutTotal.Value; 
    end;
  end;
end;

procedure TFmSelOrder.ShowPayModes;
var A:Variant;
    iClientID, I, k:Integer;
begin
  try
    iClientID := IFmMain.IFmMainEx.ClientID;
    A:=SvrSelOrder.AppServer.GetNeedValue(iClientID,3,sPayModes);
    if (not VarIsNull(A)) and (VarIsArray(A)) then
    begin
      slPayModes.Clear;
      cbPayModes.Items.Clear;
      k := VarArrayHighBound(A,2);
      for i:=VarArrayLowBound(A,2) to k do
      begin
        slPayModes.Add(A[0,i]);
        cbPayModes.Items.Add(A[0,i]+':'+A[1,i]+'('+A[2,i]+')');
      end;
    end;
  except
    on E:Exception do
      Messagebox(Handle,Pchar(E.Message),'',16);
  end;
end;

procedure TFmSelOrder.cdsSelOrderAfterScroll(DataSet: TDataSet);
Var sModeNo:String;
    iIndex:Integer;
begin
  sModeNo:=cdsSelOrderPayModeNo.Value;
  iIndex:=slPayModes.IndexOf(sModeNO);
  cbPayModes.ItemIndex:=iIndex;
  If cdsSelOrderTransfer.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 TFmSelOrder.SumCount;
Var
  dOPrice,dQty,dRebate ,dPrice ,dTaxRate ,dUnTaxprice,dAmount : Double;
begin
  dOprice := cdsSelOrderDtlOPrice.AsFloat ;    //单价
  dQty    := CdsSelOrderDtlQty.AsFloat;        //数量
  If CdsSelOrderDtlRebate.IsNull Then
    dRebate := 100
  Else
    dRebate := CdsSelOrderDtlRebate.AsFloat ;    //折扣
  dPrice := dOprice*(dRebate/100);               //实际单价
  cdsSelOrderDtlPrice.Value := dPrice ;          //保存实际单价
  dTaxRate := CdsSelOrderDtlTaxRate.AsFloat ;    //税率
  dUnTaxprice := dPrice/(1+dTaxRate/100);        //未税单价
  CdsSelOrderDtlUnTaxprice.Value := dUnTaxPrice; //保存未税单价
  cdsSelOrderDtlGoodsSum.Value  := dQty*(dUnTaxprice*(dRebate/100));    //货款;
  dAmount:=dQty*dUnTaxPrice;                   //合计
  cdsSelOrderDtlAmount.Value := dAmount;       //保存
  cdsSelOrderDtlTaxSum.AsFloat:=dAmount-dQty*(dUnTaxPrice*(dRebate/100)); //税款
end;

procedure TFmSelOrder.cdsSelOrderDtlQtyChange(Sender: TField);
begin
  SumCount;
end;

procedure TFmSelOrder.ActAuditExecute(Sender: TObject);
Var
  sUserID,Str:String;
  sSysInfo : Variant;
begin
  Try
    If cdsSelOrder.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 cdsSelOrderFDate.Value<VarToDateTime(sSysInfo) Then Begin
        Messagebox(Handle,Pchar('单据日期不对，系统已对该月做过月结...'),nil,16);
        Exit;
      End;
    End Else Begin
      Messagebox(Handle,Pchar('请先设置开帐日期...'),nil,16);
      Exit;
    End;
    cdsSelOrder.Edit;
    cdsSelOrderTransfer.Value:=True;
    sUserID := LogonInfo^.UserID;
    cdsSelOrderAudit.Value := sUserID;
    try
      cdsSelOrder.Post;
    Except
      cdsSelOrder.Cancel;
      Raise;
    end;
    If cdsSelOrder.ApplyUpdates(0)>0 Then
      Messagebox(Handle,Pchar('复核数据不成功！'),nil,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),nil,16);
  End;
End;

procedure TFmSelOrder.ActRevertExecute(Sender: TObject);
Var BillNo: String;
begin
  Try
    If cdsSelOrder.IsEmpty Then Exit;
    If FEditMode>0 then Exit;
    Inherited;
    If Application.MessageBox('确实要还原当前已审核过的数据吗？','提示',4+32)<>6 Then Exit;
    BillNo  := CdsSelOrderBillNo.Value;
    If Not(SvrSelOrder.AppServer.BillRevert(iClientID,'SelOrder',BillNo,'')) Then
      Messagebox(Handle,Pchar('还原数据不成功！'),nil,16)
    Else Begin
      ActAudit.Enabled:=True and CanAudit;
      ActRevert.Enabled:=False and CanAudit;
      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 TFmSelOrder.ActFieldLayoutExecute(Sender: TObject);
begin
  SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name,
                  [dbgSelOrderDtl],'销售合同明细');
end;

procedure TFmSelOrder.ActDataExportExecute(Sender: TObject);
begin
	ExportData([cdsSelOrder, cdsSelOrderDtl],'销售合同;销售合同明细', '');
end;

procedure TFmSelOrder.edProvNameButtonClick(Sender: TObject);
Var
  sCustNo,sCustName,sEmpNo,sPayModeNo : String;
begin
  If FEditMode=0 Then Exit;
  sCustNo := cdsSelOrderCustNo.Value;
  If SelectCust(sCustNo,sCustName,sEmpNo,sPayModeNo) Then
  Begin
    cdsSelOrderCustNo.Value := sCustNo;
    cdsSelOrderCustName.Value := sCustName;
    cdsSelOrderEmpNo.Value := sEmpNo;
    cbPayModes.ItemIndex := slPayModes.IndexOf(sPayModeNo);
  End;
End;

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

function TFmSelOrder.DoSome(cType: PChar; Values: Variant): Variant;
const
  cTypes = 'viewbill'#13'query';
  //       查看某单     查询
var sTypes: TStrings;
    i: 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 TFmSelOrder.ActBillTurnExecute(Sender: TObject);
var sBillNo, sToBillNo, str,MatchBillNo: String;
begin
  if FEditMode>0 then Exit;
  If Not(cdsSelOrderTransfer.Value) Then Begin
    Messagebox(handle,Pchar('当前单据尚没[审核],不能进行转单操作!'),'警告',64);
    Exit;
  End;
  sBillNo := cdsSelOrderBillNo.AsString;
  if sBillNo='' then Exit;
  if Application.MessageBox('确定要将此合同转出到销售开单吗？', '消息', MB_YESNO+MB_ICONQUESTION)=IDNO then
    Exit;
  sToBillNo := BuildBillNo('SelExport');
  If SvrSelOrder.AppServer.BillTurn(iClientID, 'SelOrder', 'SelExport', 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 TFmSelOrder.RzDBButtonEdit2ButtonClick(Sender: TObject);
Var
  sCustNo,sLinkMan : String;
begin
  If FEditMode=0 Then Exit;
  If DBEdit3.Text='' Then Begin
    MessageBox(Handle,Pchar('请先指定客户单位!'),nil,16);
    Exit;
  End;
  sCustNo := CdsSelOrderCustNo.Value;
  If SelectCustLinkMan(sCustNo,sLinkMan) Then
    CdsSelOrderLinkMan.Value := sLinkMan ;
end;

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

procedure TFmSelOrder.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(cdsSelOrderDtl, cdsSelOrderDtlGoodsID, cdsSelOrderDtlUnit, true, False, False);
    if not b1 then abort;
    sGoodsID := cdsSelOrderDtlGoodsID.Value;
    sCustNo := cdsSelOrderCustNo.Value;
    sUnit := cdsSelOrderDtlUnit.Value;
    if (sGoodsID<>'') and (sUnit<>'') then
    begin
      dPrice := SvrCommon.AppServer.GetGoodsPrice(IClientID,'S',sCustNo,sGoodsID,sUnit);
      if dPrice<>0 Then
        cdsSelOrderDtlOPrice.Value := dPrice;
    end;
  finally
    bBrowGoods := false;
  end;
end;

initialization
  RegisterClass(TFmSelOrder);

finalization
  UnRegisterClass(TFmSelOrder);

end.