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

Dim m_HwBfdh As HwBfdh

Dim m_Hwbm As Hwbm
Dim m_HwDw As HwDw

Dim m_HwBfd_HwBfdhno As Double

Dim m_HwBfd_HwBmCode As String
Dim m_HwBfd_HwBmMc As String
Dim m_HwBfd_HwBmno As Double

Dim m_HwBfd_HwDwCode As String
Dim m_HwBfd_HwDwNo As Double
Dim m_HwBfd_HwDwConv As Double

Dim m_HwBfdQty As Double
Dim m_HwBfdPrice As Double
Dim m_HwBfdAmt As Double

Dim m_HwBfdBz As String

Dim m_HwBfdMioNo As Double
Dim m_HwBfdNo As Double

Dim m_HwBfdId As Integer
Dim m_HwBfdKey As Double

Private Sub Class_Initialize()
   m_HwBfdId = -1
End Sub

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

Public Property Get HwBfdId() As Integer
   HwBfdId = m_HwBfdId
End Property

Public Property Let HwBfdId(vHwBfdId As Integer)
   m_HwBfdId = vHwBfdId
End Property

Public Property Get HwBfdKey() As Double
   HwBfdKey = m_HwBfdKey
End Property

Public Property Let HwBfdKey(vHwBfdKey As Double)
   m_HwBfdKey = vHwBfdKey
End Property

Public Property Get HwBfdh() As HwBfdh
   If m_HwBfdh Is Nothing Then
      Set m_HwBfdh = New HwBfdh
      m_HwBfdh.Requery "", m_HwBfd_HwBfdhno
   End If
   Set HwBfdh = m_HwBfdh
End Property

Public Property Set HwBfdh(vHwBfdh As HwBfdh)
   Set m_HwBfdh = vHwBfdh
End Property

Public Property Get Hwbm() As Hwbm
   If m_Hwbm Is Nothing Then
      Set m_Hwbm = New Hwbm
      If m_HwBfd_HwBmCode <> "" Then
         m_Hwbm.Requery m_HwBfd_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_HwBfd_HwDwCode <> "" Then
         m_HwDw.Requery m_HwBfd_HwDwCode
      End If
   End If
   Set HwDw = m_HwDw
End Property

Public Property Get HwBfd_HwBfdhno() As Double
   HwBfd_HwBfdhno = m_HwBfd_HwBfdhno
End Property

Public Property Get HwBfd_HwBmCode() As String
   HwBfd_HwBmCode = m_HwBfd_HwBmCode
End Property

Public Property Get HwBfd_HwBmMc() As String
   HwBfd_HwBmMc = m_HwBfd_HwBmMc
End Property

Public Property Get HwBfd_HwBmno() As Double
   HwBfd_HwBmno = m_HwBfd_HwBmno
End Property

Public Property Get HwBfd_HwDwCode() As String
   HwBfd_HwDwCode = m_HwBfd_HwDwCode
End Property

Public Property Get HwBfd_HwDwno() As Double
   HwBfd_HwDwno = m_HwBfd_HwDwNo
End Property

Public Property Get HwBfd_HwDwConv() As Double
   HwBfd_HwDwConv = m_HwBfd_HwDwConv
End Property

Public Property Get HwBfdQty() As Double
   HwBfdQty = m_HwBfdQty
End Property

Public Property Get HwBfdPrice() As Double
   HwBfdPrice = m_HwBfdPrice
End Property

Public Property Get HwBfdAmt() As Double
   HwBfdAmt = m_HwBfdAmt
End Property

Public Property Get HwBfdBz() As String
   HwBfdBz = m_HwBfdBz
End Property

Public Property Get HwBfdMioNo() As Double
   HwBfdMioNo = m_HwBfdMioNo
End Property

Public Property Get HwBfdNo() As Double
   HwBfdNo = m_HwBfdNo
End Property

Public Property Let HwBfd_HwBmCode(vHwBfd_HwBmCode As String)
   If Trim(vHwBfd_HwBmCode) = "" Then
      Err.Raise vbObjectError + 1, , "货物编码不能为空！"
      Exit Property
   End If
   
   If m_HwBfdh.HwBfdh_HwCkMc = "" Then
      Err.Raise vbObjectError + 1, , "仓库不能为空！"
      Exit Property
   End If
   
   If m_HwBfd_HwBmCode <> vHwBfd_HwBmCode Then
      If Hwbm.Requery(vHwBfd_HwBmCode) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的货物编码不存在！"
         Exit Property
      End If
      m_HwBfd_HwBmno = Hwbm.HwBmNo
      m_HwBfd_HwBmMc = Hwbm.HwBmMc
      m_HwBfd_HwDwCode = Hwbm.HwBm_HwDwCode
      m_HwBfd_HwDwNo = Hwbm.HwBm_HwDwNo
      m_HwBfd_HwDwConv = 1
      
   End If
   
   m_HwBfd_HwBmCode = vHwBfd_HwBmCode
   
End Property

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

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

Public Property Let HwBfdQty(vHwBfdQty As Double)
   If vHwBfdQty <= 0 Then
      Err.Raise vbObjectError + 1, , "数量不能小于等于零！"
      Exit Property
   End If
   m_HwBfdQty = vHwBfdQty
   m_HwBfdAmt = Val(Format(vHwBfdQty * m_HwBfdPrice, "##"))
