arivdh.cls

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

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

Dim m_Kh As Kh
Dim m_CwBz As CwBz
Dim m_CwQj As CwQj

Dim m_Arivds As Arivds

Dim m_ArivdhType As Integer

Dim m_ArivdhDocno As String
Dim m_ArivdhDat As String

Dim m_Arivdh_CwqjCode As String
Dim m_Arivdh_CwqjNo As Double

Dim m_Arivdh_KhCode As String
Dim m_Arivdh_Khno As Double

Dim m_Arivdh_CwBzCode As String
Dim m_Arivdh_CwBzno As Double
Dim m_Arivdh_CwBzConv As Double
Dim m_ArivdhAmt As Double

Dim m_ArivdhForm As String

Dim m_Arivdh_ArMxno As Double
Dim m_Arivdh_ArApno As Double
Dim m_ArivdhNo As Double

Dim m_ArivdhId As Integer
Dim m_ArivdhKey As Double

Private Sub Class_Initialize()
   m_ArivdhId = -1
End Sub

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

Public Property Get Kh() As Kh
   If m_Kh Is Nothing Then
      Set m_Kh = New Kh
      If m_Arivdh_KhCode <> "" Then
         m_Kh.Requery m_Arivdh_KhCode
      End If
   End If
   Set Kh = m_Kh
End Property

Public Property Get CwQj() As CwQj
   If m_CwQj Is Nothing Then
      Set m_CwQj = New CwQj
      If m_Arivdh_CwqjCode <> "" Then
         m_CwQj.Requery m_Arivdh_CwqjCode
      End If
   End If
   Set CwQj = m_CwQj
End Property

Public Property Get CwBz() As CwBz
   If m_CwBz Is Nothing Then
      Set m_CwBz = New CwBz
      If m_Arivdh_CwBzCode <> "" Then
         m_CwBz.Requery m_Arivdh_CwBzCode
      End If
   End If
   Set CwBz = m_CwBz
End Property

Public Property Get Arivds() As Arivds
   If m_Arivds Is Nothing Then
      Set m_Arivds = New Arivds
      m_Arivds.Fillbydb Me
   End If
   Set Arivds = m_Arivds
End Property

Public Property Get ArivdhId() As Integer
   ArivdhId = m_ArivdhId
End Property

Public Property Get ArivdhKey() As Double
   ArivdhKey = m_ArivdhKey
End Property

Public Property Get ArivdhType() As Integer
   ArivdhType = m_ArivdhType
End Property

Public Property Get ArivdhDocno() As String
   ArivdhDocno = m_ArivdhDocno
End Property

Public Property Get ArivdhDat() As String
   ArivdhDat = m_ArivdhDat
End Property

Public Property Get Arivdh_CwQjCode() As String
   Arivdh_CwQjCode = m_Arivdh_CwqjCode
End Property

Public Property Get Arivdh_CwqjNo() As Double
   Arivdh_CwqjNo = m_Arivdh_CwqjNo
End Property

Public Property Get Arivdh_KhCode() As String
   Arivdh_KhCode = m_Arivdh_KhCode
End Property

Public Property Get Arivdh_Khno() As Double
   Arivdh_Khno = m_Arivdh_Khno
End Property

Public Property Get Arivdh_CwBzCode() As String
   Arivdh_CwBzCode = m_Arivdh_CwBzCode
End Property

Public Property Get Arivdh_CwBzno() As Double
   Arivdh_CwBzno = m_Arivdh_CwBzno
End Property

Public Property Get Arivdh_CwBzConv() As Double
   Arivdh_CwBzConv = m_Arivdh_CwBzConv
End Property

Public Property Get ArivdhAmt() As Double
   ArivdhAmt = m_ArivdhAmt
End Property

Public Property Get ArivdhForm() As String
   ArivdhForm = m_ArivdhForm
End Property

Public Property Get Arivdh_ArMxno() As Double
   Arivdh_ArMxno = m_Arivdh_ArMxno
End Property

Public Property Get Arivdh_ArApno() As Double
   Arivdh_ArApno = m_Arivdh_ArApno
End Property

Public Property Get ArivdhNo() As Double
   ArivdhNo = m_ArivdhNo
End Property

Public Property Let ArivdhId(vArivdhId As Integer)
   m_ArivdhId = vArivdhId
End Property

Public Property Let ArivdhKey(vArivdhKey As Double)
   m_ArivdhKey = vArivdhKey
End Property

Public Property Let ArivdhType(vArivdhType As Integer)
   m_ArivdhType = vArivdhType
End Property

