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

Dim m_HwIdh As HwIdh

Dim m_Hwbm As Hwbm
Dim m_HwCk As HwCk
Dim m_HwDw As HwDw

Dim m_HwId_HwIdhno As Double

Dim m_HwId_HwBmCode As String
Dim m_HwId_HwBmMc As String
Dim m_HwId_HwBmno As Double

Dim m_HwId_HwCkMc As String
Dim m_HwId_HwCkno As Double

Dim m_HwId_HwDwCode As String
Dim m_HwId_HwDwNo As Double
Dim m_HwId_HwDwConv As Double

Dim m_HwIdQty As Double
Dim m_HwIdPrice As Double
Dim m_HwIdAmt As Double

Dim m_HwIdMiNo As Double
Dim m_HwIdMioNo As Double

Dim m_HwIdBz As String

Dim m_HwIdNo As Double

Dim m_HwIdId As Integer
Dim m_HwIdKey As Double

Private Sub Class_Initialize()
   m_HwIdId = -1
End Sub

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

Public Property Get HwIdId() As Integer
   HwIdId = m_HwIdId
End Property

Public Property Let HwIdId(vHwIdId As Integer)
   m_HwIdId = vHwIdId
End Property

Public Property Get HwIdKey() As Double
   HwIdKey = m_HwIdKey
End Property

Public Property Let HwIdKey(vHwIdKey As Double)
   m_HwIdKey = vHwIdKey
End Property

Public Property Get HwIdh() As HwIdh
   If m_HwIdh Is Nothing Then
      Set m_HwIdh = New HwIdh
      m_HwIdh.Requery "", m_HwId_HwIdhno
   End If
   Set HwIdh = m_HwIdh
End Property

Public Property Set HwIdh(vHwIdh As HwIdh)
   Set m_HwIdh = vHwIdh
End Property

Public Property Get Hwbm() As Hwbm
   If m_Hwbm Is Nothing Then
      Set m_Hwbm = New Hwbm
      If m_HwId_HwBmCode <> "" Then
         m_Hwbm.Requery m_HwId_HwBmCode
      End If
   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
      If m_HwId_HwCkMc <> "" Then
         m_HwCk.Requery m_HwId_HwCkMc
      End If
   End If
   Set HwCk = m_HwCk
End Property

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

Public Property Get HwId_HwIdhno() As Double
   HwId_HwIdhno = m_HwId_HwIdhno
End Property

Public Property Get HwId_HwBmCode() As String
   HwId_HwBmCode = m_HwId_HwBmCode
End Property

Public Property Get HwId_HwBmMc() As String
   HwId_HwBmMc = m_HwId_HwBmMc
End Property

Public Property Get HwId_HwBmno() As Double
   HwId_HwBmno = m_HwId_HwBmno
End Property

Public Property Get HwId_HwCkMc() As String
   HwId_HwCkMc = m_HwId_HwCkMc
End Property

Public Property Get HwId_HwCkno() As Double
   HwId_HwCkno = m_HwId_HwCkno
End Property

Public Property Get HwId_HwDwCode() As String
   HwId_HwDwCode = m_HwId_HwDwCode
End Property

Public Property Get HwId_HwDwno() As Double
   HwId_HwDwno = m_HwId_HwDwNo
End Property

Public Property Get HwId_HwDwConv() As Double
   HwId_HwDwConv = m_HwId_HwDwConv
End Property

Public Property Get HwIdQty() As Double
   HwIdQty = m_HwIdQty
End Property

Public Property Get HwIdPrice() As Double
   HwIdPrice = m_HwIdPrice
End Property

Public Property Get HwIdAmt() As Double
   HwIdAmt = m_HwIdAmt
End Property

Public Property Get HwIdBz() As String
   HwIdBz = m_HwIdBz
End Property

Public Property Get HwIdMiNo() As Double
   HwIdMiNo = m_HwIdMiNo
End Property

Public Property Get HwIdMioNo() As Double
   HwIdMioNo = m_HwIdMioNo
End Property

Public Property Get HwIdNo() As Double
   HwIdNo = m_HwIdNo
End Property

Public Property Let HwId_HwBmCode(vHwId_HwBmCode As String)
   If Trim(vHwId_HwBmCode) = "" Then
      Err.Raise vbObjectError + 1, , "货物编码不能为空！"
      Exit Property
   End If
   If m_HwId_HwBmCode <> vHwId_HwBmCode Then
      If Hwbm.Requery(vHwId_HwBmCode) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的货物编码不存在！"
         Exit Property
      End If
      m_HwId_HwBmno = Hwbm.HwBmNo
      m_HwId_HwBmMc = Hwbm.HwBmMc
      m_HwId_HwDwCode = Hwbm.HwBm_HwDwCode
      m_HwId_HwDwNo = Hwbm.HwBm_HwDwNo
      m_HwId_HwDwConv = 1
   End If
   m_HwId_HwBmCode = vHwId_HwBmCode
End Property

Public Property Let HwId_HwCkMc(vHwId_HwCkMc As String)
   If Trim(vHwId_HwCkMc) = "" Then
      Err.Raise vbObjectError + 1, , "仓库不能为空！"
      Exit Property
   End If
   If m_HwId_HwCkMc <> vHwId_HwCkMc Then
      If HwCk.Requery(vHwId_HwCkMc) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的仓库不存在！"
         Exit Property
      End If
      m_HwId_HwCkno = HwCk.HwCkNo
   End If
   m_HwId_HwCkMc = vHwId_HwCkMc
End Property

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

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

