xssod.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 = "XsSod"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Dim m_XsSodh As XsSodh
Dim m_Hwbm As Hwbm
Dim m_HwDw As HwDw
Dim m_CwSm As CwSm

Dim m_XsSod_XsSodhno As Double

Dim m_XsSod_HwBmCode As String
Dim m_XsSod_HwBmMc As String
Dim m_XsSod_HwBmno As Double

Dim m_XsSod_HwDwCode As String
Dim m_XsSod_HwDwNo As Double
Dim m_XsSod_HwDwConv As Double

Dim m_XsSodQty As Double
Dim m_XsSodPrice As Double
Dim m_XsSodAmt As Double

Dim m_XsSodDDat As String
Dim m_XsSod_CwSmCode As String
Dim m_XsSod_CwSmNo As Double

Dim m_XsSodBz As String
Dim m_XsSodNo As Double

Dim m_XsSodId As Integer
Dim m_XsSodKey As Double

Private Sub Class_Initialize()
   m_XsSodId = -1
End Sub

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

Public Property Get XsSodId() As Integer
   XsSodId = m_XsSodId
End Property

Public Property Let XsSodId(vXsSodId As Integer)
   m_XsSodId = vXsSodId
End Property

Public Property Get XsSodKey() As Double
   XsSodKey = m_XsSodKey
End Property

Public Property Let XsSodKey(vXsSodKey As Double)
   m_XsSodKey = vXsSodKey
End Property

Public Property Get XsSodh() As XsSodh
   If m_XsSodh Is Nothing Then
      Set m_XsSodh = New XsSodh
      m_XsSodh.Requery "", m_XsSod_XsSodhno
   End If
   Set XsSodh = m_XsSodh
End Property

Public Property Set XsSodh(vXsSodh As XsSodh)
   Set m_XsSodh = vXsSodh
End Property

Public Property Get Hwbm() As Hwbm
   If m_Hwbm Is Nothing Then
      Set m_Hwbm = New Hwbm
      If m_XsSod_HwBmCode <> "" Then
         m_Hwbm.Requery m_XsSod_HwBmCode
      End If
   End If
   Set Hwbm = m_Hwbm
End Property

Public Property Get HwDw() As HwDw
   If m_HwDw Is Nothing Then
      Set m_HwDw = New HwDw
      If m_XsSod_HwDwCode <> "" Then
         m_HwDw.Requery m_XsSod_HwDwCode
      End If
   End If
   Set HwDw = m_HwDw
End Property

Public Property Get CwSm() As CwSm
   If m_CwSm Is Nothing Then
      Set m_CwSm = New CwSm
      If m_XsSod_CwSmCode <> "" Then
         m_CwSm.Requery m_XsSod_CwSmCode
      End If
   End If
   Set CwSm = m_CwSm
End Property

Public Property Get XsSod_XsSodhno() As Double
   XsSod_XsSodhno = m_XsSod_XsSodhno
End Property

Public Property Get XsSod_HwBmCode() As String
   XsSod_HwBmCode = m_XsSod_HwBmCode
End Property

Public Property Get XsSod_HwBmMc() As String
   XsSod_HwBmMc = m_XsSod_HwBmMc
End Property

Public Property Get XsSod_HwBmno() As Double
   XsSod_HwBmno = m_XsSod_HwBmno
End Property

Public Property Get XsSod_HwDwCode() As String
   XsSod_HwDwCode = m_XsSod_HwDwCode
End Property

Public Property Get XsSod_HwDwno() As Double
   XsSod_HwDwno = m_XsSod_HwDwNo
End Property

Public Property Get XsSod_HwDwConv() As Double
   XsSod_HwDwConv = m_XsSod_HwDwConv
End Property

Public Property Get XsSodQty() As Double
   XsSodQty = m_XsSodQty
End Property

Public Property Get XsSodPrice() As Double
   XsSodPrice = m_XsSodPrice
End Property

Public Property Get XsSodAmt() As Double
   XsSodAmt = m_XsSodAmt
End Property

Public Property Get XsSod_CwSmCode() As String
   XsSod_CwSmCode = m_XsSod_CwSmCode
End Property

Public Property Get XsSodDDat() As String
   XsSodDDat = m_XsSodDDat
End Property

Public Property Get XsSodBz() As String
   XsSodBz = m_XsSodBz
End Property

Public Property Get XsSodNo() As Double
   XsSodNo = m_XsSodNo
End Property

