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

Dim m_Hwdbdh As Hwdbdh

Dim m_Hwbm As Hwbm
Dim m_FromHwCk As HwCk
Dim m_ToHwCk As HwCk
Dim m_HwDw As HwDw

Dim m_Hwdbd_Hwdbdhno As Double

Dim m_Hwdbd_HwBmCode As String
Dim m_Hwdbd_HwBmMc As String
Dim m_Hwdbd_HwBmno As Double

Dim m_Hwdbd_FromHwCkMc As String
Dim m_Hwdbd_FromHwCkno As Double

Dim m_Hwdbd_ToHwCkMc As String
Dim m_Hwdbd_ToHwCkno As Double

Dim m_Hwdbd_HwDwCode As String
Dim m_Hwdbd_HwDwNo As Double
Dim m_Hwdbd_HwDwConv As Double

Dim m_HwdbdQty As Double
Dim m_HwdbdPrice As Double
Dim m_HwdbdAmt As Double

Dim m_HwdbdMioNo As Double

Dim m_HwdbdBz As String

Dim m_HwdbdNo As Double

Dim m_HwdbdId As Integer
Dim m_HwdbdKey As Double

Private Sub Class_Initialize()
   m_HwdbdId = -1
End Sub

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

Public Property Get HwdbdId() As Integer
   HwdbdId = m_HwdbdId
End Property

Public Property Let HwdbdId(vHwdbdId As Integer)
   m_HwdbdId = vHwdbdId
End Property

Public Property Get HwdbdKey() As Double
   HwdbdKey = m_HwdbdKey
End Property

Public Property Let HwdbdKey(vHwdbdKey As Double)
   m_HwdbdKey = vHwdbdKey
End Property

Public Property Get Hwdbdh() As Hwdbdh
   If m_Hwdbdh Is Nothing Then
      Set m_Hwdbdh = New Hwdbdh
      m_Hwdbdh.Requery "", m_Hwdbd_Hwdbdhno
   End If
   Set Hwdbdh = m_Hwdbdh
End Property

Public Property Set Hwdbdh(vHwdbdh As Hwdbdh)
   Set m_Hwdbdh = vHwdbdh
End Property

Public Property Get Hwbm() As Hwbm
   If m_Hwbm Is Nothing Then
      Set m_Hwbm = New Hwbm
      If m_Hwdbd_HwBmCode <> "" Then
         m_Hwbm.Requery m_Hwdbd_HwBmCode
      End If
   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
      If m_Hwdbd_FromHwCkMc <> "" Then
         m_FromHwCk.Requery m_Hwdbd_FromHwCkMc
      End If
   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
      If m_Hwdbd_ToHwCkMc <> "" Then
         m_ToHwCk.Requery m_Hwdbd_ToHwCkMc
      End If
   End If
   Set ToHwck = m_ToHwCk
End Property

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

Public Property Get Hwdbd_Hwdbdhno() As Double
   Hwdbd_Hwdbdhno = m_Hwdbd_Hwdbdhno
End Property

Public Property Get Hwdbd_HwBmCode() As String
   Hwdbd_HwBmCode = m_Hwdbd_HwBmCode
End Property

Public Property Get Hwdbd_HwBmMc() As String
   Hwdbd_HwBmMc = m_Hwdbd_HwBmMc
End Property

Public Property Get Hwdbd_HwBmno() As Double
   Hwdbd_HwBmno = m_Hwdbd_HwBmno
End Property

Public Property Get Hwdbd_FromHwCkMc() As String
   Hwdbd_FromHwCkMc = m_Hwdbd_FromHwCkMc
End Property

Public Property Get Hwdbd_FromHwCkno() As Double
   Hwdbd_FromHwCkno = m_Hwdbd_FromHwCkno
End Property

Public Property Get Hwdbd_ToHwCkMc() As String
   Hwdbd_ToHwCkMc = m_Hwdbd_ToHwCkMc
End Property

Public Property Get Hwdbd_ToHwCkno() As Double
   Hwdbd_ToHwCkno = m_Hwdbd_ToHwCkno
End Property

Public Property Get Hwdbd_HwDwCode() As String
   Hwdbd_HwDwCode = m_Hwdbd_HwDwCode
End Property

Public Property Get Hwdbd_HwDwno() As Double
   Hwdbd_HwDwno = m_Hwdbd_HwDwNo
End Property

Public Property Get Hwdbd_HwDwConv() As Double
   Hwdbd_HwDwConv = m_Hwdbd_HwDwConv
End Property

Public Property Get HwdbdQty() As Double
   HwdbdQty = m_HwdbdQty
End Property

Public Property Get HwdbdPrice() As Double
   HwdbdPrice = m_HwdbdPrice
End Property

Public Property Get HwdbdAmt() As Double
   HwdbdAmt = m_HwdbdAmt
End Property

