kcdbd.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 = "KcDbd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'QQ:75347626
'MSN:[e-mail]
Option Explicit

Dim m_KcDbdh As KcDbdh
Dim m_Hwbm As Hwbm
Dim m_FromHwCk As HwCk
Dim m_ToHwCk As HwCk

Dim m_KcDbd_KcDbdhno As Double

Dim m_KcDbd_HwBmCode As String
Dim m_KcDbd_HwBmno As Double

Dim m_KcDbd_FromHwCkMc As String
Dim m_KcDbd_FromHwCkno As Double

Dim m_KcDbd_ToHwCkMc As String
Dim m_KcDbd_ToHwCkno As Double

Dim m_KcDbdQty As Double
Dim m_KcDbdPrice As Double
Dim m_KcDbdAmt As Double

Dim m_KcDbdBz As String

Dim m_KcDbdSysDat As String
Dim m_KcDbdSysTime As String
Dim m_KcDbdNo As Double

Dim m_KcDbdId As Integer
Dim m_KcDbdKey As Double

Private Sub Class_Initialize()
   m_KcDbdId = -1
End Sub

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

Public Property Get KcDbdId() As Integer
   KcDbdId = m_KcDbdId
End Property

Public Property Get KcDbdKey() As Double
   KcDbdKey = m_KcDbdKey
End Property

Public Property Get KcDbdh() As KcDbdh
   If m_KcDbdh Is Nothing Then
      Set m_KcDbdh = New KcDbdh
      m_KcDbdh.Requery "", m_KcDbd_KcDbdhno
   End If
   Set KcDbdh = m_KcDbdh
End Property

Public Property Get Hwbm() As Hwbm
   If m_Hwbm Is Nothing Then
      Set m_Hwbm = New Hwbm
      m_Hwbm.Requery "", m_KcDbd_HwBmno
   End If
   Set Hwbm = m_Hwbm
End Property

Public Property Get FromHwCk() As HwCk
   If m_FromHwCk Is Nothing Then
      Set m_FromHwCk = New HwCk
      m_FromHwCk.Requery "", m_KcDbd_FromHwCkno
   End If
   Set FromHwCk = m_FromHwCk
End Property

Public Property Get ToHwCk() As HwCk
   If m_ToHwCk Is Nothing Then
      Set m_ToHwCk = New HwCk
      m_ToHwCk.Requery "", m_KcDbd_ToHwCkno
   End If
   Set ToHwCk = m_ToHwCk
End Property

Public Property Get KcDbd_KcDbdhno() As Double
   KcDbd_KcDbdhno = m_KcDbd_KcDbdhno
End Property

Public Property Get KcDbd_HwBmno() As Double
   KcDbd_HwBmno = m_KcDbd_HwBmno
End Property

Public Property Get KcDbd_FromHwCkno() As Double
   KcDbd_FromHwCkno = m_KcDbd_FromHwCkno
End Property

Public Property Get KcDbd_ToHwCkno() As Double
   KcDbd_ToHwCkno = m_KcDbd_ToHwCkno
End Property

Public Property Get KcDbdQty() As Double
   KcDbdQty = m_KcDbdQty
End Property

Public Property Get KcDbdPrice() As Double
   KcDbdPrice = m_KcDbdPrice
End Property

Public Property Get KcDbdAmt() As Double
   KcDbdAmt = m_KcDbdAmt
End Property

Public Property Get KcDbdBz() As String
   KcDbdBz = m_KcDbdBz
End Property

Public Property Get KcDbdSysDat() As String
   KcDbdSysDat = m_KcDbdSysDat
End Property

Public Property Get KcDbdSysTime() As String
   KcDbdSysTime = m_KcDbdSysTime
End Property

Public Property Get KcDbdNo() As Double
   KcDbdNo = m_KcDbdNo
End Property

Public Property Let KcDbdId(vKcDbdId As Integer)
   m_KcDbdId = vKcDbdId
End Property

Public Property Let KcDbdKey(vKcDbdKey As Double)
   m_KcDbdKey = vKcDbdKey
End Property

Public Property Set KcDbdh(vKcDbdh As KcDbdh)
   Set m_KcDbdh = vKcDbdh
End Property

