kcbfd.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 = "KcBfd"
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_KcBfdh As KcBfdh
Dim m_Hwbm As Hwbm
Dim m_HwBfrc As HwBfrc

Dim m_KcBfd_KcBfdhno As Double

Dim m_KcBfd_HwBmCode As String
Dim m_KcBfd_HwBmno As Double

Dim m_KcBfdQty As Double
Dim m_KcBfdPrice As Double
Dim m_KcBfdAmt As Double

Dim m_KcBfd_HwBfrcMc As String
Dim m_KcBfd_HwBfrcNo As Double

Dim m_KcBfdBz As String

Dim m_KcBfdSysDat As String
Dim m_KcBfdSysTime As String
Dim m_KcBfdNo As Double

Dim m_KcBfdId As Integer
Dim m_KcBfdKey As Double

Private Sub Class_Initialize()
   m_KcBfdId = -1
End Sub

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

Public Property Get KcBfdId() As Integer
   KcBfdId = m_KcBfdId
End Property

Public Property Get KcBfdKey() As Double
   KcBfdKey = m_KcBfdKey
End Property

Public Property Get KcBfdh() As KcBfdh
   If m_KcBfdh Is Nothing Then
      Set m_KcBfdh = New KcBfdh
      m_KcBfdh.Requery "", m_KcBfd_KcBfdhno
   End If
   Set KcBfdh = m_KcBfdh
End Property

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

Public Property Get HwBfrc() As HwBfrc
   If m_HwBfrc Is Nothing Then
      Set m_HwBfrc = New HwBfrc
      m_HwBfrc.Requery "", m_KcBfd_HwBfrcNo
   End If
   Set HwBfrc = m_HwBfrc
End Property

Public Property Get KcBfd_KcBfdhno() As Double
   KcBfd_KcBfdhno = m_KcBfd_KcBfdhno
End Property

Public Property Get KcBfd_HwBmno() As Double
   KcBfd_HwBmno = m_KcBfd_HwBmno
End Property

Public Property Get KcBfdQty() As Double
   KcBfdQty = m_KcBfdQty
End Property

Public Property Get KcBfdPrice() As Double
   KcBfdPrice = m_KcBfdPrice
End Property

Public Property Get KcBfdAmt() As Double
   KcBfdAmt = m_KcBfdAmt
End Property

Public Property Get KcBfd_HwBfRcno() As Double
   KcBfd_HwBfRcno = m_KcBfd_HwBfrcNo
End Property

Public Property Get KcBfdBz() As String
   KcBfdBz = m_KcBfdBz
End Property

Public Property Get KcBfdSysDat() As String
   KcBfdSysDat = m_KcBfdSysDat
End Property

Public Property Get KcBfdSysTime() As String
   KcBfdSysTime = m_KcBfdSysTime
End Property

Public Property Get KcBfdNo() As Double
   KcBfdNo = m_KcBfdNo
End Property

Public Property Let KcBfdId(vKcBfdId As Integer)
   m_KcBfdId = vKcBfdId
End Property

Public Property Let KcBfdKey(vKcBfdKey As Double)
   m_KcBfdKey = vKcBfdKey
End Property

Public Property Set KcBfdh(vKcBfdh As KcBfdh)
   Set m_KcBfdh = vKcBfdh
End Property

Public Property Let KcBfd_HwBmCode(vKcBfd_HwBmCode As String)
   If Trim(vKcBfd_HwBmCode) = "" Then
      Err.Raise vbObjectError + 1, , "货物编码不能为空！"
      Exit Property
   End If
   If m_KcBfd_HwBmCode <> vKcBfd_HwBmCode Then
      If Hwbm.Requery(vKcBfd_HwBmCode) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的货物编码不存在！"
         Exit Property
      End If
      m_KcBfd_HwBmno = Hwbm.HwBmNo
   End If
   m_KcBfd_HwBmCode = vKcBfd_HwBmCode
End Property

Public Property Let KcBfdQty(vKcBfdQty As Double)
   If vKcBfdQty < 0 Then
      Err.Raise vbObjectError + 1, , "报废数量不能小于零！"
      Exit Property
   End If
   m_KcBfdQty = vKcBfdQty
   m_KcBfdAmt = vKcBfdQty * m_KcBfdPrice
End Property

