xssodh.cls

制造业产供销与往来系统源码,包括进销存及全部控件！

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "XsSodh"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Dim m_Kh As Kh
Dim m_CwBz As CwBz
Dim m_Saler As Saler

Dim m_XsSods As XsSods

Dim m_XsSodhDocno As String
Dim m_XsSodhDat As String

Dim m_XsSodh_SalerCode As String
Dim m_XsSodh_SalerNo As Double

Dim m_XsSodh_KhCode As String
Dim m_XsSodh_Khno As Double

Dim m_XsSodh_CwBzCode As String
Dim m_XsSodh_CwBzno As Double

Dim m_XsSodhForm As String

Dim m_XsSodhNo As Double

Dim m_XsSodhId As Integer
Dim m_XsSodhKey As Double

Private Sub Class_Initialize()
   m_XsSodhId = -1
End Sub

Public Property Get Name() As String
   Name = "XsSodh"
End Property

Public Property Get Kh() As Kh
   If m_Kh Is Nothing Then
      Set m_Kh = New Kh
      If m_XsSodh_KhCode <> "" Then
         m_Kh.Requery m_XsSodh_KhCode
      End If
   End If
   Set Kh = m_Kh
End Property

Public Property Get Saler() As Saler
   If m_Saler Is Nothing Then
      Set m_Saler = New Saler
      If m_XsSodh_SalerCode <> "" Then
         m_Saler.Requery m_XsSodh_SalerCode
      End If
   End If
   Set Saler = m_Saler
End Property

Public Property Get CwBz() As CwBz
   If m_CwBz Is Nothing Then
      Set m_CwBz = New CwBz
      If m_XsSodh_CwBzCode <> "" Then
         m_CwBz.Requery m_XsSodh_CwBzCode
      End If
   End If
   Set CwBz = m_CwBz
End Property

Public Property Get XsSods() As XsSods
   If m_XsSods Is Nothing Then
      Set m_XsSods = New XsSods
      If m_XsSodhId = 1 Then
         m_XsSods.Fillbydb Me
      End If
   End If
   Set XsSods = m_XsSods
End Property

Public Property Get XsSodhId() As Integer
   XsSodhId = m_XsSodhId
End Property

Public Property Get XsSodhKey() As Double
   XsSodhKey = m_XsSodhKey
End Property

Public Property Get XsSodhDocno() As String
   XsSodhDocno = m_XsSodhDocno
End Property

Public Property Get XsSodhDat() As String
   XsSodhDat = m_XsSodhDat
End Property

Public Property Get XsSodh_SalerCode() As String
   XsSodh_SalerCode = m_XsSodh_SalerCode
End Property

Public Property Get XsSodh_SalerNo() As Double
   XsSodh_SalerNo = m_XsSodh_SalerNo
End Property

Public Property Get XsSodh_KhCode() As String
   XsSodh_KhCode = m_XsSodh_KhCode
End Property

Public Property Get XsSodh_Khno() As Double
   XsSodh_Khno = m_XsSodh_Khno
End Property

Public Property Get XsSodh_CwBzCode() As String
   XsSodh_CwBzCode = m_XsSodh_CwBzCode
End Property

Public Property Get XsSodh_CwBzno() As Double
   XsSodh_CwBzno = m_XsSodh_CwBzno
End Property

Public Property Get XsSodhForm() As String
   XsSodhForm = m_XsSodhForm
End Property

Public Property Get XsSodhNo() As Double
   XsSodhNo = m_XsSodhNo
End Property

Public Property Let XsSodhId(vXsSodhId As Integer)
   m_XsSodhId = vXsSodhId
End Property

Public Property Let XsSodhKey(vXsSodhKey As Double)
   m_XsSodhKey = vXsSodhKey
End Property