Public Property Let KcDbd_HwBmCode(vKcDbd_HwBmCode As String)
   If Trim(vKcDbd_HwBmCode) = "" Then
      Err.Raise vbObjectError + 1, , "货物编码不能为空！"
      Exit Property
   End If
   If m_KcDbd_HwBmCode <> vKcDbd_HwBmCode Then
      Dim Rs As ADODB.Recordset
      Set Rs = Conn.Execute("SELECT HWBMNO FROM HWBMREC WHERE HwBmCode='" & vKcDbd_HwBmCode & "'")
      If Rs.EOF Then
         Rs.Close
         Set Rs = Nothing
         Err.Raise vbObjectError + 1, , "录入的货物编码不存在！"
         Exit Property
      End If
      m_KcDbd_HwBmno = Rs!HwBmNo
      Rs.Close
      Set Rs = Nothing
   End If
   m_KcDbd_HwBmCode = vKcDbd_HwBmCode
End Property

Public Property Let KcDbd_FromHwCkMc(vKcDbd_FromHwCkMc As String)
   If Trim(vKcDbd_FromHwCkMc) = "" Then
      Err.Raise vbObjectError + 1, , "来源仓库不能为空！"
      Exit Property
   End If
   If m_KcDbd_FromHwCkMc <> vKcDbd_FromHwCkMc Then
      Dim Rs As ADODB.Recordset
      Set Rs = Conn.Execute("SELECT HwCkNO FROM HwCkREC WHERE HwCkMc='" & vKcDbd_FromHwCkMc & "'")
      If Rs.EOF Then
         Rs.Close
         Set Rs = Nothing
         Err.Raise vbObjectError + 1, , "录入的来源仓库不存在！"
         Exit Property
      End If
      m_KcDbd_FromHwCkno = Rs!HwCkNo
      Rs.Close
      Set Rs = Nothing
   End If
   m_KcDbd_FromHwCkMc = vKcDbd_FromHwCkMc
End Property

Public Property Let KcDbd_ToHwCkMc(vKcDbd_ToHwCkMc As String)
   If Trim(vKcDbd_ToHwCkMc) = "" Then
      Err.Raise vbObjectError + 1, , "目的仓库不能为空！"
      Exit Property
   End If
   If m_KcDbd_ToHwCkMc <> vKcDbd_ToHwCkMc Then
      Dim Rs As ADODB.Recordset
      Set Rs = Conn.Execute("SELECT HwCkNO FROM HwCkREC WHERE HwCkMc='" & vKcDbd_ToHwCkMc & "'")
      If Rs.EOF Then
         Rs.Close
         Set Rs = Nothing
         Err.Raise vbObjectError + 1, , "录入的目的仓库不存在！"
         Exit Property
      End If
      m_KcDbd_ToHwCkno = Rs!HwCkNo
      Rs.Close
      Set Rs = Nothing
   End If
   m_KcDbd_ToHwCkMc = vKcDbd_ToHwCkMc
End Property

Public Property Let KcDbdQty(vKcDbdQty As Double)
   If vKcDbdQty <= 0 Then
      Err.Raise vbObjectError + 1, , "数量必须大于零！"
      Exit Property
   End If
   m_KcDbdQty = vKcDbdQty
   m_KcDbdAmt = vKcDbdQty * m_KcDbdPrice
End Property

Public Property Let KcDbdPrice(vKcDbdPrice As Double)
   If vKcDbdPrice < 0 Then
      Err.Raise vbObjectError + 1, , "单价不能小于零！"
      Exit Property
   End If
   m_KcDbdPrice = vKcDbdPrice
   m_KcDbdAmt = vKcDbdPrice * m_KcDbdQty
End Property

Public Property Let KcDbdBz(vKcDbdDBz As String)
   m_KcDbdBz = vKcDbdDBz
End Property

