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

Dim m_HwPddh As HwPddh

Dim m_Hwbm As Hwbm
Dim m_HwDw As HwDw

Dim m_HwPdd_HwPddhno As Double

Dim m_HwPdd_HwBmCode As String
Dim m_HwPdd_HwBmMc As String
Dim m_HwPdd_HwBmno As Double

Dim m_HwPdd_HwDwCode As String
Dim m_HwPdd_HwDwNo As Double
Dim m_HwPdd_HwDwConv As Double

Dim m_HwPddZQty As Double

Dim m_HwPddPQty As Double
Dim m_HwPddPrice As Double
Dim m_HwPddAmt As Double

Dim m_HwPddBz As String

Dim m_HwPddMioNo As Double
Dim m_HwPddNo As Double

Dim m_HwPddId As Integer
Dim m_HwPddKey As Double

Private Sub Class_Initialize()
   m_HwPddId = -1
End Sub

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

Public Property Get HwPddId() As Integer
   HwPddId = m_HwPddId
End Property

Public Property Let HwPddId(vHwPddId As Integer)
   m_HwPddId = vHwPddId
End Property

Public Property Get HwPddKey() As Double
   HwPddKey = m_HwPddKey
End Property

Public Property Let HwPddKey(vHwPddKey As Double)
   m_HwPddKey = vHwPddKey
End Property

Public Property Get HwPddh() As HwPddh
   If m_HwPddh Is Nothing Then
      Set m_HwPddh = New HwPddh
      m_HwPddh.Requery "", m_HwPdd_HwPddhno
   End If
   Set HwPddh = m_HwPddh
End Property

Public Property Set HwPddh(vHwPddh As HwPddh)
   Set m_HwPddh = vHwPddh
End Property

Public Property Get Hwbm() As Hwbm
   If m_Hwbm Is Nothing Then
      Set m_Hwbm = New Hwbm
      If m_HwPdd_HwBmCode <> "" Then
         m_Hwbm.Requery m_HwPdd_HwBmCode
      End If
   End If
   Set Hwbm = m_Hwbm
End Property

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

Public Property Get HwPdd_HwPddhno() As Double
   HwPdd_HwPddhno = m_HwPdd_HwPddhno
End Property

Public Property Get HwPdd_HwBmCode() As String
   HwPdd_HwBmCode = m_HwPdd_HwBmCode
End Property

Public Property Get HwPdd_HwBmMc() As String
   HwPdd_HwBmMc = m_HwPdd_HwBmMc
End Property

Public Property Get HwPdd_HwBmno() As Double
   HwPdd_HwBmno = m_HwPdd_HwBmno
End Property

Public Property Get HwPdd_HwDwCode() As String
   HwPdd_HwDwCode = m_HwPdd_HwDwCode
End Property

Public Property Get HwPdd_HwDwno() As Double
   HwPdd_HwDwno = m_HwPdd_HwDwNo
End Property

Public Property Get HwPdd_HwDwConv() As Double
   HwPdd_HwDwConv = m_HwPdd_HwDwConv
End Property

Public Property Get HwPddZQty() As Double
   HwPddZQty = m_HwPddZQty
End Property

Public Property Get HwPddPQty() As Double
   HwPddPQty = m_HwPddPQty
End Property

Public Property Get HwPddPrice() As Double
   HwPddPrice = m_HwPddPrice
End Property

Public Property Get HwPddAmt() As Double
   HwPddAmt = m_HwPddAmt
End Property

Public Property Get HwPddBz() As String
   HwPddBz = m_HwPddBz
End Property

Public Property Get HwPddMioNo() As Double
   HwPddMioNo = m_HwPddMioNo
End Property

Public Property Get HwPddNo() As Double
   HwPddNo = m_HwPddNo
End Property

Public Property Let HwPdd_HwBmCode(vHwPdd_HwBmCode As String)
   If Trim(vHwPdd_HwBmCode) = "" Then
      Err.Raise vbObjectError + 1, , "货物编码不能为空！"
      Exit Property
   End If
   
   If m_HwPddh.HwPddh_HwCkMc = "" Then
      Err.Raise vbObjectError + 1, , "仓库不能为空！"
      Exit Property
   End If
   
   If m_HwPdd_HwBmCode <> vHwPdd_HwBmCode Then
      If Hwbm.Requery(vHwPdd_HwBmCode) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的货物编码不存在！"
         Exit Property
      End If
      m_HwPdd_HwBmno = Hwbm.HwBmNo
      m_HwPdd_HwBmMc = Hwbm.HwBmMc
      m_HwPdd_HwDwCode = Hwbm.HwBm_HwDwCode
      m_HwPdd_HwDwNo = Hwbm.HwBm_HwDwNo
      m_HwPdd_HwDwConv = 1
      
      m_HwPddZQty = gPublicFunction.GetFieldValue("HWJCNOWQTY", "SELECT HWJCNOWQTY=COALESCE((SELECT HWJCNOWQTY FROM HWJCREC WHERE HWJC_HWCKNO=" & CStr(m_HwPddh.HwPddh_HwCkno) & " AND HWJC_HWBMNO=" & CStr(m_HwPdd_HwBmno) & "),0)")
      
   End If
   
   m_HwPdd_HwBmCode = vHwPdd_HwBmCode
   
End Property

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

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