Public Property Let XsSodhDocno(vXsSodhDocno As String)

   If Trim(vXsSodhDocno) = "" Then
      Err.Raise vbObjectError + 1, , "单据编号不能为空！"
      Exit Property
   End If
   
   If m_XsSodhDocno <> vXsSodhDocno Then
      Dim Rs As DbRs
      Set Rs = New DbRs
      Rs.Fillbydb "SELECT * FROM XsSodHREC WHERE XsSodHDOCNO='" & vXsSodhDocno & "'"
      If Not Rs.EOF Then
         Set Rs = Nothing
         Err.Raise vbObjectError + 1, , "单据编号已经存在！"
         Exit Property
      End If
      Set Rs = Nothing
   End If
   
   m_XsSodhDocno = vXsSodhDocno
   
End Property

Public Property Let XsSodhDat(vXsSodhDat As String)

   If Trim(vXsSodhDat) = "" Then
      Err.Raise vbObjectError + 1, , "日期不能为空！"
      Exit Property
   End If
   
   m_XsSodhDat = vXsSodhDat
   
End Property

Public Property Let XsSodh_KhCode(vXsSodh_KhCode As String)

   If Trim(vXsSodh_KhCode) = "" Then
      Err.Raise vbObjectError + 1, , "供应商编码不能为空！"
      Exit Property
   End If
   
   If m_XsSodh_KhCode <> vXsSodh_KhCode Then
      If Kh.Requery(vXsSodh_KhCode) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的供应商编码不存在！"
         Exit Property
      End If
      m_XsSodh_Khno = Kh.KhNo
      m_XsSodh_CwBzCode = Kh.Kh_CwBzCode
      m_XsSodh_CwBzno = Kh.Kh_CwBzno
   End If
   
   m_XsSodh_KhCode = vXsSodh_KhCode
   
End Property

Public Property Let XsSodh_SalerCode(vXsSodh_SalerCode As String)

   If Trim(vXsSodh_SalerCode) = "" Then
      m_XsSodh_SalerCode = ""
      m_XsSodh_SalerNo = 0
      Exit Property
   End If
   
   If m_XsSodh_SalerCode <> vXsSodh_SalerCode Then
      If Saler.Requery(vXsSodh_SalerCode) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的业务员不存在！"
         Exit Property
      End If
      m_XsSodh_SalerNo = Saler.SalerNo
   End If
   
   m_XsSodh_SalerCode = vXsSodh_SalerCode
   
End Property

Public Property Let XsSodh_CwBzCode(vXsSodh_CwBzCode As String)

   If Trim(vXsSodh_CwBzCode) = "" Then
      Err.Raise vbObjectError + 1, , "录入的币种不能为空！"
      Exit Property
   End If
   
   If m_XsSodh_CwBzCode <> vXsSodh_CwBzCode Then
      If CwBz.Requery(vXsSodh_CwBzCode) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的币种编码不存在！"
         Exit Property
      End If
      m_XsSodh_CwBzno = CwBz.CwbzNo
   End If
   
   m_XsSodh_CwBzCode = vXsSodh_CwBzCode
   
End Property

Public Property Let XsSodhForm(vXsSodhForm As String)
   m_XsSodhForm = vXsSodhForm
End Property

Public Sub Save()
   Dim Cmd As ADODB.Command
On Error GoTo Errorhandle
      
   If XsSods.Count = 0 Then
      On Error GoTo 0
      Err.Raise vbObjectError + 1, , "单据无明细行，不能存盘！"
      Exit Sub
   End If
      
   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
   
   If m_XsSodhId = -1 Then
      Cmd.CommandText = gPublicFunction.GetCallSPString("XsSodHREC_INSERT", 7)
      Cmd(0) = m_XsSodhDocno
      Cmd(1) = m_XsSodhDat
      Cmd(2) = m_XsSodh_Khno
      Cmd(3) = m_XsSodh_CwBzno
      Cmd(4) = m_XsSodh_SalerNo
      Cmd(5) = m_XsSodhForm
      Cmd(6).Direction = adParamOutput   'XsSodhNo
   Else
      Cmd.CommandText = gPublicFunction.GetCallSPString("XsSodhREC_UPDATE", 6)
      Cmd(0) = m_XsSodhNo
      Cmd(1) = m_XsSodhDocno
      Cmd(2) = m_XsSodhDat
      Cmd(3) = m_XsSodh_Khno
      Cmd(4) = m_XsSodh_CwBzno
      Cmd(5) = m_XsSodh_SalerNo
   End If
   
   gDbCommon.Conn.BeginTrans
   Cmd.Execute
   If m_XsSodhId = -1 Then
      m_XsSodhNo = Cmd(6)
   End If
   XsSods.Save Me
   gDbCommon.Conn.CommitTrans
   
   If m_XsSodhId = -1 Then
      m_XsSodhId = 1
   End If
   
   Set Cmd = Nothing
   
