arivr.cls

来自「制造业产供销与往来系统源码」· CLS 代码 · 共 153 行

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Arivr"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Dim m_Arivd As Arivd

Dim m_Arivr_Arivdno As Double
Dim m_Arivr_XsArno As Double

Dim m_ArivrNo As Double

Dim m_ArivrQty As Double

Dim m_ArivrId As Integer
Dim m_ArivrKey As Double

Private Sub Class_Initialize()
   m_ArivrId = -1
End Sub

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

Public Property Get ArivrId() As Integer
   ArivrId = m_ArivrId
End Property

Public Property Let ArivrId(vArivrId As Integer)
   m_ArivrId = vArivrId
End Property

Public Property Get ArivrKey() As Double
   ArivrKey = m_ArivrKey
End Property

Public Property Let ArivrKey(vArivrKey As Double)
   m_ArivrKey = vArivrKey
End Property

Public Property Get Arivd() As Arivd
   If m_Arivd Is Nothing Then
      Set m_Arivd = New Arivd
      If m_Arivr_Arivdno <> 0 Then
         m_Arivd.Requery m_Arivr_Arivdno
      End If
   End If
   Set Arivd = m_Arivd
End Property

Public Property Set Arivd(vArivd As Arivd)
   Set m_Arivd = vArivd
End Property

Public Property Get Arivr_Arivdno() As Double
   Arivr_Arivdno = m_Arivr_Arivdno
End Property

Public Property Get Arivr_XsArno() As Double
   Arivr_XsArno = m_Arivr_XsArno
End Property

Public Property Get ArivrQty() As Double
   ArivrQty = m_ArivrQty
End Property

Public Property Get ArivrNo() As Double
   ArivrNo = m_ArivrNo
End Property

Public Property Let Arivr_XsArno(vArivr_XsArNo As Double)

   Dim mRs As DbRs
   Set mRs = New DbRs
   
   mRs.Fillbydb "SELECT * FROM XsArREC WHERE XsArNO=" & CStr(vArivr_XsArNo)
   mRs.MoveFirst
   
   If mRs.EOF Then
      Set mRs = Nothing
      Err.Raise vbObjectError + 1, , "销售应收明细不存在！"
      Exit Property
   End If
   
   Set mRs = Nothing
   m_Arivr_XsArno = vArivr_XsArNo
   
End Property

Public Property Let ArivrQty(vArivrQty As Double)

   If vArivrQty = 0 Then
      Err.Raise vbObjectError + 1, , "数量不能等于零！"
      Exit Property
   End If
   
   m_ArivrQty = vArivrQty

End Property

Public Sub BatchLet(ParamArray Properties() As Variant)
   
   m_Arivr_Arivdno = Properties(0)
   m_Arivr_XsArno = Properties(1)
   
   m_ArivrQty = Properties(2)
   m_ArivrNo = Properties(3)
   
   m_ArivrId = 1

End Sub

Public Sub Save()
   Dim Cmd As ADODB.Command
On Error GoTo Errorhandle
      
   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
           
   Cmd.CommandText = gPublicFunction.GetCallSPString("ArivrREC_INSERT", 4)
   Cmd(0) = m_Arivd.ArivdNo
   Cmd(1) = m_Arivr_XsArno
   Cmd(2) = m_ArivrQty
   Cmd(3).Direction = adParamOutput     'ArivrNo

   Cmd.Execute
   
   m_ArivrNo = Cmd(3)
   
   Set Cmd = Nothing
   
Exit Sub
Errorhandle:
   Set Cmd = Nothing
   Err.Raise vbObjectError + 1, , gDbCommon.Conn.Errors(0)
End Sub