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

Dim m_Arivdh As Arivdh
Dim m_Arivrs As Arivrs

Dim m_Hwbm As Hwbm
Dim m_HwDw As HwDw
Dim m_CwSm As CwSm

Dim m_Arivd_Arivdhno As Double

Dim m_Arivd_HwBmCode As String
Dim m_Arivd_HwBmMc As String
Dim m_Arivd_HwBmno As Double

Dim m_Arivd_HwDwCode As String
Dim m_Arivd_HwDwNo As Double
Dim m_Arivd_HwDwConv As Double

Dim m_ArivdQty As Double
Dim m_ArivdPrice As Double
Dim m_ArivdAmt As Double

Dim m_ArivdNtAmt As Double
Dim m_ArivdTAmt As Double

Dim m_Arivd_CwSmCode As String
Dim m_Arivd_CwSmNo As Double
Dim m_Arivd_CwSmConv As Double

Dim m_ArivdBz As String

Dim m_ArivdNo As Double

Dim m_ArivdId As Integer
Dim m_ArivdKey As Double

Private Sub Class_Initialize()
   m_ArivdId = -1
End Sub

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

Public Property Get ArivdId() As Integer
   ArivdId = m_ArivdId
End Property

Public Property Let ArivdId(vArivdId As Integer)
   m_ArivdId = vArivdId
End Property

Public Property Get ArivdKey() As Double
   ArivdKey = m_ArivdKey
End Property

Public Property Let ArivdKey(vArivdKey As Double)
   m_ArivdKey = vArivdKey
End Property

Public Property Get Arivdh() As Arivdh
   If m_Arivdh Is Nothing Then
      Set m_Arivdh = New Arivdh
      m_Arivdh.Requery "", m_Arivd_Arivdhno
   End If
   Set Arivdh = m_Arivdh
End Property

Public Property Set Arivdh(vArivdh As Arivdh)
   Set m_Arivdh = vArivdh
End Property

Public Property Get Arivrs() As Arivrs
   If m_Arivrs Is Nothing Then
      Set m_Arivrs = New Arivrs
      If m_ArivdNo <> 0 Then
         m_Arivrs.Fillbydb Me
      End If
   End If
   Set Arivrs = m_Arivrs
End Property

Public Property Get Hwbm() As Hwbm
   If m_Hwbm Is Nothing Then
      Set m_Hwbm = New Hwbm
      If m_Arivd_HwBmCode <> "" Then
         m_Hwbm.Requery m_Arivd_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_Arivd_HwDwCode <> "" Then
         m_HwDw.Requery m_Arivd_HwDwCode
      End If
   End If
   Set HwDw = m_HwDw
End Property

Public Property Get CwSm() As CwSm
   If m_CwSm Is Nothing Then
      Set m_CwSm = New CwSm
      If m_Arivd_CwSmCode <> "" Then
         m_CwSm.Requery m_Arivd_CwSmCode
      End If
   End If
   Set CwSm = m_CwSm
End Property

Public Property Get Arivd_Arivdhno() As Double
   Arivd_Arivdhno = m_Arivd_Arivdhno
End Property

Public Property Get Arivd_HwBmCode() As String
   Arivd_HwBmCode = m_Arivd_HwBmCode
End Property

Public Property Get Arivd_HwBmMc() As String
   Arivd_HwBmMc = m_Arivd_HwBmMc
End Property

Public Property Get Arivd_HwBmno() As Double
   Arivd_HwBmno = m_Arivd_HwBmno
End Property

Public Property Get Arivd_HwDwCode() As String
   Arivd_HwDwCode = m_Arivd_HwDwCode
End Property

Public Property Get Arivd_HwDwno() As Double
   Arivd_HwDwno = m_Arivd_HwDwNo
End Property

Public Property Get Arivd_HwDwConv() As Double
   Arivd_HwDwConv = m_Arivd_HwDwConv
End Property

Public Property Get ArivdQty() As Double
   ArivdQty = m_ArivdQty
End Property

Public Property Get ArivdPrice() As Double
   ArivdPrice = m_ArivdPrice
End Property

Public Property Get ArivdAmt() As Double
   ArivdAmt = m_ArivdAmt
End Property

Public Property Get ArivdNtAmt() As Double
   ArivdNtAmt = m_ArivdNtAmt
End Property

Public Property Get ArivdTAmt() As Double
   ArivdTAmt = m_ArivdTAmt
End Property

Public Property Get Arivd_CwSmCode() As String
   Arivd_CwSmCode = m_Arivd_CwSmCode
End Property

Public Property Get Arivd_CwSmno() As Double
   Arivd_CwSmno = m_Arivd_CwSmNo
End Property

Public Property Get Arivd_CwsmConv() As Double
   Arivd_CwsmConv = m_Arivd_CwSmConv
End Property

Public Property Get ArivdBz() As String
   ArivdBz = m_ArivdBz
End Property

Public Property Get ArivdNo() As Double
   ArivdNo = m_ArivdNo