Public Property Let ArivdhDocno(vArivdhDocno As String)

   If Trim(vArivdhDocno) = "" Then
      Err.Raise vbObjectError + 1, , "单据编号不能为空！"
      Exit Property
   End If
   
   If m_ArivdhDocno <> vArivdhDocno Then
      Dim Rs As DbRs
      Set Rs = New DbRs
      Rs.Fillbydb "SELECT * FROM ArivdHREC WHERE ArivdHDOCNO='" & vArivdhDocno & "'"
      If Not Rs.EOF Then
         Set Rs = Nothing
         Err.Raise vbObjectError + 1, , "单据编号已经存在！"
         Exit Property
      End If
      Set Rs = Nothing
   End If
   
   m_ArivdhDocno = vArivdhDocno
   
End Property

Public Property Let ArivdhDat(vArivdhDat As String)

   If Trim(vArivdhDat) = "" Then
      Err.Raise vbObjectError + 1, , "收货日期不能为空！"
      Exit Property
   End If
   
   m_Arivdh_CwqjCode = gPublicFunction.GetCwqjCode(vArivdhDat)
   CwQj.Requery m_Arivdh_CwqjCode
   m_Arivdh_CwqjNo = CwQj.CwQjNo
   m_ArivdhDat = vArivdhDat
   
End Property

Public Property Let Arivdh_KhCode(vArivdh_KhCode As String)

   If Trim(vArivdh_KhCode) = "" Then
      Err.Raise vbObjectError + 1, , "客户编码不能为空！"
      Exit Property
   End If
   
   If m_Arivdh_KhCode <> vArivdh_KhCode Then
      If Kh.Requery(vArivdh_KhCode) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的客户编码不存在！"
         Exit Property
      End If
      m_Arivdh_Khno = Kh.KhNo
      m_Arivdh_CwBzCode = Kh.Kh_CwBzCode
      m_Arivdh_CwBzno = Kh.Kh_CwBzno
   End If
   
   m_Arivdh_KhCode = vArivdh_KhCode
   
End Property

Public Property Let Arivdh_CwQjCode(vArivdh_CwQjCode As String)

   If Trim(vArivdh_CwQjCode) = "" Then
      Err.Raise vbObjectError + 1, , "录入的财务月份不能为空！"
      Exit Property
   End If
   
   If m_Arivdh_CwqjCode <> vArivdh_CwQjCode Then
      If CwQj.Requery(vArivdh_CwQjCode) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的财务月份不存在！"
         Exit Property
      End If
      m_Arivdh_CwqjNo = CwQj.CwQjNo
   End If
   
   m_Arivdh_CwqjCode = vArivdh_CwQjCode
   
End Property

Public Property Let Arivdh_CwBzCode(vArivdh_CwBzCode As String)

   If Trim(vArivdh_CwBzCode) = "" Then
      Err.Raise vbObjectError + 1, , "录入的币种不能为空！"
      Exit Property
   End If
   
   If m_Arivdh_CwBzCode <> vArivdh_CwBzCode Then
      If CwBz.Requery(vArivdh_CwBzCode) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的币种编码不存在！"
         Exit Property
      End If
      m_Arivdh_CwBzno = CwBz.CwbzNo
   End If
   
   m_Arivdh_CwBzCode = vArivdh_CwBzCode
   
End Property

Public Property Let ArivdhAmt(vArivdhAmt As Double)
   m_ArivdhAmt = vArivdhAmt
End Property

Public Property Let ArivdhForm(vArivdhForm As String)
   m_ArivdhForm = vArivdhForm
End Property

Public Sub Save()
   Dim Cmd As ADODB.Command
On Error GoTo Errorhandle
      
   If Arivds.Count = 0 Then
      On Error GoTo 0
      Err.Raise vbObjectError + 1, , "单据无明细行，不能存盘！"
      Exit Sub
   End If
      
   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
   
   If m_ArivdhId = -1 Then
      Cmd.CommandText = gPublicFunction.GetCallSPString("ArivdHREC_INSERT", 12)
      Cmd(0) = m_ArivdhType
      Cmd(1) = m_ArivdhDocno
      Cmd(2) = m_ArivdhDat
      Cmd(3) = m_Arivdh_CwqjNo
      Cmd(4) = m_Arivdh_Khno
      Cmd(5) = m_Arivdh_CwBzno
      Cmd(6) = m_Arivdh_CwBzConv
      Cmd(7) = m_ArivdhAmt
      Cmd(8) = m_ArivdhForm
      Cmd(9).Direction = adParamOutput   'Arivdh_ArMxno
      Cmd(10).Direction = adParamOutput   'Arivdh_ArApNo
      Cmd(11).Direction = adParamOutput     'ArivdhNo
   Else
      Cmd.CommandText = gPublicFunction.GetCallSPString("ArivdHREC_UPDATE", 8)
      Cmd(0) = m_ArivdhNo
      Cmd(1) = m_ArivdhDocno
      Cmd(2) = m_ArivdhDat
      Cmd(3) = m_Arivdh_CwqjNo
      Cmd(4) = m_Arivdh_Khno
      Cmd(5) = m_Arivdh_CwBzno
      Cmd(6) = m_Arivdh_CwBzConv
      Cmd(7) = m_ArivdhAmt
   End If
   
   gDbCommon.Conn.BeginTrans
   Cmd.Execute
   If m_ArivdhId = -1 Then
      m_Arivdh_ArMxno = Cmd(9)
      m_Arivdh_ArApno = Cmd(10)
      m_ArivdhNo = Cmd(11)
   End If
   Arivds.Save Me
   gDbCommon.Conn.CommitTrans
   
   If m_ArivdhId = -1 Then
      m_ArivdhId = 1
   End If
   
   Set Cmd = Nothing
   