Exit Sub
Errorhandle:
   Set Cmd = Nothing
   gDbCommon.Conn.RollbackTrans
   Err.Raise vbObjectError + 1, , gDbCommon.Conn.Errors(0)
End Sub

Public Sub Del(Optional mMxDel As Integer = 0)
   Dim Cmd As ADODB.Command
On Error GoTo Errorhandle
      
   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
   
   Cmd.CommandText = "{CALL XsSodHREC_DELETE(?)}"
   Cmd(0) = m_XsSodhNo
   
   If mMxDel = 0 Then
      gDbCommon.Conn.BeginTrans
   End If
   Cmd.Execute
   If mMxDel = 0 Then
      gDbCommon.Conn.CommitTrans
   End If
   
   Set Cmd = Nothing
   
Exit Sub
Errorhandle:
   Set Cmd = Nothing
   If mMxDel = 0 Then
      gDbCommon.Conn.RollbackTrans
   End If
   Err.Raise vbObjectError + 1, , gDbCommon.Conn.Errors(0)
End Sub

Public Function Requery(Optional vXsSodhDocno As String = "", Optional vXsSodhno As Double = 0) As Integer
   Dim mRs As DbRs
   Dim mSqlStr As String
On Error GoTo Errorhandle

   Requery = -1
   
   mSqlStr = "SELECT XsSodHDOCNO,XsSodHDAT,XsSodH_KHCODE=COALESCE((SELECT KHCODE FROM KHREC WHERE KHNO=XsSodH_KHNO),''),XsSodH_KHNO,"
   mSqlStr = mSqlStr & "XsSodh_CwBzCode=COALESCE((SELECT CWBZCODE FROM CWBZREC WHERE CWBZNO=XsSodh_CwBzno),''),XsSodh_CwBzno,"
   mSqlStr = mSqlStr & "XsSodh_SalerCode=COALESCE((SELECT SalerCODE FROM SalerREC WHERE SalerNO=XsSodh_Salerno),''),XsSodh_Salerno,"
   mSqlStr = mSqlStr & "XsSodHFORM,XsSodHNO FROM XsSodHREC WHERE (XsSodHDOCNO='" & vXsSodhDocno & "' OR XsSodHNO=" & CStr(vXsSodhno) & ") "
   
   Set mRs = New DbRs
   mRs.Fillbydb mSqlStr
   
   If Not mRs.EOF Then
      Requery = 1
      BatchLet mRs!XsSodhDocno, mRs!XsSodhDat, mRs!XsSodh_KhCode, mRs!XsSodh_Khno, mRs!XsSodh_CwBzCode, mRs!XsSodh_CwBzno, mRs!XsSodh_SalerCode, mRs!XsSodh_SalerNo, mRs!XsSodhForm, mRs!XsSodhNo
   End If
   
   Set mRs = Nothing
   
Exit Function
Errorhandle:
   Set mRs = Nothing
   Err.Raise vbObjectError + 1, , Err.Description
End Function

Public Sub BatchLet(ParamArray Properties() As Variant)

   m_XsSodhDocno = Properties(0)
   m_XsSodhDat = Properties(1)
   m_XsSodh_KhCode = Properties(2)
   m_XsSodh_Khno = Properties(3)
   m_XsSodh_CwBzCode = Properties(4)
   m_XsSodh_CwBzno = Properties(5)
   m_XsSodh_SalerCode = Properties(6)
   m_XsSodh_SalerNo = Properties(7)
   m_XsSodhForm = Properties(8)
   m_XsSodhNo = Properties(9)

   m_XsSodhId = 1

End Sub