Public Property Let HwIdQty(vHwIdQty As Double)
   If vHwIdQty <= 0 Then
      Err.Raise vbObjectError + 1, , "数量必须大于零！"
      Exit Property
   End If
   m_HwIdQty = vHwIdQty
   m_HwIdAmt = Val(Format(vHwIdQty * m_HwIdPrice, "##"))
End Property

Public Property Let HwIdPrice(vHwIdPrice As Double)
   If vHwIdPrice < 0 Then
      Err.Raise vbObjectError + 1, , "单价不能小于零！"
      Exit Property
   End If
   m_HwIdPrice = vHwIdPrice
   m_HwIdAmt = Val(Format(vHwIdPrice * m_HwIdQty, "##"))
End Property

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

Public Property Let HwIdBz(vHwIdDBz As String)
   m_HwIdBz = vHwIdDBz
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_HwIdId = -1 Then
      Cmd.CommandText = gPublicFunction.GetCallSPString("HwIdREC_INSERT", 12)
      Cmd(0) = m_HwIdh.HwIdhNo
      Cmd(1) = m_HwId_HwBmno
      Cmd(2) = m_HwId_HwDwNo
      Cmd(3) = m_HwId_HwDwConv
      Cmd(4) = m_HwId_HwCkno
      Cmd(5) = m_HwIdQty
      Cmd(6) = m_HwIdPrice
      Cmd(7) = m_HwIdAmt
      Cmd(8) = m_HwIdBz
      Cmd(9).Direction = adParamOutput 'HwIdMino
      Cmd(10).Direction = adParamOutput 'HwIdMino
      Cmd(11).Direction = adParamOutput    'HwIdNo
   Else
      Cmd.CommandText = gPublicFunction.GetCallSPString("HwIdREC_UPDATE", 9)
      Cmd(0) = m_HwIdNo
      Cmd(1) = m_HwId_HwBmno
      Cmd(2) = m_HwId_HwDwNo
      Cmd(3) = m_HwId_HwDwConv
      Cmd(4) = m_HwId_HwCkno
      Cmd(5) = m_HwIdQty
      Cmd(6) = m_HwIdPrice
      Cmd(7) = m_HwIdAmt
      Cmd(8) = m_HwIdBz
   End If
   
   Cmd.Execute
   
   If m_HwIdId = -1 Then
      m_HwIdMiNo = Cmd(9)
      m_HwIdMioNo = Cmd(10)
      m_HwIdNo = Cmd(11)
      m_HwIdId = 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 "HWIDREC", "HWIDNO", CStr(m_HwIdNo)
   
On Error GoTo Errorhandle

   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
      
   Cmd.CommandText = "{CALL HwIdREC_DELETE(?)}"
   Cmd(0) = m_HwIdNo
   
   gDbCommon.Conn.BeginTrans
   Cmd.Execute
   If HwIdh.HwIds.Count = 1 Then
      HwIdh.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(vHwIdNo As Double) As Integer
   Dim mRs As DbRs
   Dim mSqlStr As String
On Error GoTo Errorhandle
   Requery = -1
   
   Set mRs = New DbRs
   
   mSqlStr = "SELECT HwId_HwIdHNO,HwId_HwBmCode=COALESCE((SELECT HwBmCode FROM HWBMREC WHERE HWBMNO=HwId_HWBMNO),''),HwId_HwBmMc=COALESCE((SELECT HwBmMc FROM HWBMREC WHERE HWBMNO=HwId_HWBMNO),''),HwId_HWBMNO,"
   mSqlStr = mSqlStr & "HwId_HwCkMc=COALESCE((SELECT HwCkMc FROM HWCKREC WHERE HWCKNO=HwId_HWCKNO),''),HwId_HWCKNO,"
   mSqlStr = mSqlStr & "HwId_HwDwCode=COALESCE((SELECT HWDWCode FROM HWDWREC WHERE HWDWNO=HwId_HWDWNO),''),HwId_HWDWNO,HwId_HWDWCONV,"
   mSqlStr = mSqlStr & "HwIdQTY,HwIdPRICE,HwIdAMT,HwIdBZ,HwIdMINO,HwIdMIONO,HwIdNO FROM HwIdREC WHERE HwIdNO=" & CStr(vHwIdNo)
   
   mRs.Fillbydb mSqlStr
   
   If Not mRs.EOF Then
      BatchLet mRs!HwId_HwIdhno, mRs!HwId_HwBmCode, mRs!HwId_HwBmMc, mRs!HwId_HwBmno, _
               mRs!HwId_HwCkMc, mRs!HwId_HwCkno, mRs!HwId_HwDwCode, mRs!HwId_HwDwno, mRs!HwId_HwDwConv, _
               mRs!HwIdQty, mRs!HwIdPrice, mRs!HwIdAmt, _
               mRs!HwIdBz, mRs!HwIdMiNo, mRs!HwIdMioNo, mRs!HwIdNo
   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_HwId_HwIdhno = Properties(0)
   m_HwId_HwBmCode = Properties(1)
   m_HwId_HwBmMc = Properties(2)
   m_HwId_HwBmno = Properties(3)
   m_HwId_HwCkMc = Properties(4)
   m_HwId_HwCkno = Properties(5)
   m_HwId_HwDwCode = Properties(6)
   m_HwId_HwDwNo = Properties(7)
   m_HwId_HwDwConv = Properties(8)
   m_HwIdQty = Properties(9)
   m_HwIdPrice = Properties(10)
   m_HwIdAmt = Properties(11)
   m_HwIdBz = Properties(12)
   m_HwIdMiNo = Properties(13)
   m_HwIdMioNo = Properties(14)
   m_HwIdNo = Properties(15)

   m_HwIdId = 1

End Sub