Public Sub Save()
On Error GoTo Errorhandle
      
   If m_KcDbdId = -1 Then
      Cmd.CommandText = "{CALL KcDbdREC_INSERT(?,?,?,?,?,?,?,?,?,?,?)}"
      Cmd(0) = m_KcDbdh.KcDbdhNo
      Cmd(1) = m_KcDbd_HwBmno
      Cmd(2) = m_KcDbd_FromHwCkno
      Cmd(3) = m_KcDbd_ToHwCkno
      Cmd(4) = m_KcDbdQty
      Cmd(5) = m_KcDbdPrice
      Cmd(6) = m_KcDbdAmt
      Cmd(7) = m_KcDbdBz
      Cmd(8).Direction = adParamOutput 'KcDbdSysDate
      Cmd(9).Direction = adParamOutput 'KcDbdSysTime
      Cmd(10).Direction = adParamOutput 'KcDbdNo
   Else
      Cmd.CommandText = "{CALL KcDbdREC_UPDATE(?,?,?,?,?,?,?,?)}"
      Cmd(0) = m_KcDbdNo
      Cmd(1) = m_KcDbd_HwBmno
      Cmd(2) = m_KcDbd_FromHwCkno
      Cmd(3) = m_KcDbd_ToHwCkno
      Cmd(4) = m_KcDbdQty
      Cmd(5) = m_KcDbdPrice
      Cmd(6) = m_KcDbdAmt
      Cmd(7) = m_KcDbdBz
   End If
   
   Cmd.Execute
   
   If m_KcDbdId = -1 Then
      m_KcDbdSysDat = Cmd(8)
      m_KcDbdSysTime = Cmd(9)
      m_KcDbdNo = Cmd(10)
      m_KcDbdId = 1
   End If
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Public Sub Del()
On Error GoTo Errorhandle
      
   Cmd.CommandText = "{CALL KcDbdREC_DELETE(?)}"
   Cmd(0) = m_KcDbdNo
   
   Conn.BeginTrans
   Cmd.Execute
   If KcDbdh.KcDbds.Count = 1 Then
      KcDbdh.Del
   End If
   Conn.CommitTrans
   
Exit Sub
Errorhandle:
   Conn.RollbackTrans
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Public Function Requery(vKcDbdNo As Double) As Integer
   Dim mRs As ADODB.Recordset
On Error GoTo Errorhandle
   Requery = -1
   Set mRs = Conn.Execute("SELECT KcDbd_KcDbdHNO,KcDbd_HwBmCode=HwBmCode,KcDbd_HWBMNO,KcDbd_FromHwCkMc=A.HWCKMC,KcDbd_FromHwCkNO,KcDbd_TOHwCkMc=B.HWCKMC,KcDbd_TOHwCkNO,KcDbdQTY,KcDbdPRICE,KcDbdAMT,KcDbdBZ,KcDbdSYSDAT,KcDbdSYSTIME,KcDbdNO FROM KcDbdREC,HWBMREC,HwCkREC A,HWCKREC B WHERE KcDbdNO=" & CStr(vKcDbdNo) & " AND HWBMNO=KcDbd_HWBMNO AND A.HwCkNO=KcDbd_FromHwCkNO AND B.HWCKNO=KCDBD_TOHWCKNO")
   If Not mRs.EOF Then
      BatchLet mRs!KcDbd_KcDbdhno, mRs!KcDbd_HwBmCode, mRs!KcDbd_HwBmno, mRs!KcDbd_FromHwCkMc, mRs!KcDbd_FromHwCkno, mRs!KcDbd_ToHwCkMc, mRs!KcDbd_ToHwCkno, mRs!KcDbdQty, mRs!KcDbdPrice, mRs!KcDbdAmt, mRs!KcDbdBz, mRs!KcDbdSysDat, mRs!KcDbdSysTime, mRs!KcDbdNo
   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_KcDbd_KcDbdhno = Properties(0)
   m_KcDbd_HwBmCode = Properties(1)
   m_KcDbd_HwBmno = Properties(2)
   m_KcDbd_FromHwCkMc = Properties(3)
   m_KcDbd_FromHwCkno = Properties(4)
   m_KcDbd_ToHwCkMc = Properties(5)
   m_KcDbd_ToHwCkno = Properties(6)
   m_KcDbdQty = Properties(7)
   m_KcDbdPrice = Properties(8)
   m_KcDbdAmt = Properties(9)
   m_KcDbdBz = Properties(10)
   m_KcDbdSysDat = Properties(11)
   m_KcDbdSysTime = Properties(12)
   m_KcDbdNo = Properties(13)

   m_KcDbdId = 1

End Sub