Public Property Let XsSod_HwBmCode(vXsSod_HwBmCode As String)
   If Trim(vXsSod_HwBmCode) = "" Then
      Err.Raise vbObjectError + 1, , "货物编码不能为空！"
      Exit Property
   End If
   If m_XsSod_HwBmCode <> vXsSod_HwBmCode Then
      If Hwbm.Requery(vXsSod_HwBmCode) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的货物编码不存在！"
         Exit Property
      End If
      m_XsSod_HwBmno = Hwbm.HwBmNo
      m_XsSod_HwBmMc = Hwbm.HwBmMc
      m_XsSod_HwDwCode = Hwbm.HwBm_HwDwCode
      m_XsSod_HwDwNo = Hwbm.HwBm_HwDwNo
      m_XsSod_HwDwConv = 1
   End If
   m_XsSod_HwBmCode = vXsSod_HwBmCode
End Property

Public Property Let XsSod_HwDwCode(vXsSod_HwDwCode As String)
   If Trim(vXsSod_HwDwCode) = "" Then
      Err.Raise vbObjectError + 1, , "计量单位不能为空！"
      Exit Property
   End If
   If m_XsSod_HwDwCode <> vXsSod_HwDwCode Then
      If HwDw.Requery(vXsSod_HwDwCode) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的计量单位不存在！"
         Exit Property
      End If
      m_XsSod_HwDwNo = HwDw.HwDwNo
   End If
   m_XsSod_HwDwCode = vXsSod_HwDwCode
End Property

Public Property Let XsSod_HwDwConv(vXsSod_HwdwConv As Double)
   If vXsSod_HwdwConv <= 0 Then
      Err.Raise vbObjectError + 1, , "换算系数必须大于零！"
      Exit Property
   End If
   m_XsSod_HwDwConv = vXsSod_HwdwConv
End Property

Public Property Let XsSodQty(vXsSodQty As Double)
   If vXsSodQty <= 0 Then
      Err.Raise vbObjectError + 1, , "数量必须大于零！"
      Exit Property
   End If
   m_XsSodQty = vXsSodQty
   m_XsSodAmt = Val(Format(vXsSodQty * m_XsSodPrice, "##"))
End Property

Public Property Let XsSodPrice(vXsSodPrice As Double)
   If vXsSodPrice < 0 Then
      Err.Raise vbObjectError + 1, , "单价不能小于零！"
      Exit Property
   End If
   m_XsSodPrice = vXsSodPrice
   m_XsSodAmt = Val(Format(vXsSodPrice * m_XsSodQty, "##"))
End Property

Public Property Let XsSodAmt(vXsSodAmt As Double)
   If vXsSodAmt < 0 Then
      Err.Raise vbObjectError + 1, , "金额不能小于零！"
      Exit Property
   End If
   m_XsSodAmt = vXsSodAmt
End Property

Public Property Let XsSod_CwSmCode(vXsSod_CwSmCode As String)
   If Trim(vXsSod_CwSmCode) = "" Then
      Err.Raise vbObjectError + 1, , "税码不能为空！"
      Exit Property
   End If
   If m_XsSod_CwSmCode <> vXsSod_CwSmCode Then
      If CwSm.Requery(vXsSod_CwSmCode) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的税码不存在！"
         Exit Property
      End If
      m_XsSod_CwSmNo = CwSm.CwsmNo
   End If
   m_XsSod_CwSmCode = vXsSod_CwSmCode
End Property

Public Property Let XsSodDDat(vXsSodDDat As String)
   If vXsSodDDat = "" Then
      m_XsSodDDat = ""
      Exit Property
   End If
   If gPublicFunction.IsDateValid(vXsSodDDat) = 0 Then
      Err.Raise vbObjectError + 1, , "需求日期不正确！"
      Exit Property
   End If
   m_XsSodDDat = vXsSodDDat
End Property

Public Property Let XsSodBz(vXsSodDBz As String)
   m_XsSodBz = vXsSodDBz
End Property

Public Sub Save()
   Dim Cmd As ADODB.Command
On Error GoTo Errorhandle
      
   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
            
   If m_XsSodId = -1 Then
      Cmd.CommandText = gPublicFunction.GetCallSPString("XsSodREC_INSERT", 11)
      Cmd(0) = m_XsSodh.XsSodhNo
      Cmd(1) = m_XsSod_HwBmno
      Cmd(2) = m_XsSod_HwDwNo
      Cmd(3) = m_XsSod_HwDwConv
      Cmd(4) = m_XsSodQty
      Cmd(5) = m_XsSodPrice
      Cmd(6) = m_XsSodAmt
      Cmd(7) = m_XsSod_CwSmNo
      Cmd(8) = m_XsSodDDat
      Cmd(9) = m_XsSodBz
      Cmd(10).Direction = adParamOutput   'XsSodNo
   Else
      Cmd.CommandText = gPublicFunction.GetCallSPString("XsSodREC_UPDATE", 10)
      Cmd(0) = m_XsSodNo
      Cmd(1) = m_XsSod_HwBmno
      Cmd(2) = m_XsSod_HwDwNo
      Cmd(3) = m_XsSod_HwDwConv
      Cmd(4) = m_XsSodQty
      Cmd(5) = m_XsSodPrice
      Cmd(6) = m_XsSodAmt
      Cmd(7) = m_XsSod_CwSmNo
      Cmd(8) = m_XsSodDDat
      Cmd(9) = m_XsSodBz
   End If
   
   Cmd.Execute
   
   If m_XsSodId = -1 Then
      m_XsSodNo = Cmd(10)
      m_XsSodId = 1
   End If
   
   Set Cmd = Nothing
   