Public Property Get HwdbdBz() As String
   HwdbdBz = m_HwdbdBz
End Property

Public Property Get HwdbdMioNo() As Double
   HwdbdMioNo = m_HwdbdMioNo
End Property

Public Property Get HwdbdNo() As Double
   HwdbdNo = m_HwdbdNo
End Property

Public Property Let Hwdbd_HwBmCode(vHwdbd_HwBmCode As String)
   If Trim(vHwdbd_HwBmCode) = "" Then
      Err.Raise vbObjectError + 1, , "货物编码不能为空！"
      Exit Property
   End If
   If m_Hwdbd_HwBmCode <> vHwdbd_HwBmCode Then
      If Hwbm.Requery(vHwdbd_HwBmCode) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的货物编码不存在！"
         Exit Property
      End If
      m_Hwdbd_HwBmno = Hwbm.HwBmNo
      m_Hwdbd_HwBmMc = Hwbm.HwBmMc
      m_Hwdbd_HwDwCode = Hwbm.HwBm_HwDwCode
      m_Hwdbd_HwDwNo = Hwbm.HwBm_HwDwNo
      m_Hwdbd_HwDwConv = 1
   End If
   m_Hwdbd_HwBmCode = vHwdbd_HwBmCode
End Property

Public Property Let Hwdbd_FromHwCkMc(vHwdbd_FromHwCkMc As String)
   If Trim(vHwdbd_FromHwCkMc) = "" Then
      Err.Raise vbObjectError + 1, , "来源仓库不能为空！"
      Exit Property
   End If
   If m_Hwdbd_FromHwCkMc <> vHwdbd_FromHwCkMc Then
      If FromHwck.Requery(vHwdbd_FromHwCkMc) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的来源仓库不存在！"
         Exit Property
      End If
      m_Hwdbd_FromHwCkno = FromHwck.HwCkNo
   End If
   m_Hwdbd_FromHwCkMc = vHwdbd_FromHwCkMc
End Property

Public Property Let Hwdbd_ToHwCkMc(vHwdbd_ToHwCkMc As String)
   If Trim(vHwdbd_ToHwCkMc) = "" Then
      Err.Raise vbObjectError + 1, , "目的仓库不能为空！"
      Exit Property
   End If
   If m_Hwdbd_ToHwCkMc <> vHwdbd_ToHwCkMc Then
      If ToHwck.Requery(vHwdbd_ToHwCkMc) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的目的仓库不存在！"
         Exit Property
      End If
      m_Hwdbd_ToHwCkno = ToHwck.HwCkNo
   End If
   m_Hwdbd_ToHwCkMc = vHwdbd_ToHwCkMc
End Property

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

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

Public Property Let HwdbdQty(vHwdbdQty As Double)
   If vHwdbdQty <= 0 Then
      Err.Raise vbObjectError + 1, , "数量必须大于零！"
      Exit Property
   End If
   m_HwdbdQty = vHwdbdQty
   m_HwdbdAmt = Val(Format(vHwdbdQty * m_HwdbdPrice, "##"))
End Property

Public Property Let HwdbdPrice(vHwdbdPrice As Double)
   If vHwdbdPrice < 0 Then
      Err.Raise vbObjectError + 1, , "单价不能小于零！"
      Exit Property
   End If
   m_HwdbdPrice = vHwdbdPrice
   m_HwdbdAmt = Val(Format(vHwdbdPrice * m_HwdbdQty, "##"))
End Property

Public Property Let HwdbdAmt(vHwdbdAmt As Double)
   If vHwdbdAmt < 0 Then
      Err.Raise vbObjectError + 1, , "采购金额不能小于零！"
      Exit Property
   End If
   m_HwdbdAmt = vHwdbdAmt
End Property

Public Property Let HwdbdBz(vHwdbdDBz As String)
   m_HwdbdBz = vHwdbdDBz
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_HwdbdId = -1 Then
      Cmd.CommandText = gPublicFunction.GetCallSPString("HwdbdREC_INSERT", 12)
      Cmd(0) = m_Hwdbdh.HwdbdhNo
      Cmd(1) = m_Hwdbd_HwBmno
      Cmd(2) = m_Hwdbd_HwDwNo
      Cmd(3) = m_Hwdbd_HwDwConv
      Cmd(4) = m_Hwdbd_FromHwCkno
      Cmd(5) = m_Hwdbd_ToHwCkno
      Cmd(6) = m_HwdbdQty
      Cmd(7) = m_HwdbdPrice
      Cmd(8) = m_HwdbdAmt
      Cmd(9) = m_HwdbdBz
      Cmd(10).Direction = adParamOutput 'HwdbdMiono
      Cmd(11).Direction = adParamOutput    'HwdbdNo
   Else
      Cmd.CommandText = gPublicFunction.GetCallSPString("HwdbdREC_UPDATE", 10)
      Cmd(0) = m_HwdbdNo
      Cmd(1) = m_Hwdbd_HwBmno
      Cmd(2) = m_Hwdbd_HwDwNo
      Cmd(3) = m_Hwdbd_HwDwConv
      Cmd(4) = m_Hwdbd_FromHwCkno
      Cmd(5) = m_Hwdbd_ToHwCkno
      Cmd(6) = m_HwdbdQty
      Cmd(7) = m_HwdbdPrice
      Cmd(8) = m_HwdbdAmt
      Cmd(9) = m_HwdbdBz
   End If
   
   Cmd.Execute
   
   If m_HwdbdId = -1 Then
      m_HwdbdMioNo = Cmd(10)
      m_HwdbdNo = Cmd(11)
      m_HwdbdId = 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
   
   gPublicFunction.CheckCanBeDelete "HWDBDREC", "HWDBDNO", CStr(m_HwdbdNo)
   
