cgshd.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 = "CgShd"
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_CgShdh As CgShdh
Dim m_CgPod As CgPod
Dim m_Hwbm As Hwbm
Dim m_HwCk As HwCk

Dim m_CgShd_CgShdhno As Double

Dim m_CgShd_CgPodDocno As String
Dim m_CgShd_CgPodno As Double
Dim m_CgShd_HwBmCode As String
Dim m_CgShd_HwBmno As Double

Dim m_CgShd_HwCkMc As String
Dim m_CgShd_HwCkno As Double

Dim m_CgShdQty As Double
Dim m_CgShdPrice As Double
Dim m_CgShdAmt As Double

Dim m_CgShdDDat As String
Dim m_CgShdBz As String

Dim m_CgShdSysDat As String
Dim m_CgShdSysTime As String
Dim m_CgShdNo As Double

Dim m_CgShdId As Integer
Dim m_CgShdKey As Double

Private Sub Class_Initialize()
   m_CgShdId = -1
End Sub

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

Public Property Get CgShdId() As Integer
   CgShdId = m_CgShdId
End Property

Public Property Get CgShdKey() As Double
   CgShdKey = m_CgShdKey
End Property

Public Property Get CgShdh() As CgShdh
   If m_CgShdh Is Nothing Then
      Set m_CgShdh = New CgShdh
      m_CgShdh.Requery "", m_CgShd_CgShdhno
   End If
   Set CgShdh = m_CgShdh
End Property

Public Property Get CgPod() As CgPod
   If m_CgPod Is Nothing Then
      Set m_CgPod = New CgPod
      m_CgPod.Requery m_CgShd_CgPodno
   End If
   Set CgPod = m_CgPod
End Property

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

Public Property Get HwCk() As HwCk
   If m_HwCk Is Nothing Then
      Set m_HwCk = New HwCk
      m_HwCk.Requery "", m_CgShd_HwCkno
   End If
   Set HwCk = m_HwCk
End Property

Public Property Get CgShd_CgShdhno() As Double
   CgShd_CgShdhno = m_CgShd_CgShdhno
End Property

Public Property Get CgShd_CgPodDocno() As String
   CgShd_CgPodDocno = m_CgShd_CgPodDocno
End Property

Public Property Get CgShd_CgPodno() As Double
   CgShd_CgPodno = m_CgShd_CgPodno
End Property

Public Property Get CgShd_HwBmno() As Double
   CgShd_HwBmno = m_CgShd_HwBmno
End Property

Public Property Get CgShd_HwCkno() As Double
   CgShd_HwCkno = m_CgShd_HwCkno
End Property

Public Property Get CgShdQty() As Double
   CgShdQty = m_CgShdQty
End Property

Public Property Get CgShdPrice() As Double
   CgShdPrice = m_CgShdPrice
End Property

Public Property Get CgShdAmt() As Double
   CgShdAmt = m_CgShdAmt
End Property

Public Property Get CgShdDDat() As String
   CgShdDDat = m_CgShdDDat
End Property

Public Property Get CgShdBz() As String
   CgShdBz = m_CgShdBz
End Property

Public Property Get CgShdSysDat() As String
   CgShdSysDat = m_CgShdSysDat
End Property

Public Property Get CgShdSysTime() As String
   CgShdSysTime = m_CgShdSysTime
End Property

Public Property Get CgShdNo() As Double
   CgShdNo = m_CgShdNo
End Property

Public Property Let CgShdId(vCgShdId As Integer)
   m_CgShdId = vCgShdId
End Property

Public Property Let CgShdKey(vCgShdKey As Double)
   m_CgShdKey = vCgShdKey
End Property

Public Property Set CgShdh(vCgShdh As CgShdh)
   Set m_CgShdh = vCgShdh
End Property

Public Property Let CgShd_CgPodno(vCgShd_CgPodno As Double)
   If vCgShd_CgPodno = 0 Then
      m_CgShd_CgPodDocno = ""
      Exit Property
   End If

   Dim Rs As ADODB.Recordset
   Set Rs = Conn.Execute("SELECT CgPodHDOCNO,CgPod_HWBMNO FROM CgPodREC,CgPodHREC WHERE CgPodNO=" & CStr(vCgShd_CgPodno) & " AND CgPodHNO=CgPod_CgPodHNO")
   If Rs.EOF Then
      Rs.Close
      Set Rs = Nothing
      Err.Raise vbObjectError + 1, , "对应的采购单行不存在！"
      Exit Property
   End If
   m_CgShd_CgPodDocno = Rs!CgPodhDocno
   m_CgShd_HwBmno = Rs!CgPod_HwBmno
   Rs.Close
   Set Rs = Nothing

   m_CgShd_CgPodno = vCgShd_CgPodno