End Property

Public Property Let Arivd_HwBmCode(vArivd_HwBmCode As String)
   If Trim(vArivd_HwBmCode) = "" Then
      Err.Raise vbObjectError + 1, , "货物编码不能为空！"
      Exit Property
   End If
   If m_Arivd_HwBmCode <> vArivd_HwBmCode Then
      If Hwbm.Requery(vArivd_HwBmCode) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的货物编码不存在！"
         Exit Property
      End If
      m_Arivd_HwBmno = Hwbm.HwBmNo
      m_Arivd_HwBmMc = Hwbm.HwBmMc
      m_Arivd_HwDwCode = Hwbm.HwBm_HwDwCode
      m_Arivd_HwDwNo = Hwbm.HwBm_HwDwNo
      m_Arivd_HwDwConv = 1
   End If
   m_Arivd_HwBmCode = vArivd_HwBmCode
End Property

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

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

Public Property Let ArivdQty(vArivdQty As Double)
   If vArivdQty < 0 Then
      Err.Raise vbObjectError + 1, , "数量不能小于零！"
      Exit Property
   End If
   m_ArivdNtAmt = Val(Format(vArivdQty * m_ArivdPrice, "##"))
   m_ArivdTAmt = Val(Format(m_ArivdNtAmt * m_Arivd_CwSmConv, "##"))
   m_ArivdAmt = Val(Format(m_ArivdNtAmt + m_ArivdTAmt, "##"))
   m_ArivdQty = vArivdQty
End Property

Public Property Let ArivdPrice(vArivdPrice As Double)
   If vArivdPrice < 0 Then
      Err.Raise vbObjectError + 1, , "单价不能小于零！"
      Exit Property
   End If
   m_ArivdNtAmt = Val(Format(m_ArivdQty * vArivdPrice, "##"))
   m_ArivdTAmt = Val(Format(m_ArivdNtAmt * m_Arivd_CwSmConv, "##"))
   m_ArivdAmt = Val(Format(m_ArivdNtAmt + m_ArivdTAmt, "##"))
   m_ArivdPrice = vArivdPrice
End Property

Public Property Let ArivdNtAmt(vArivdNtAmt As Double)
   If vArivdNtAmt < 0 Then
      Err.Raise vbObjectError + 1, , "不含税金额不能小于零！"
      Exit Property
   End If
   m_ArivdTAmt = Val(Format(vArivdNtAmt * m_Arivd_CwSmConv, "##"))
   m_ArivdAmt = Val(Format(vArivdNtAmt + m_ArivdTAmt, "##"))
   If m_ArivdQty <> 0 Then
      m_ArivdPrice = Val(Format(vArivdNtAmt / m_ArivdQty, "########"))
   End If
   m_ArivdNtAmt = vArivdNtAmt
End Property

Public Property Let ArivdAmt(vArivdAmt As Double)
   If vArivdAmt < 0 Then
      Err.Raise vbObjectError + 1, , "总金额不能小于零！"
      Exit Property
   End If
   m_ArivdNtAmt = Val(Format(vArivdAmt / (1 + m_Arivd_CwSmConv), "##"))
   m_ArivdTAmt = Val(Format(vArivdAmt - m_ArivdNtAmt, "##"))
   If m_ArivdQty <> 0 Then
      m_ArivdPrice = Val(Format(m_ArivdNtAmt / m_ArivdQty, "########"))
   End If
   m_ArivdAmt = vArivdAmt
End Property

Public Property Let Arivd_CwSmCode(vArivd_CwSmCode As String)

   If Trim(vArivd_CwSmCode) = "" Then
      Err.Raise vbObjectError + 1, , "税码不能为空！"
      Exit Property
   End If
   
   If m_Arivd_CwSmCode <> vArivd_CwSmCode Then
      If CwSm.Requery(vArivd_CwSmCode) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的税码不存在！"
         Exit Property
      End If
      
      m_ArivdTAmt = Val(Format(m_ArivdNtAmt * CwSm.CwsmSl, "##"))
      m_ArivdAmt = Val(Format(m_ArivdNtAmt + m_ArivdTAmt, "##"))
      If m_ArivdQty <> 0 Then
         m_ArivdPrice = Val(Format(m_ArivdNtAmt / m_ArivdQty, "########"))
      End If
      
      m_Arivd_CwSmConv = CwSm.CwsmSl
      m_Arivd_CwSmNo = CwSm.CwsmNo
      
   End If
   
   m_Arivd_CwSmCode = vArivd_CwSmCode
   
End Property