On Error GoTo Errorhandle

   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
      
   Cmd.CommandText = "{CALL HwdbdREC_DELETE(?)}"
   Cmd(0) = m_HwdbdNo
   
   gDbCommon.Conn.BeginTrans
   Cmd.Execute
   If Hwdbdh.Hwdbds.Count = 1 Then
      Hwdbdh.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(vHwdbdNo As Double) As Integer
   Dim mRs As DbRs
   Dim mSqlStr As String
On Error GoTo Errorhandle
   Requery = -1
   
   Set mRs = New DbRs
   
   mSqlStr = "SELECT Hwdbd_HwdbdHNO,Hwdbd_HwBmCode=COALESCE((SELECT HwBmCode FROM HWBMREC WHERE HWBMNO=Hwdbd_HWBMNO),''),Hwdbd_HwBmMc=COALESCE((SELECT HwBmMc FROM HWBMREC WHERE HWBMNO=Hwdbd_HWBMNO),''),Hwdbd_HWBMNO,"
   mSqlStr = mSqlStr & "Hwdbd_FromHwCkMc=COALESCE((SELECT HwCkMc FROM HWCKREC WHERE HWCKNO=Hwdbd_FromHwCkNO),''),Hwdbd_FromHwCkNO,"
   mSqlStr = mSqlStr & "Hwdbd_ToHwCkMc=COALESCE((SELECT HwCkMc FROM HWCKREC WHERE HWCKNO=Hwdbd_ToHwCkNO),''),Hwdbd_ToHwCkNO,"
   mSqlStr = mSqlStr & "Hwdbd_HwDwCode=COALESCE((SELECT HWDWCode FROM HWDWREC WHERE HWDWNO=Hwdbd_HWDWNO),''),Hwdbd_HWDWNO,Hwdbd_HWDWCONV,"
   mSqlStr = mSqlStr & "HwdbdQTY,HwdbdPRICE,HwdbdAMT,HwdbdBZ,HwdbdMIONO,HwdbdNO FROM HwdbdREC WHERE HwdbdNO=" & CStr(vHwdbdNo)
   
   mRs.Fillbydb mSqlStr
   
   If Not mRs.EOF Then
      BatchLet mRs!Hwdbd_Hwdbdhno, mRs!Hwdbd_HwBmCode, mRs!Hwdbd_HwBmMc, mRs!Hwdbd_HwBmno, _
               mRs!Hwdbd_FromHwCkMc, mRs!Hwdbd_FromHwCkno, mRs!Hwdbd_ToHwCkMc, mRs!Hwdbd_ToHwCkno, mRs!Hwdbd_HwDwCode, mRs!Hwdbd_HwDwno, mRs!Hwdbd_HwDwConv, _
               mRs!HwdbdQty, mRs!HwdbdPrice, mRs!HwdbdAmt, _
               mRs!HwdbdBz, mRs!HwdbdMioNo, mRs!HwdbdNo
   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_Hwdbd_Hwdbdhno = Properties(0)
   m_Hwdbd_HwBmCode = Properties(1)
   m_Hwdbd_HwBmMc = Properties(2)
   m_Hwdbd_HwBmno = Properties(3)
   m_Hwdbd_FromHwCkMc = Properties(4)
   m_Hwdbd_FromHwCkno = Properties(5)
   m_Hwdbd_ToHwCkMc = Properties(6)
   m_Hwdbd_ToHwCkno = Properties(7)
   m_Hwdbd_HwDwCode = Properties(8)
   m_Hwdbd_HwDwNo = Properties(9)
   m_Hwdbd_HwDwConv = Properties(10)
   m_HwdbdQty = Properties(11)
   m_HwdbdPrice = Properties(12)
   m_HwdbdAmt = Properties(13)
   m_HwdbdBz = Properties(14)
   m_HwdbdMioNo = Properties(15)
   m_HwdbdNo = Properties(16)

   m_HwdbdId = 1

End Sub