Public Property Let HwPddPQty(vHwPddPQty As Double)
   If vHwPddPQty < 0 Then
      Err.Raise vbObjectError + 1, , "数量不能小于零！"
      Exit Property
   End If
   m_HwPddPQty = vHwPddPQty
   m_HwPddAmt = Val(Format(vHwPddPQty * m_HwPddPrice, "##"))
End Property

Public Property Let HwPddPrice(vHwPddPrice As Double)
   If vHwPddPrice < 0 Then
      Err.Raise vbObjectError + 1, , "单价不能小于零！"
      Exit Property
   End If
   m_HwPddPrice = vHwPddPrice
   m_HwPddAmt = Val(Format(vHwPddPrice * m_HwPddPQty, "##"))
End Property

Public Property Let HwPddAmt(vHwPddAmt As Double)
   If vHwPddAmt < 0 Then
      Err.Raise vbObjectError + 1, , "金额不能小于零！"
      Exit Property
   End If
   m_HwPddAmt = vHwPddAmt
End Property

Public Property Let HwPddBz(vHwPddDBz As String)
   m_HwPddBz = vHwPddDBz
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_HwPddId = -1 Then
      Cmd.CommandText = gPublicFunction.GetCallSPString("HwPddREC_INSERT", 11)
      Cmd(0) = m_HwPddh.HwPddhNo
      Cmd(1) = m_HwPdd_HwBmno
      Cmd(2) = m_HwPdd_HwDwNo
      Cmd(3) = m_HwPdd_HwDwConv
      Cmd(4) = m_HwPddZQty
      Cmd(5) = m_HwPddPQty
      Cmd(6) = m_HwPddPrice
      Cmd(7) = m_HwPddAmt
      Cmd(8) = m_HwPddBz
      Cmd(9).Direction = adParamOutput 'HwPddMiono
      Cmd(10).Direction = adParamOutput     'HwPddNo
   Else
      Cmd.CommandText = gPublicFunction.GetCallSPString("HwPddREC_UPDATE", 9)
      Cmd(0) = m_HwPddNo
      Cmd(1) = m_HwPdd_HwBmno
      Cmd(2) = m_HwPdd_HwDwNo
      Cmd(3) = m_HwPdd_HwDwConv
      Cmd(4) = m_HwPddZQty
      Cmd(5) = m_HwPddPQty
      Cmd(6) = m_HwPddPrice
      Cmd(7) = m_HwPddAmt
      Cmd(8) = m_HwPddBz
   End If
   
   Cmd.Execute
   
   If m_HwPddId = -1 Then
      m_HwPddMioNo = Cmd(9)
      m_HwPddNo = Cmd(10)
      m_HwPddId = 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 "HWPDDREC", "HWPDDNO", CStr(m_HwPddNo)
   
On Error GoTo Errorhandle

   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
      
   Cmd.CommandText = "{CALL HwPddREC_DELETE(?)}"
   Cmd(0) = m_HwPddNo
   
   gDbCommon.Conn.BeginTrans
   Cmd.Execute
   If HwPddh.HwPdds.Count = 1 Then
      HwPddh.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(vHwPddNo As Double) As Integer
   Dim mRs As DbRs
   Dim mSqlStr As String
On Error GoTo Errorhandle
   Requery = -1
   
   Set mRs = New DbRs
   
   mSqlStr = "SELECT HwPdd_HwPddHNO,HwPdd_HwBmCode=COALESCE((SELECT HwBmCode FROM HWBMREC WHERE HWBMNO=HwPdd_HWBMNO),''),HwPdd_HwBmMc=COALESCE((SELECT HwBmMc FROM HWBMREC WHERE HWBMNO=HwPdd_HWBMNO),''),HwPdd_HWBMNO,"
   mSqlStr = mSqlStr & "HwPdd_HwDwCode=COALESCE((SELECT HWDWCode FROM HWDWREC WHERE HWDWNO=HwPdd_HWDWNO),''),HwPdd_HWDWNO,HwPdd_HWDWCONV,"
   mSqlStr = mSqlStr & "HwPddZQty,HwPddPQty,HwPddPRICE,HwPddAMT,HwPddBZ,HwPddMIONO,HwPddNO FROM HwPddREC WHERE HwPddNO=" & CStr(vHwPddNo)
   
   mRs.Fillbydb mSqlStr
   
   If Not mRs.EOF Then
      BatchLet mRs!HwPdd_HwPddhno, mRs!HwPdd_HwBmCode, mRs!HwPdd_HwBmMc, mRs!HwPdd_HwBmno, _
               mRs!HwPdd_HwDwCode, mRs!HwPdd_HwDwno, mRs!HwPdd_HwDwConv, _
               mRs!HwPddZQty, mRs!HwPddPQty, mRs!HwPddPrice, mRs!HwPddAmt, _
               mRs!HwPddBz, mRs!HwPddMioNo, mRs!HwPddNo
   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_HwPdd_HwPddhno = Properties(0)
   m_HwPdd_HwBmCode = Properties(1)
   m_HwPdd_HwBmMc = Properties(2)
   m_HwPdd_HwBmno = Properties(3)
   m_HwPdd_HwDwCode = Properties(4)
   m_HwPdd_HwDwNo = Properties(5)
   m_HwPdd_HwDwConv = Properties(6)
   m_HwPddZQty = Properties(7)
   m_HwPddPQty = Properties(8)
   m_HwPddPrice = Properties(9)
   m_HwPddAmt = Properties(10)
   m_HwPddBz = Properties(11)
   m_HwPddMioNo = Properties(12)
   m_HwPddNo = Properties(13)

   m_HwPddId = 1

End Sub