Exit Sub
Errorhandle:
   Set Cmd = Nothing
   Err.Raise vbObjectError + 1, , gDbCommon.Conn.Errors(0)
End Sub

Public Sub Del()
   Dim Cmd As ADODB.Command
On Error GoTo Errorhandle

   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
      
   Cmd.CommandText = "{CALL XsSodREC_DELETE(?)}"
   Cmd(0) = m_XsSodNo
   
   gDbCommon.Conn.BeginTrans
   Cmd.Execute
   If XsSodh.XsSods.Count = 1 Then
      XsSodh.Del 1
   End If
   gDbCommon.Conn.CommitTrans
   
   Set Cmd = Nothing
   
Exit Sub
Errorhandle:
   Set Cmd = Nothing
   gDbCommon.Conn.RollbackTrans
   Err.Raise vbObjectError + 1, , gDbCommon.Conn.Errors(0)
End Sub

Public Function Requery(vXsSodNo As Double) As Integer
   Dim mRs As DbRs
   Dim mSqlStr As String
On Error GoTo Errorhandle
   Requery = -1
   
   Set mRs = New DbRs
   
   mSqlStr = "SELECT XsSod_XsSodHNO,XsSod_HwBmCode=COALESCE((SELECT HwBmCode FROM HWBMREC WHERE HWBMNO=XsSod_HWBMNO),''),XsSod_HwBmMc=COALESCE((SELECT HwBmMc FROM HWBMREC WHERE HWBMNO=XsSod_HWBMNO),''),XsSod_HWBMNO,"
   mSqlStr = mSqlStr & "XsSod_HwDwCode=COALESCE((SELECT HWDWCode FROM HWDWREC WHERE HWDWNO=XsSod_HWDWNO),''),XsSod_HWDWNO,XsSod_HWDWCONV,"
   mSqlStr = mSqlStr & "XsSodQTY,XsSodPRICE,XsSodAMT,"
   mSqlStr = mSqlStr & "XsSod_CWSMCODE=COALESCE((SELECT CWSMCODE FROM CWSMREC WHERE CWSMNO=XsSod_CWSMNO),''),XsSod_CWSMNO,XsSodDDAT,"
   mSqlStr = mSqlStr & "XsSodBZ,XsSodNO FROM XsSodREC WHERE XsSodNO=" & CStr(vXsSodNo)
   
   mRs.Fillbydb mSqlStr
   mRs.MoveFirst
   
   If Not mRs.EOF Then
      BatchLet mRs!XsSod_XsSodhno, mRs!XsSod_HwBmCode, mRs!XsSod_HwBmMc, mRs!XsSod_HwBmno, _
               mRs!XsSod_HwDwCode, mRs!XsSod_HwDwno, mRs!XsSod_HwDwConv, _
               mRs!XsSodQty, mRs!XsSodPrice, mRs!XsSodAmt, _
               mRs!XsSod_CwSmCode, mRs!XsSod_CwSmno, mRs!XsSodDDat, mRs!XsSodBz, mRs!XsSodNo
      Requery = 1
   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_XsSod_XsSodhno = Properties(0)
   m_XsSod_HwBmCode = Properties(1)
   m_XsSod_HwBmMc = Properties(2)
   m_XsSod_HwBmno = Properties(3)
   m_XsSod_HwDwCode = Properties(4)
   m_XsSod_HwDwNo = Properties(5)
   m_XsSod_HwDwConv = Properties(6)
   m_XsSodQty = Properties(7)
   m_XsSodPrice = Properties(8)
   m_XsSodAmt = Properties(9)
   m_XsSod_CwSmCode = Properties(10)
   m_XsSod_CwSmNo = Properties(11)
   m_XsSodDDat = Properties(12)
   m_XsSodBz = Properties(13)
   m_XsSodNo = Properties(14)

   m_XsSodId = 1

End Sub