End Property

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

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

Public Property Let CgShdQty(vCgShdQty As Double)
   If vCgShdQty <= 0 Then
      Err.Raise vbObjectError + 1, , "数量必须大于零！"
      Exit Property
   End If
   m_CgShdQty = vCgShdQty
   m_CgShdAmt = vCgShdQty * m_CgShdPrice
End Property

Public Property Let CgShdPrice(vCgShdPrice As Double)
   If vCgShdPrice < 0 Then
      Err.Raise vbObjectError + 1, , "单价不能小于零！"
      Exit Property
   End If
   m_CgShdPrice = vCgShdPrice
   m_CgShdAmt = vCgShdPrice * m_CgShdQty
End Property

Public Property Let CgShdBz(vCgShdDBz As String)
   m_CgShdBz = vCgShdDBz
End Property

Public Sub Save()
On Error GoTo Errorhandle
      
   If m_CgShdId = -1 Then
      Cmd.CommandText = "{CALL CgShdREC_INSERT(?,?,?,?,?,?,?,?,?,?,?)}"
      Cmd(0) = m_CgShdh.CgShdhNo
      Cmd(1) = m_CgShd_CgPodno
      Cmd(2) = m_CgShd_HwBmno
      Cmd(3) = m_CgShd_HwCkno
      Cmd(4) = m_CgShdQty
      Cmd(5) = m_CgShdPrice
      Cmd(6) = m_CgShdAmt
      Cmd(7) = m_CgShdBz
      Cmd(8).Direction = adParamOutput 'CgShdSysDate
      Cmd(9).Direction = adParamOutput 'CgShdSysTime
      Cmd(10).Direction = adParamOutput 'CgShdNo
   Else
      Cmd.CommandText = "{CALL CgShdREC_UPDATE(?,?,?,?,?,?,?)}"
      Cmd(0) = m_CgShdNo
      Cmd(1) = m_CgShd_HwBmno
      Cmd(2) = m_CgShd_HwCkno
      Cmd(3) = m_CgShdQty
      Cmd(4) = m_CgShdPrice
      Cmd(5) = m_CgShdAmt
      Cmd(6) = m_CgShdBz
   End If
   
   Cmd.Execute
   
   If m_CgShdId = -1 Then
      m_CgShdSysDat = Cmd(8)
      m_CgShdSysTime = Cmd(9)
      m_CgShdNo = Cmd(10)
      m_CgShdId = 1
   End If
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

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

Public Function Requery(vCgShdNo As Double) As Integer
   Dim mRs As ADODB.Recordset
On Error GoTo Errorhandle
   Requery = -1
   Set mRs = Conn.Execute("SELECT CgShd_CgShdHNO,CgShd_CgPodDOCNO=COALESCE((SELECT CgPodHDOCNO FROM CgPodHREC,CgPodREC WHERE CgPodNO=CgShd_CgPodNO AND CgPodHNO=CgPod_CgPodHNO),''),CgShd_CgPodNO,CgShd_HwBmCode=HwBmCode,CgShd_HWBMNO,CgShd_HwCkMc=HwCkMc,CgShd_HWCKNO,CgShdQTY,CgShdPRICE,CgShdAMT,CgShdBZ,CgShdSYSDAT,CgShdSYSTIME,CgShdNO FROM CgShdREC,HWBMREC,HWCKREC WHERE CgShdNO=" & CStr(vCgShdNo) & " AND HWBMNO=CgShd_HWBMNO AND HWCKNO=CgShd_HWCKNO")
   If Not mRs.EOF Then
      BatchLet mRs!CgShd_CgShdhno, mRs!CgShd_CgPodDocno, mRs!CgShd_CgPodno, mRs!CgShd_HwBmCode, mRs!CgShd_HwBmno, mRs!CgShd_HwCkMc, mRs!CgShd_HwCkno, mRs!CgShdQty, mRs!CgShdPrice, mRs!CgShdAmt, mRs!CgShdBz, mRs!CgShdSysDat, mRs!CgShdSysTime, mRs!CgShdNo
   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_CgShd_CgShdhno = Properties(0)
   m_CgShd_CgPodDocno = Properties(1)
   m_CgShd_CgPodno = Properties(2)
   m_CgShd_HwBmCode = Properties(3)
   m_CgShd_HwBmno = Properties(4)
   m_CgShd_HwCkMc = Properties(5)
   m_CgShd_HwCkno = Properties(6)
   m_CgShdQty = Properties(7)
   m_CgShdPrice = Properties(8)
   m_CgShdAmt = Properties(9)
   m_CgShdBz = Properties(10)
   m_CgShdSysDat = Properties(11)
   m_CgShdSysTime = Properties(12)
   m_CgShdNo = Properties(13)

   m_CgShdId = 1

End Sub