kcpdd.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 = "KcPdd"
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_KcPddh As KcPddh
Dim m_Hwbm As Hwbm
Dim m_HwPdRc As HwPdRc

Dim m_KcPdd_KcPddhno As Double

Dim m_KcPdd_HwBmCode As String
Dim m_KcPdd_HwBmno As Double

Dim m_KcPddQty1 As Double
Dim m_KcPddQty2 As Double
Dim m_KcPddPrice As Double
Dim m_KcPddAmt1 As Double
Dim m_KcPddAmt2 As Double

Dim m_KcPdd_HwPdRcMc As String
Dim m_KcPdd_HwPdRcno As Double
Dim m_KcPddBz As String

Dim m_KcPddSysDat As String
Dim m_KcPddSysTime As String
Dim m_KcPddNo As Double

Dim m_KcPddId As Integer
Dim m_KcPddKey As Double

Private Sub Class_Initialize()
   m_KcPddId = -1
End Sub

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

Public Property Get KcPddId() As Integer
   KcPddId = m_KcPddId
End Property

Public Property Get KcPddKey() As Double
   KcPddKey = m_KcPddKey
End Property

Public Property Get KcPddh() As KcPddh
   If m_KcPddh Is Nothing Then
      Set m_KcPddh = New KcPddh
      m_KcPddh.Requery "", m_KcPdd_KcPddhno
   End If
   Set KcPddh = m_KcPddh
End Property

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

Public Property Get HwPdRc() As HwPdRc
   If m_HwPdRc Is Nothing Then
      Set m_HwPdRc = New HwPdRc
      m_HwPdRc.Requery "", m_KcPdd_HwPdRcno
   End If
   Set HwPdRc = m_HwPdRc
End Property

Public Property Get KcPdd_KcPddhno() As Double
   KcPdd_KcPddhno = m_KcPdd_KcPddhno
End Property

Public Property Get KcPdd_HwBmno() As Double
   KcPdd_HwBmno = m_KcPdd_HwBmno
End Property

Public Property Get KcPddQty1() As Double
   KcPddQty1 = m_KcPddQty1
End Property

Public Property Get KcPddQty2() As Double
   KcPddQty2 = m_KcPddQty2
End Property

Public Property Get KcPddPrice() As Double
   KcPddPrice = m_KcPddPrice
End Property

Public Property Get KcPddAmt1() As Double
   KcPddAmt1 = m_KcPddAmt1
End Property

Public Property Get KcPddAmt2() As Double
   KcPddAmt2 = m_KcPddAmt2
End Property

Public Property Get KcPdd_HwPdRcno() As Double
   KcPdd_HwPdRcno = m_KcPdd_HwPdRcno
End Property

Public Property Get KcPddBz() As String
   KcPddBz = m_KcPddBz
End Property

Public Property Get KcPddSysDat() As String
   KcPddSysDat = m_KcPddSysDat
End Property

Public Property Get KcPddSysTime() As String
   KcPddSysTime = m_KcPddSysTime
End Property

Public Property Get KcPddNo() As Double
   KcPddNo = m_KcPddNo
End Property

Public Property Let KcPddId(vKcPddId As Integer)
   m_KcPddId = vKcPddId
End Property

Public Property Let KcPddKey(vKcPddKey As Double)
   m_KcPddKey = vKcPddKey
End Property

Public Property Set KcPddh(vKcPddh As KcPddh)
   Set m_KcPddh = vKcPddh
End Property

Public Property Let KcPdd_HwBmCode(vKcPdd_HwBmCode As String)
   If Trim(vKcPdd_HwBmCode) = "" Then
      Err.Raise vbObjectError + 1, , "货物编码不能为空！"
      Exit Property
   End If
   If m_KcPdd_HwBmCode <> vKcPdd_HwBmCode Then
      If Hwbm.Requery(vKcPdd_HwBmCode) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的货物编码不存在！"
         Exit Property
      End If
      m_KcPdd_HwBmno = Hwbm.HwBmNo
      
      Dim Rs As ADODB.Recordset
      Set Rs = Conn.Execute("SELECT HWKCQTY FROM HWKCREC,HWBMREC,HWCKREC WHERE HWCKNO=HWKC_HWCKNO AND HWCKMC='" & KcPddh.HwCk.HwCkMc & "' AND HWBMNO=HWKC_HWBMNO AND HwBmCode='" & vKcPdd_HwBmCode & "'")
      If Rs.EOF Then
         m_KcPddQty1 = 0
      Else
         m_KcPddQty1 = Val(Rs!HWKCQTY)
      End If
      Rs.Close
      Set Rs = Nothing
   End If
   m_KcPdd_HwBmCode = vKcPdd_HwBmCode
End Property

Public Property Let KcPddQty2(vKcPddQty2 As Double)
   If vKcPddQty2 < 0 Then
      Err.Raise vbObjectError + 1, , "实盘数量不能小于零！"
      Exit Property
   End If
   m_KcPddQty2 = vKcPddQty2
   m_KcPddAmt2 = vKcPddQty2 * m_KcPddPrice
End Property

