apivdh.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 = "Apivdh"
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_Apivds As Apivds

Dim m_ApivdhType As Integer

Dim m_ApivdhDocno As String
Dim m_ApivdhDat As String

Dim m_Apivdh_CwqjCode As String
Dim m_Apivdh_CwqjNo As Double

Dim m_Apivdh_KhCode As String
Dim m_Apivdh_Khno As Double

Dim m_Apivdh_CwBzCode As String
Dim m_Apivdh_CwBzno As Double
Dim m_Apivdh_CwBzConv As Double
Dim m_ApivdhAmt As Double

Dim m_ApivdhForm As String

Dim m_Apivdh_ApMxno As Double
Dim m_Apivdh_ArApno As Double
Dim m_ApivdhNo As Double

Dim m_ApivdhId As Integer
Dim m_ApivdhKey As Double

Private Sub Class_Initialize()
   m_ApivdhId = -1
End Sub

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

Public Property Get Kh() As Kh
   If m_Kh Is Nothing Then
      Set m_Kh = New Kh
      If m_Apivdh_KhCode <> "" Then
         m_Kh.Requery m_Apivdh_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_Apivdh_CwqjCode <> "" Then
         m_CwQj.Requery m_Apivdh_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_Apivdh_CwBzCode <> "" Then
         m_CwBz.Requery m_Apivdh_CwBzCode
      End If
   End If
   Set CwBz = m_CwBz
End Property

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

Public Property Get ApivdhId() As Integer
   ApivdhId = m_ApivdhId
End Property

Public Property Get ApivdhKey() As Double
   ApivdhKey = m_ApivdhKey
End Property

Public Property Get ApivdhType() As Integer
   ApivdhType = m_ApivdhType
End Property

Public Property Get ApivdhDocno() As String
   ApivdhDocno = m_ApivdhDocno
End Property

Public Property Get ApivdhDat() As String
   ApivdhDat = m_ApivdhDat
End Property

Public Property Get Apivdh_CwQjCode() As String
   Apivdh_CwQjCode = m_Apivdh_CwqjCode
End Property

Public Property Get Apivdh_CwqjNo() As Double
   Apivdh_CwqjNo = m_Apivdh_CwqjNo
End Property

Public Property Get Apivdh_KhCode() As String
   Apivdh_KhCode = m_Apivdh_KhCode
End Property

Public Property Get Apivdh_Khno() As Double
   Apivdh_Khno = m_Apivdh_Khno
End Property

Public Property Get Apivdh_CwBzCode() As String
   Apivdh_CwBzCode = m_Apivdh_CwBzCode
End Property

Public Property Get Apivdh_CwBzno() As Double
   Apivdh_CwBzno = m_Apivdh_CwBzno
End Property

Public Property Get Apivdh_CwBzConv() As Double
   Apivdh_CwBzConv = m_Apivdh_CwBzConv
End Property

Public Property Get ApivdhAmt() As Double
   ApivdhAmt = m_ApivdhAmt
End Property

Public Property Get ApivdhForm() As String
   ApivdhForm = m_ApivdhForm
End Property

Public Property Get Apivdh_ApMxno() As Double
   Apivdh_ApMxno = m_Apivdh_ApMxno
End Property

Public Property Get Apivdh_ArApno() As Double
   Apivdh_ArApno = m_Apivdh_ArApno
End Property

Public Property Get ApivdhNo() As Double
   ApivdhNo = m_ApivdhNo
End Property

Public Property Let ApivdhId(vApivdhId As Integer)
   m_ApivdhId = vApivdhId
End Property

Public Property Let ApivdhKey(vApivdhKey As Double)
   m_ApivdhKey = vApivdhKey
End Property

Public Property Let ApivdhType(vApivdhType As Integer)
   m_ApivdhType = vApivdhType
End Property

Public Property Let ApivdhDocno(vApivdhDocno As String)

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

Public Property Let ApivdhDat(vApivdhDat As String)

   If Trim(vApivdhDat) = "" Then
      Err.Raise vbObjectError + 1, , "收货日期不能为空！"
      Exit Property
   End If
   
   m_Apivdh_CwqjCode = gPublicFunction.GetCwqjCode(vApivdhDat)
   CwQj.Requery m_Apivdh_CwqjCode
   m_Apivdh_CwqjNo = CwQj.CwQjNo
   m_ApivdhDat = vApivdhDat
   
End Property

Public Property Let Apivdh_KhCode(vApivdh_KhCode As String)

   If Trim(vApivdh_KhCode) = "" Then
      Err.Raise vbObjectError + 1, , "供应商编码不能为空！"
      Exit Property
   End If
   
   If m_Apivdh_KhCode <> vApivdh_KhCode Then
      If Kh.Requery(vApivdh_KhCode) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的供应商编码不存在！"
         Exit Property
      End If
      m_Apivdh_Khno = Kh.KhNo
      m_Apivdh_CwBzCode = Kh.Kh_CwBzCode
      m_Apivdh_CwBzno = Kh.Kh_CwBzno
   End If
   
   m_Apivdh_KhCode = vApivdh_KhCode
   
End Property

Public Property Let Apivdh_CwQjCode(vApivdh_CwQjCode As String)

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

Public Property Let Apivdh_CwBzCode(vApivdh_CwBzCode As String)

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

