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

Dim m_Apivdh As Apivdh
Dim m_Apivrs As Apivrs

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

Dim m_Apivd_Apivdhno As Double

Dim m_Apivd_HwBmCode As String
Dim m_Apivd_HwBmMc As String
Dim m_Apivd_HwBmno As Double

Dim m_Apivd_HwDwCode As String
Dim m_Apivd_HwDwNo As Double
Dim m_Apivd_HwDwConv As Double

Dim m_ApivdQty As Double
Dim m_ApivdPrice As Double
Dim m_ApivdAmt As Double

Dim m_ApivdNtAmt As Double
Dim m_ApivdTAmt As Double

Dim m_Apivd_CwSmCode As String
Dim m_Apivd_CwSmNo As Double
Dim m_Apivd_CwSmConv As Double

Dim m_ApivdBz As String

Dim m_ApivdNo As Double

Dim m_ApivdId As Integer
Dim m_ApivdKey As Double

Private Sub Class_Initialize()
   m_ApivdId = -1
End Sub

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

Public Property Get ApivdId() As Integer
   ApivdId = m_ApivdId
End Property

Public Property Let ApivdId(vApivdId As Integer)
   m_ApivdId = vApivdId
End Property

Public Property Get ApivdKey() As Double
   ApivdKey = m_ApivdKey
End Property

Public Property Let ApivdKey(vApivdKey As Double)
   m_ApivdKey = vApivdKey
End Property

Public Property Get Apivdh() As Apivdh
   If m_Apivdh Is Nothing Then
      Set m_Apivdh = New Apivdh
      m_Apivdh.Requery "", m_Apivd_Apivdhno
   End If
   Set Apivdh = m_Apivdh
End Property

Public Property Set Apivdh(vApivdh As Apivdh)
   Set m_Apivdh = vApivdh
End Property

Public Property Get Apivrs() As Apivrs
   If m_Apivrs Is Nothing Then
      Set m_Apivrs = New Apivrs
      If m_ApivdNo <> 0 Then
         m_Apivrs.Fillbydb Me
      End If
   End If
   Set Apivrs = m_Apivrs
End Property

Public Property Get Hwbm() As Hwbm
   If m_Hwbm Is Nothing Then
      Set m_Hwbm = New Hwbm
      If m_Apivd_HwBmCode <> "" Then
         m_Hwbm.Requery m_Apivd_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_Apivd_HwDwCode <> "" Then
         m_HwDw.Requery m_Apivd_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_Apivd_CwSmCode <> "" Then
         m_CwSm.Requery m_Apivd_CwSmCode
      End If
   End If
   Set CwSm = m_CwSm
End Property

Public Property Get Apivd_Apivdhno() As Double
   Apivd_Apivdhno = m_Apivd_Apivdhno
End Property

Public Property Get Apivd_HwBmCode() As String
   Apivd_HwBmCode = m_Apivd_HwBmCode
End Property

Public Property Get Apivd_HwBmMc() As String
   Apivd_HwBmMc = m_Apivd_HwBmMc
End Property

Public Property Get Apivd_HwBmno() As Double
   Apivd_HwBmno = m_Apivd_HwBmno
End Property

Public Property Get Apivd_HwDwCode() As String
   Apivd_HwDwCode = m_Apivd_HwDwCode
End Property

Public Property Get Apivd_HwDwno() As Double
   Apivd_HwDwno = m_Apivd_HwDwNo
End Property

Public Property Get Apivd_HwDwConv() As Double
   Apivd_HwDwConv = m_Apivd_HwDwConv
End Property

Public Property Get ApivdQty() As Double
   ApivdQty = m_ApivdQty
End Property

Public Property Get ApivdPrice() As Double
   ApivdPrice = m_ApivdPrice
End Property

Public Property Get ApivdAmt() As Double
   ApivdAmt = m_ApivdAmt
End Property

Public Property Get ApivdNtAmt() As Double
   ApivdNtAmt = m_ApivdNtAmt
End Property

Public Property Get ApivdTAmt() As Double
   ApivdTAmt = m_ApivdTAmt
End Property

Public Property Get Apivd_CwSmCode() As String
   Apivd_CwSmCode = m_Apivd_CwSmCode
End Property

Public Property Get Apivd_CwSmno() As Double
   Apivd_CwSmno = m_Apivd_CwSmNo
End Property

Public Property Get Apivd_CwsmConv() As Double
   Apivd_CwsmConv = m_Apivd_CwSmConv
End Property

Public Property Get ApivdBz() As String
   ApivdBz = m_ApivdBz
End Property

Public Property Get ApivdNo() As Double
   ApivdNo = m_ApivdNo
End Property