End Property

Public Property Let HwBfdPrice(vHwBfdPrice As Double)
   If vHwBfdPrice < 0 Then
      Err.Raise vbObjectError + 1, , "单价不能小于零！"
      Exit Property
   End If
   m_HwBfdPrice = vHwBfdPrice
   m_HwBfdAmt = Val(Format(vHwBfdPrice * m_HwBfdQty, "##"))
End Property

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

Public Property Let HwBfdBz(vHwBfdDBz As String)
   m_HwBfdBz = vHwBfdDBz
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_HwBfdId = -1 Then
      Cmd.CommandText = gPublicFunction.GetCallSPString("HwBfdREC_INSERT", 10)
      Cmd(0) = m_HwBfdh.HwBfdhNo
      Cmd(1) = m_HwBfd_HwBmno
      Cmd(2) = m_HwBfd_HwDwNo
      Cmd(3) = m_HwBfd_HwDwConv
      Cmd(4) = m_HwBfdQty
      Cmd(5) = m_HwBfdPrice
      Cmd(6) = m_HwBfdAmt
      Cmd(7) = m_HwBfdBz
      Cmd(8).Direction = adParamOutput 'HwBfdMiono
      Cmd(9).Direction = adParamOutput      'HwBfdNo
   Else
      Cmd.CommandText = gPublicFunction.GetCallSPString("HwBfdREC_UPDATE", 8)
      Cmd(0) = m_HwBfdNo
      Cmd(1) = m_HwBfd_HwBmno
      Cmd(2) = m_HwBfd_HwDwNo
      Cmd(3) = m_HwBfd_HwDwConv
      Cmd(4) = m_HwBfdQty
      Cmd(5) = m_HwBfdPrice
      Cmd(6) = m_HwBfdAmt
      Cmd(7) = m_HwBfdBz
   End If
   
   Cmd.Execute
   
   If m_HwBfdId = -1 Then
      m_HwBfdMioNo = Cmd(8)
      m_HwBfdNo = Cmd(9)
      m_HwBfdId = 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 "HWBFDREC", "HWBFDNO", CStr(m_HwBfdNo)
   
On Error GoTo Errorhandle

   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
      
   Cmd.CommandText = "{CALL HwBfdREC_DELETE(?)}"
   Cmd(0) = m_HwBfdNo
   
   gDbCommon.Conn.BeginTrans
   Cmd.Execute
   If HwBfdh.HwBfds.Count = 1 Then
      HwBfdh.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(vHwBfdNo As Double) As Integer
   Dim mRs As DbRs
   Dim mSqlStr As String
On Error GoTo Errorhandle
   Requery = -1
   
   Set mRs = New DbRs
   
   mSqlStr = "SELECT HwBfd_HwBfdHNO,HwBfd_HwBmCode=COALESCE((SELECT HwBmCode FROM HWBMREC WHERE HWBMNO=HwBfd_HWBMNO),''),HwBfd_HwBmMc=COALESCE((SELECT HwBmMc FROM HWBMREC WHERE HWBMNO=HwBfd_HWBMNO),''),HwBfd_HWBMNO,"
   mSqlStr = mSqlStr & "HwBfd_HwDwCode=COALESCE((SELECT HWDWCode FROM HWDWREC WHERE HWDWNO=HwBfd_HWDWNO),''),HwBfd_HWDWNO,HwBfd_HWDWCONV,"
   mSqlStr = mSqlStr & "HwBfdQty,HwBfdPRICE,HwBfdAMT,HwBfdBZ,HwBfdMIONO,HwBfdNO FROM HwBfdREC WHERE HwBfdNO=" & CStr(vHwBfdNo)
   
   mRs.Fillbydb mSqlStr
   
   If Not mRs.EOF Then
      BatchLet mRs!HwBfd_HwBfdhno, mRs!HwBfd_HwBmCode, mRs!HwBfd_HwBmMc, mRs!HwBfd_HwBmno, _
               mRs!HwBfd_HwDwCode, mRs!HwBfd_HwDwno, mRs!HwBfd_HwDwConv, _
               mRs!HwBfdQty, mRs!HwBfdPrice, mRs!HwBfdAmt, _
               mRs!HwBfdBz, mRs!HwBfdMioNo, mRs!HwBfdNo
   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_HwBfd_HwBfdhno = Properties(0)
   
   m_HwBfd_HwBmCode = Properties(1)
   m_HwBfd_HwBmMc = Properties(2)
   m_HwBfd_HwBmno = Properties(3)
   
   m_HwBfd_HwDwCode = Properties(4)
   m_HwBfd_HwDwNo = Properties(5)
   m_HwBfd_HwDwConv = Properties(6)
   
   m_HwBfdQty = Properties(7)
   m_HwBfdPrice = Properties(8)
   m_HwBfdAmt = Properties(9)
   
   m_HwBfdBz = Properties(10)
   m_HwBfdMioNo = Properties(11)
   m_HwBfdNo = Properties(12)

   m_HwBfdId = 1

End Sub