Exit Sub
Errorhandle:
   Set Cmd = Nothing
   gDbCommon.Conn.RollbackTrans
   Err.Raise vbObjectError + 1, , gDbCommon.Conn.Errors(0)
End Sub

Public Sub Del(Optional mMxDel As Integer = 0)
   Dim Cmd As ADODB.Command
   
   gPublicFunction.CheckCanBeDelete "ARIVDHREC", "ARIVDHNO", CStr(m_ArivdhNo)
   
On Error GoTo Errorhandle
      
   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
   
   Cmd.CommandText = "{CALL ArivdHREC_DELETE(?)}"
   Cmd(0) = m_ArivdhNo
   
   If mMxDel = 0 Then
      gDbCommon.Conn.BeginTrans
   End If
   Cmd.Execute
   If mMxDel = 0 Then
      gDbCommon.Conn.CommitTrans
   End If
   
   Set Cmd = Nothing
   
Exit Sub
Errorhandle:
   Set Cmd = Nothing
   If mMxDel = 0 Then
      gDbCommon.Conn.RollbackTrans
   End If
   Err.Raise vbObjectError + 1, , gDbCommon.Conn.Errors(0)
End Sub

Public Function Requery(Optional vArivdhDocno As String = "", Optional vArivdhno As Double = 0) As Integer
   Dim mRs As DbRs
   Dim mSqlStr As String
On Error GoTo Errorhandle

   Requery = -1
   
   mSqlStr = "SELECT ArivdHTYPE,ArivdHDOCNO,ArivdHDAT,ArivdH_KHCODE=COALESCE((SELECT KHCODE FROM KHREC WHERE KHNO=ArivdH_KHNO),''),ArivdH_KHNO,"
   mSqlStr = mSqlStr & "Arivdh_CwQjCode=COALESCE((SELECT CWQJCODE FROM CWQJREC WHERE CWQJNO=Arivdh_CwQjno),''),Arivdh_CwQjno,"
   mSqlStr = mSqlStr & "Arivdh_CwBzCode=COALESCE((SELECT CWBZCODE FROM CWBZREC WHERE CWBZNO=Arivdh_CwBzno),''),Arivdh_CwBzno,ArivdH_CWBZCONV,ArivdHAMT,"
   mSqlStr = mSqlStr & "ArivdHFORM,ArivdH_ArMxno,ArivdH_ARAPNO,ArivdHNO FROM ArivdHREC WHERE (ArivdHDOCNO='" & vArivdhDocno & "' OR ArivdHNO=" & CStr(vArivdhno) & ") "
   
   Set mRs = New DbRs
   mRs.Fillbydb mSqlStr
   
   If Not mRs.EOF Then
      Requery = 1
      BatchLet mRs!ArivdhType, mRs!ArivdhDocno, mRs!ArivdhDat, mRs!Arivdh_CwQjCode, mRs!Arivdh_CwqjNo, mRs!Arivdh_KhCode, mRs!Arivdh_Khno, mRs!Arivdh_CwBzCode, mRs!Arivdh_CwBzno, mRs!Arivdh_CwBzConv, mRs!ArivdhAmt, mRs!ArivdhForm, mRs!Arivdh_ArMxno, mRs!Arivdh_ArApno, mRs!ArivdhNo
   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_ArivdhType = Properties(0)
   m_ArivdhDocno = Properties(1)
   m_ArivdhDat = Properties(2)
   m_Arivdh_CwqjCode = Properties(3)
   m_Arivdh_CwqjNo = Properties(4)
   m_Arivdh_KhCode = Properties(5)
   m_Arivdh_Khno = Properties(6)
   m_Arivdh_CwBzCode = Properties(7)
   m_Arivdh_CwBzno = Properties(8)
   m_Arivdh_CwBzConv = Properties(9)
   m_ArivdhAmt = Properties(10)
   m_ArivdhForm = Properties(11)
   m_Arivdh_ArMxno = Properties(12)
   m_Arivdh_ArApno = Properties(13)
   m_ArivdhNo = Properties(14)

   m_ArivdhId = 1

End Sub