Public Property Let KcPddPrice(vKcPddPrice As Double)
   If vKcPddPrice < 0 Then
      Err.Raise vbObjectError + 1, , "单价不能小于零！"
      Exit Property
   End If
   m_KcPddPrice = vKcPddPrice
   m_KcPddAmt1 = vKcPddPrice * m_KcPddQty1
   m_KcPddAmt2 = vKcPddPrice * m_KcPddQty2
End Property

Public Property Let KcPdd_HwPdrcMc(vKcPdd_HwPdrcMc As String)
   If Trim(vKcPdd_HwPdrcMc) = "" Then
      Err.Raise vbObjectError + 1, , "盘点差异原因不能为空！"
      Exit Property
   End If
   If m_KcPdd_HwPdRcMc <> vKcPdd_HwPdrcMc Then
      If HwPdRc.Requery(vKcPdd_HwPdrcMc) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的盘点差异原因不存在！"
         Exit Property
      End If
      m_KcPdd_HwPdRcno = HwPdRc.HwPdRcNo
   End If
   m_KcPdd_HwPdRcMc = vKcPdd_HwPdrcMc
End Property

Public Property Let KcPddBz(vKcPddDBz As String)
   m_KcPddBz = vKcPddDBz
End Property

Public Sub Save()
On Error GoTo Errorhandle
      
   If m_KcPddId = -1 Then
      Cmd.CommandText = "{CALL KcPddREC_INSERT(?,?,?,?,?,?,?,?,?,?,?,?,?)}"
      Cmd(0) = m_KcPddh.KcPddhNo
      Cmd(1) = KcPddh.KcPddh_HwCkno
      Cmd(2) = m_KcPdd_HwBmno
      Cmd(3) = m_KcPddQty1
      Cmd(4) = m_KcPddQty2
      Cmd(5) = m_KcPddPrice
      Cmd(6) = m_KcPddAmt1
      Cmd(7) = m_KcPddAmt2
      Cmd(8) = m_KcPdd_HwPdRcno
      Cmd(9) = m_KcPddBz
      Cmd(10).Direction = adParamOutput 'KcPddSysDate
      Cmd(11).Direction = adParamOutput 'KcPddSysTime
      Cmd(12).Direction = adParamOutput 'KcPddNo
   Else
      Cmd.CommandText = "{CALL KcPddREC_UPDATE(?,?,?,?,?,?,?,?,?,?)}"
      Cmd(0) = m_KcPddNo
      Cmd(1) = KcPddh.KcPddh_HwCkno
      Cmd(2) = m_KcPdd_HwBmno
      Cmd(3) = m_KcPddQty1
      Cmd(4) = m_KcPddQty2
      Cmd(5) = m_KcPddPrice
      Cmd(6) = m_KcPddAmt1
      Cmd(7) = m_KcPddAmt2
      Cmd(8) = m_KcPdd_HwPdRcno
      Cmd(9) = m_KcPddBz
   End If
   
   Cmd.Execute
   
   If m_KcPddId = -1 Then
      m_KcPddSysDat = Cmd(10)
      m_KcPddSysTime = Cmd(11)
      m_KcPddNo = Cmd(12)
      m_KcPddId = 1
   End If
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

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

Public Function Requery(vKcPddNo As Double) As Integer
   Dim mRs As ADODB.Recordset
On Error GoTo Errorhandle
   Requery = -1
   Set mRs = Conn.Execute("SELECT KcPdd_HwBmCode=HwBmCode,KcPdd_HWBMNO,KcPddQTY1,KCPDDQTY2,KcPddPRICE,KcPddAMT1,KCPDDAMT2,KCPDD_HWPDRCMC=HWPDRCMC,KCPDD_HWPDRCNO,KcPddBZ,KcPddSYSDAT,KcPddSYSTIME,KcPddNO FROM KcPddREC,HWBMREC,HWPDRCREC WHERE KcPddNO=" & CStr(vKcPddNo) & " AND HWBMNO=KcPdd_HWBMNO AND HWPDRCNO=KCPDD_HWPDRCNO")
   If Not mRs.EOF Then
      BatchLet mRs!KcPdd_HwBmCode, mRs!KcPdd_HwBmno, mRs!KcPddQty1, mRs!KcPddQty2, mRs!KcPddPrice, mRs!KcPddAmt1, mRs!KcPddAmt2, mRs!KcPdd_HwPdrcMc, mRs!KcPdd_HwPdRcno, mRs!KcPddBz, mRs!KcPddSysDat, mRs!KcPddSysTime, mRs!KcPddNo
   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_KcPdd_HwBmCode = Properties(0)
   m_KcPdd_HwBmno = Properties(1)
   m_KcPddQty1 = Properties(2)
   m_KcPddQty2 = Properties(3)
   m_KcPddPrice = Properties(4)
   m_KcPddAmt1 = Properties(5)
   m_KcPddAmt2 = Properties(6)
   m_KcPdd_HwPdRcMc = Properties(7)
   m_KcPdd_HwPdRcno = Properties(8)
   m_KcPddBz = Properties(9)
   m_KcPddSysDat = Properties(10)
   m_KcPddSysTime = Properties(11)
   m_KcPddNo = Properties(12)

   m_KcPddId = 1

End Sub