Public Property Let Apivd_HwBmCode(vApivd_HwBmCode As String)
   If Trim(vApivd_HwBmCode) = "" Then
      Err.Raise vbObjectError + 1, , "货物编码不能为空！"
      Exit Property
   End If
   If m_Apivd_HwBmCode <> vApivd_HwBmCode Then
      If Hwbm.Requery(vApivd_HwBmCode) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的货物编码不存在！"
         Exit Property
      End If
      m_Apivd_HwBmno = Hwbm.HwBmNo
      m_Apivd_HwBmMc = Hwbm.HwBmMc
      m_Apivd_HwDwCode = Hwbm.HwBm_HwDwCode
      m_Apivd_HwDwNo = Hwbm.HwBm_HwDwNo
      m_Apivd_HwDwConv = 1
   End If
   m_Apivd_HwBmCode = vApivd_HwBmCode
End Property

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

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

Public Property Let ApivdQty(vApivdQty As Double)
   If vApivdQty < 0 Then
      Err.Raise vbObjectError + 1, , "数量不能小于零！"
      Exit Property
   End If
   m_ApivdNtAmt = Val(Format(vApivdQty * m_ApivdPrice, "##"))
   m_ApivdTAmt = Val(Format(m_ApivdNtAmt * m_Apivd_CwSmConv, "##"))
   m_ApivdAmt = Val(Format(m_ApivdNtAmt + m_ApivdTAmt, "##"))
   m_ApivdQty = vApivdQty
End Property

Public Property Let ApivdPrice(vApivdPrice As Double)
   If vApivdPrice < 0 Then
      Err.Raise vbObjectError + 1, , "单价不能小于零！"
      Exit Property
   End If
   m_ApivdNtAmt = Val(Format(m_ApivdQty * vApivdPrice, "##"))
   m_ApivdTAmt = Val(Format(m_ApivdNtAmt * m_Apivd_CwSmConv, "##"))
   m_ApivdAmt = Val(Format(m_ApivdNtAmt + m_ApivdTAmt, "##"))
   m_ApivdPrice = vApivdPrice
End Property

Public Property Let ApivdNtAmt(vApivdNtAmt As Double)
   If vApivdNtAmt < 0 Then
      Err.Raise vbObjectError + 1, , "不含税金额不能小于零！"
      Exit Property
   End If
   m_ApivdTAmt = Val(Format(vApivdNtAmt * m_Apivd_CwSmConv, "##"))
   m_ApivdAmt = Val(Format(vApivdNtAmt + m_ApivdTAmt, "##"))
   If m_ApivdQty <> 0 Then
      m_ApivdPrice = Val(Format(vApivdNtAmt / m_ApivdQty, "########"))
   End If
   m_ApivdNtAmt = vApivdNtAmt
End Property

Public Property Let ApivdAmt(vApivdAmt As Double)
   If vApivdAmt < 0 Then
      Err.Raise vbObjectError + 1, , "总金额不能小于零！"
      Exit Property
   End If
   m_ApivdNtAmt = Val(Format(vApivdAmt / (1 + m_Apivd_CwSmConv), "##"))
   m_ApivdTAmt = Val(Format(vApivdAmt - m_ApivdNtAmt, "##"))
   If m_ApivdQty <> 0 Then
      m_ApivdPrice = Val(Format(m_ApivdNtAmt / m_ApivdQty, "########"))
   End If
   m_ApivdAmt = vApivdAmt
End Property

Public Property Let Apivd_CwSmCode(vApivd_CwSmCode As String)

   If Trim(vApivd_CwSmCode) = "" Then
      Err.Raise vbObjectError + 1, , "税码不能为空！"
      Exit Property
   End If
   
   If m_Apivd_CwSmCode <> vApivd_CwSmCode Then
      If CwSm.Requery(vApivd_CwSmCode) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的税码不存在！"
         Exit Property
      End If
      
      m_ApivdTAmt = Val(Format(m_ApivdNtAmt * CwSm.CwsmSl, "##"))
      m_ApivdAmt = Val(Format(m_ApivdNtAmt + m_ApivdTAmt, "##"))
      If m_ApivdQty <> 0 Then
         m_ApivdPrice = Val(Format(m_ApivdNtAmt / m_ApivdQty, "########"))
      End If
      
      m_Apivd_CwSmConv = CwSm.CwsmSl
      m_Apivd_CwSmNo = CwSm.CwsmNo
      
   End If
   
   m_Apivd_CwSmCode = vApivd_CwSmCode
   
End Property

Public Property Let ApivdBz(vApivdDBz As String)
   m_ApivdBz = vApivdDBz
End Property

Public Sub Save()
   Dim Cmd As ADODB.Command
   Dim mApivr As Apivr