Public Property Let ApivdhAmt(vApivdhAmt As Double)
   m_ApivdhAmt = vApivdhAmt
End Property

Public Property Let ApivdhForm(vApivdhForm As String)
   m_ApivdhForm = vApivdhForm
End Property

Public Sub Save()
   Dim Cmd As ADODB.Command
On Error GoTo Errorhandle
      
   If Apivds.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_ApivdhId = -1 Then
      Cmd.CommandText = gPublicFunction.GetCallSPString("APIVDHREC_INSERT", 12)
      Cmd(0) = m_ApivdhType
      Cmd(1) = m_ApivdhDocno
      Cmd(2) = m_ApivdhDat
      Cmd(3) = m_Apivdh_CwqjNo
      Cmd(4) = m_Apivdh_Khno
      Cmd(5) = m_Apivdh_CwBzno
      Cmd(6) = m_Apivdh_CwBzConv
      Cmd(7) = m_ApivdhAmt
      Cmd(8) = m_ApivdhForm
      Cmd(9).Direction = adParamOutput   'Apivdh_APmxNo
      Cmd(10).Direction = adParamOutput   'Apivdh_ArApNo
      Cmd(11).Direction = adParamOutput     'ApivdhNo
   Else
      Cmd.CommandText = gPublicFunction.GetCallSPString("APIVDHREC_UPDATE", 8)
      Cmd(0) = m_ApivdhNo
      Cmd(1) = m_ApivdhDocno
      Cmd(2) = m_ApivdhDat
      Cmd(3) = m_Apivdh_CwqjNo
      Cmd(4) = m_Apivdh_Khno
      Cmd(5) = m_Apivdh_CwBzno
      Cmd(6) = m_Apivdh_CwBzConv
      Cmd(7) = m_ApivdhAmt
   End If
   
   gDbCommon.Conn.BeginTrans
   Cmd.Execute
   If m_ApivdhId = -1 Then
      m_Apivdh_ApMxno = Cmd(9)
      m_Apivdh_ArApno = Cmd(10)
      m_ApivdhNo = Cmd(11)
   End If
   Apivds.Save Me
   gDbCommon.Conn.CommitTrans
   
   If m_ApivdhId = -1 Then
      m_ApivdhId = 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 "APIVDHREC", "APIVDHNO", CStr(m_ApivdhNo)
   
On Error GoTo Errorhandle
      
   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
   
   Cmd.CommandText = "{CALL ApivdHREC_DELETE(?)}"
   Cmd(0) = m_ApivdhNo
   
   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 vApivdhDocno As String = "", Optional vApivdhno As Double = 0) As Integer
   Dim mRs As DbRs
   Dim mSqlStr As String
On Error GoTo Errorhandle

   Requery = -1
   
   mSqlStr = "SELECT ApivdHTYPE,ApivdHDOCNO,ApivdHDAT,ApivdH_KHCODE=COALESCE((SELECT KHCODE FROM KHREC WHERE KHNO=ApivdH_KHNO),''),ApivdH_KHNO,"
   mSqlStr = mSqlStr & "Apivdh_CwQjCode=COALESCE((SELECT CWQJCODE FROM CWQJREC WHERE CWQJNO=Apivdh_CwQjno),''),Apivdh_CwQjno,"
   mSqlStr = mSqlStr & "Apivdh_CwBzCode=COALESCE((SELECT CWBZCODE FROM CWBZREC WHERE CWBZNO=Apivdh_CwBzno),''),Apivdh_CwBzno,APIVDH_CWBZCONV,APIVDHAMT,"
   mSqlStr = mSqlStr & "ApivdHFORM,APIVDH_APMXNO,APIVDH_ARAPNO,ApivdHNO FROM ApivdHREC WHERE (ApivdHDOCNO='" & vApivdhDocno & "' OR ApivdHNO=" & CStr(vApivdhno) & ") "
   
   Set mRs = New DbRs
   mRs.Fillbydb mSqlStr
   
   If Not mRs.EOF Then
      Requery = 1
      BatchLet mRs!ApivdhType, mRs!ApivdhDocno, mRs!ApivdhDat, mRs!Apivdh_CwQjCode, mRs!Apivdh_CwqjNo, mRs!Apivdh_KhCode, mRs!Apivdh_Khno, mRs!Apivdh_CwBzCode, mRs!Apivdh_CwBzno, mRs!Apivdh_CwBzConv, mRs!ApivdhAmt, mRs!ApivdhForm, mRs!Apivdh_ApMxno, mRs!Apivdh_ArApno, mRs!ApivdhNo
   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_ApivdhType = Properties(0)
   m_ApivdhDocno = Properties(1)
   m_ApivdhDat = Properties(2)
   m_Apivdh_CwqjCode = Properties(3)
   m_Apivdh_CwqjNo = Properties(4)
   m_Apivdh_KhCode = Properties(5)
   m_Apivdh_Khno = Properties(6)
   m_Apivdh_CwBzCode = Properties(7)
   m_Apivdh_CwBzno = Properties(8)
   m_Apivdh_CwBzConv = Properties(9)
   m_ApivdhAmt = Properties(10)
   m_ApivdhForm = Properties(11)
   m_Apivdh_ApMxno = Properties(12)
   m_Apivdh_ArApno = Properties(13)
   m_ApivdhNo = Properties(14)

   m_ApivdhId = 1

End Sub