Public Property Let KcBfd_HwBfrcMc(vKcBfd_HwBfrcMc As String)
   If Trim(vKcBfd_HwBfrcMc) = "" Then
      Err.Raise vbObjectError + 1, , "报废原因不能为空！"
      Exit Property
   End If
   If m_KcBfd_HwBfrcMc <> vKcBfd_HwBfrcMc Then
      If HwBfrc.Requery(vKcBfd_HwBfrcMc) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的报废原因不存在！"
         Exit Property
      End If
      m_KcBfd_HwBfrcNo = HwBfrc.HwBfRcNo
   End If
   m_KcBfd_HwBfrcMc = vKcBfd_HwBfrcMc
End Property

Public Property Let KcBfdBz(vKcBfdDBz As String)
   m_KcBfdBz = vKcBfdDBz
End Property

Public Sub Save()
On Error GoTo Errorhandle
      
   If m_KcBfdId = -1 Then
      Cmd.CommandText = "{CALL KcBfdREC_INSERT(?,?,?,?,?,?,?,?,?,?,?)}"
      Cmd(0) = m_KcBfdh.KcBfdhNo
      Cmd(1) = KcBfdh.KcBfdh_HwCkno
      Cmd(2) = m_KcBfd_HwBmno
      Cmd(3) = m_KcBfdQty
      Cmd(4) = m_KcBfdPrice
      Cmd(5) = m_KcBfdAmt
      Cmd(6) = m_KcBfd_HwBfrcNo
      Cmd(7) = m_KcBfdBz
      Cmd(8).Direction = adParamOutput 'KcBfdSysDate
      Cmd(9).Direction = adParamOutput 'KcBfdSysTime
      Cmd(10).Direction = adParamOutput 'KcBfdNo
   Else
      Cmd.CommandText = "{CALL KcBfdREC_UPDATE(?,?,?,?,?,?,?,?)}"
      Cmd(0) = m_KcBfdNo
      Cmd(1) = KcBfdh.KcBfdh_HwCkno
      Cmd(2) = m_KcBfd_HwBmno
      Cmd(3) = m_KcBfdQty
      Cmd(4) = m_KcBfdPrice
      Cmd(5) = m_KcBfdAmt
      Cmd(6) = m_KcBfd_HwBfrcNo
      Cmd(7) = m_KcBfdBz
   End If
   
   Cmd.Execute
   
   If m_KcBfdId = -1 Then
      m_KcBfdSysDat = Cmd(8)
      m_KcBfdSysTime = Cmd(9)
      m_KcBfdNo = Cmd(10)
      m_KcBfdId = 1
   End If
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

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

Public Function Requery(vKcBfdNo As Double) As Integer
   Dim mRs As ADODB.Recordset
On Error GoTo Errorhandle
   Requery = -1
   Set mRs = Conn.Execute("SELECT KcBfd_HwBmCode=HwBmCode,KcBfd_HWBMNO,KcBfdQTY,KcBfdPRICE,KcBfdAMT,KCBFD_HWBFRCMC=HWBFRCMC,KCBFD_HWBFRCNO,KcBfdBZ,KcBfdSYSDAT,KcBfdSYSTIME,KcBfdNO FROM KcBfdREC,HWBMREC,HWBFRCREC WHERE KcBfdNO=" & CStr(vKcBfdNo) & " AND HWBMNO=KcBfd_HWBMNO AND HWBFRCNO=KCBFD_HWBFRCNO")
   If Not mRs.EOF Then
      BatchLet mRs!KcBfd_HwBmCode, mRs!KcBfd_HwBmno, mRs!KcBfdQty, mRs!KcBfdPrice, mRs!KcBfdAmt, mRs!KcBfd_HwBfrcMc, mRs!KcBfd_HwBfRcno, mRs!KcBfdBz, mRs!KcBfdSysDat, mRs!KcBfdSysTime, mRs!KcBfdNo
   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_KcBfd_HwBmCode = Properties(0)
   m_KcBfd_HwBmno = Properties(1)
   m_KcBfdQty = Properties(2)
   m_KcBfdPrice = Properties(3)
   m_KcBfdAmt = Properties(4)
   m_KcBfd_HwBfrcMc = Properties(5)
   m_KcBfd_HwBfrcNo = Properties(6)
   m_KcBfdBz = Properties(7)
   m_KcBfdSysDat = Properties(8)
   m_KcBfdSysTime = Properties(9)
   m_KcBfdNo = Properties(10)

   m_KcBfdId = 1

End Sub