On Error GoTo Errorhandle
      
   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
           
   If m_ApivdId = -1 Then
   
      Cmd.CommandText = gPublicFunction.GetCallSPString("APIVDREC_INSERT", 13)
      Cmd(0) = m_Apivdh.ApivdhNo
      Cmd(1) = m_Apivd_HwBmno
      Cmd(2) = m_Apivd_HwDwNo
      Cmd(3) = m_Apivd_HwDwConv
      Cmd(4) = m_ApivdQty
      Cmd(5) = m_ApivdPrice
      Cmd(6) = m_ApivdNtAmt
      Cmd(7) = m_ApivdTAmt
      Cmd(8) = m_ApivdAmt
      Cmd(9) = m_Apivd_CwSmNo
      Cmd(10) = m_Apivd_CwSmConv
      Cmd(11) = m_ApivdBz
      Cmd(12).Direction = adParamOutput   'ApivdNo
   
      Cmd.Execute
      m_ApivdNo = Cmd(12)
      Apivrs.Save
      m_ApivdId = 1
   
   Else
   
      Cmd.CommandText = gPublicFunction.GetCallSPString("APIVDREC_UPDATE", 12)
      Cmd(0) = m_ApivdNo
      Cmd(1) = m_Apivd_HwBmno
      Cmd(2) = m_Apivd_HwDwNo
      Cmd(3) = m_Apivd_HwDwConv
      Cmd(4) = m_ApivdQty
      Cmd(5) = m_ApivdPrice
      Cmd(6) = m_ApivdNtAmt
      Cmd(7) = m_ApivdTAmt
      Cmd(8) = m_ApivdAmt
      Cmd(9) = m_Apivd_CwSmNo
      Cmd(10) = m_Apivd_CwSmConv
      Cmd(11) = m_ApivdBz
      
      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 "APIVDREC", "APIVDNO", CStr(m_ApivdNo)
   
On Error GoTo Errorhandle

   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
      
   Cmd.CommandText = "{CALL ApivdREC_DELETE(?)}"
   Cmd(0) = m_ApivdNo
   
   gDbCommon.Conn.BeginTrans
   Cmd.Execute
   If Apivdh.Apivds.Count = 1 Then
      Apivdh.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(vApivdNo As Double) As Integer
   Dim mRs As DbRs
   Dim mSqlStr As String
On Error GoTo Errorhandle
   Requery = -1
   
   Set mRs = New DbRs
   
   mSqlStr = "SELECT Apivd_ApivdHNO,Apivd_HwBmCode=COALESCE((SELECT HwBmCode FROM HWBMREC WHERE HWBMNO=Apivd_HWBMNO),''),Apivd_HwBmMc=COALESCE((SELECT HwBmMc FROM HWBMREC WHERE HWBMNO=Apivd_HWBMNO),''),Apivd_HWBMNO,"
   mSqlStr = mSqlStr & "Apivd_HwDwCode=COALESCE((SELECT HWDWCode FROM HWDWREC WHERE HWDWNO=Apivd_HWDWNO),''),Apivd_HWDWNO,Apivd_HWDWCONV,"
   mSqlStr = mSqlStr & "ApivdQTY,ApivdPRICE,ApivdNtAmt,ApivdTAMT,ApivdAMT,"
   mSqlStr = mSqlStr & "Apivd_CWSMCODE=COALESCE((SELECT CWSMCODE FROM CWSMREC WHERE CWSMNO=Apivd_CWSMNO),''),Apivd_CWSMNO,Apivd_CWSMCONV,"
   mSqlStr = mSqlStr & "ApivdBZ,ApivdNO FROM ApivdREC WHERE ApivdNO=" & CStr(vApivdNo)
   
   mRs.Fillbydb mSqlStr
   
   If Not mRs.EOF Then
      BatchLet mRs!Apivd_Apivdhno, mRs!Apivd_HwBmCode, mRs!Apivd_HwBmMc, mRs!Apivd_HwBmno, _
               mRs!Apivd_HwDwCode, mRs!Apivd_HwDwno, mRs!Apivd_HwDwConv, _
               mRs!ApivdQty, mRs!ApivdPrice, mRs!ApivdNtAmt, mRs!ApivdTAmt, mRs!ApivdAmt, _
               mRs!Apivd_CwSmCode, mRs!Apivd_CwSmno, mRs!Apivd_CwsmConv, _
               mRs!ApivdBz, mRs!ApivdNo
   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_Apivd_Apivdhno = Properties(0)
   
   m_Apivd_HwBmCode = Properties(1)
   m_Apivd_HwBmMc = Properties(2)
   m_Apivd_HwBmno = Properties(3)
   
   m_Apivd_HwDwCode = Properties(4)
   m_Apivd_HwDwNo = Properties(5)
   m_Apivd_HwDwConv = Properties(6)
   
   m_ApivdQty = Properties(7)
   m_ApivdPrice = Properties(8)
   m_ApivdNtAmt = Properties(9)
   m_ApivdTAmt = Properties(10)
   m_ApivdAmt = Properties(11)
   
   m_Apivd_CwSmCode = Properties(12)
   m_Apivd_CwSmNo = Properties(13)
   m_Apivd_CwSmConv = Properties(14)
   
   m_ApivdBz = Properties(15)
   m_ApivdNo = Properties(16)

   m_ApivdId = 1

End Sub