Public Property Let ArivdBz(vArivdDBz As String)
   m_ArivdBz = vArivdDBz
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_ArivdId = -1 Then
   
      Cmd.CommandText = gPublicFunction.GetCallSPString("ArivdREC_INSERT", 13)
      Cmd(0) = m_Arivdh.ArivdhNo
      Cmd(1) = m_Arivd_HwBmno
      Cmd(2) = m_Arivd_HwDwNo
      Cmd(3) = m_Arivd_HwDwConv
      Cmd(4) = m_ArivdQty
      Cmd(5) = m_ArivdPrice
      Cmd(6) = m_ArivdNtAmt
      Cmd(7) = m_ArivdTAmt
      Cmd(8) = m_ArivdAmt
      Cmd(9) = m_Arivd_CwSmNo
      Cmd(10) = m_Arivd_CwSmConv
      Cmd(11) = m_ArivdBz
      Cmd(12).Direction = adParamOutput   'ArivdNo
            
      Cmd.Execute
            
      m_ArivdNo = Cmd(12)
      Arivrs.Save
      m_ArivdId = 1
      
      
   Else
      Cmd.CommandText = gPublicFunction.GetCallSPString("ArivdREC_UPDATE", 12)
      Cmd(0) = m_ArivdNo
      Cmd(1) = m_Arivd_HwBmno
      Cmd(2) = m_Arivd_HwDwNo
      Cmd(3) = m_Arivd_HwDwConv
      Cmd(4) = m_ArivdQty
      Cmd(5) = m_ArivdPrice
      Cmd(6) = m_ArivdNtAmt
      Cmd(7) = m_ArivdTAmt
      Cmd(8) = m_ArivdAmt
      Cmd(9) = m_Arivd_CwSmNo
      Cmd(10) = m_Arivd_CwSmConv
      Cmd(11) = m_ArivdBz
      
      Cmd.Execute
      
   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 "ARIVDREC", "ARIVDNO", CStr(m_ArivdNo)
   
On Error GoTo Errorhandle

   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
      
   Cmd.CommandText = "{CALL ArivdREC_DELETE(?)}"
   Cmd(0) = m_ArivdNo
   
   gDbCommon.Conn.BeginTrans
   Cmd.Execute
   If Arivdh.Arivds.Count = 1 Then
      Arivdh.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(vArivdNo As Double) As Integer
   Dim mRs As DbRs
   Dim mSqlStr As String
On Error GoTo Errorhandle
   Requery = -1
   
   Set mRs = New DbRs
   
   mSqlStr = "SELECT Arivd_ArivdHNO,Arivd_HwBmCode=COALESCE((SELECT HwBmCode FROM HWBMREC WHERE HWBMNO=Arivd_HWBMNO),''),Arivd_HwBmMc=COALESCE((SELECT HwBmMc FROM HWBMREC WHERE HWBMNO=Arivd_HWBMNO),''),Arivd_HWBMNO,"
   mSqlStr = mSqlStr & "Arivd_HwDwCode=COALESCE((SELECT HWDWCode FROM HWDWREC WHERE HWDWNO=Arivd_HWDWNO),''),Arivd_HWDWNO,Arivd_HWDWCONV,"
   mSqlStr = mSqlStr & "ArivdQTY,ArivdPRICE,ArivdNtAmt,ArivdTAMT,ArivdAMT,"
   mSqlStr = mSqlStr & "Arivd_CWSMCODE=COALESCE((SELECT CWSMCODE FROM CWSMREC WHERE CWSMNO=Arivd_CWSMNO),''),Arivd_CWSMNO,Arivd_CWSMCONV,"
   mSqlStr = mSqlStr & "ArivdBZ,ArivdNO FROM ArivdREC WHERE ArivdNO=" & CStr(vArivdNo)
   
   mRs.Fillbydb mSqlStr
   
   If Not mRs.EOF Then
      BatchLet mRs!Arivd_Arivdhno, mRs!Arivd_HwBmCode, mRs!Arivd_HwBmMc, mRs!Arivd_HwBmno, _
               mRs!Arivd_HwDwCode, mRs!Arivd_HwDwno, mRs!Arivd_HwDwConv, _
               mRs!ArivdQty, mRs!ArivdPrice, mRs!ArivdNtAmt, mRs!ArivdTAmt, mRs!ArivdAmt, _
               mRs!Arivd_CwSmCode, mRs!Arivd_CwSmno, mRs!Arivd_CwsmConv, _
               mRs!ArivdBz, mRs!ArivdNo
   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_Arivd_Arivdhno = Properties(0)
   
   m_Arivd_HwBmCode = Properties(1)
   m_Arivd_HwBmMc = Properties(2)
   m_Arivd_HwBmno = Properties(3)
   
   m_Arivd_HwDwCode = Properties(4)
   m_Arivd_HwDwNo = Properties(5)
   m_Arivd_HwDwConv = Properties(6)
   
   m_ArivdQty = Properties(7)
   m_ArivdPrice = Properties(8)
   m_ArivdNtAmt = Properties(9)
   m_ArivdTAmt = Properties(10)
   m_ArivdAmt = Properties(11)
   
   m_Arivd_CwSmCode = Properties(12)
   m_Arivd_CwSmNo = Properties(13)
   m_Arivd_CwSmConv = Properties(14)
   
   m_ArivdBz = Properties(15)
   m_ArivdNo = Properties(16)

   m_ArivdId = 1

End Sub