apfkd.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 = "ApFkd"
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_CwZh As CwZh

Dim m_ApFkdDocno As String
Dim m_ApFkdDat As String

Dim m_ApFkd_CwqjCode As String
Dim m_ApFkd_CwqjNo As Double

Dim m_ApFkd_KhCode As String
Dim m_ApFkd_Khno As Double

Dim m_ApFkd_CwZhMc As String
Dim m_ApFkd_CwZhno As Double

Dim m_ApFkd_CwBzCode As String
Dim m_ApFkd_CwBzno As Double
Dim m_ApFkd_CwBzConv As Double

Dim m_ApFkdAmt As Double
Dim m_ApFkdBz As String

Dim m_ApFkdForm As String

Dim m_ApFkd_ApFkMxno As Double
Dim m_ApFkd_ArApno As Double

Dim m_ApFkdNo As Double

Dim m_ApFkdId As Integer
Dim m_ApFkdKey As Double

Private Sub Class_Initialize()
   m_ApFkdId = -1
End Sub

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

Public Property Get Kh() As Kh
   If m_Kh Is Nothing Then
      Set m_Kh = New Kh
      If m_ApFkd_KhCode <> "" Then
         m_Kh.Requery m_ApFkd_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_ApFkd_CwqjCode <> "" Then
         m_CwQj.Requery m_ApFkd_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_ApFkd_CwBzCode <> "" Then
         m_CwBz.Requery m_ApFkd_CwBzCode
      End If
   End If
   Set CwBz = m_CwBz
End Property

Public Property Get CwZh() As CwZh
   If m_CwZh Is Nothing Then
      Set m_CwZh = New CwZh
      If m_ApFkd_CwZhMc <> "" Then
         m_CwZh.Requery m_ApFkd_CwZhMc
      End If
   End If
   Set CwZh = m_CwZh
End Property

Public Property Get ApFkdId() As Integer
   ApFkdId = m_ApFkdId
End Property

Public Property Get ApFkdKey() As Double
   ApFkdKey = m_ApFkdKey
End Property

Public Property Get ApFkdDocno() As String
   ApFkdDocno = m_ApFkdDocno
End Property

Public Property Get ApFkdDat() As String
   ApFkdDat = m_ApFkdDat
End Property

Public Property Get ApFkd_CwQjCode() As String
   ApFkd_CwQjCode = m_ApFkd_CwqjCode
End Property

Public Property Get ApFkd_CwqjNo() As Double
   ApFkd_CwqjNo = m_ApFkd_CwqjNo
End Property

Public Property Get ApFkd_KhCode() As String
   ApFkd_KhCode = m_ApFkd_KhCode
End Property

Public Property Get ApFkd_Khno() As Double
   ApFkd_Khno = m_ApFkd_Khno
End Property

Public Property Get ApFkd_CwZhMc() As String
   ApFkd_CwZhMc = m_ApFkd_CwZhMc
End Property

Public Property Get ApFkd_CwZhno() As Double
   ApFkd_CwZhno = m_ApFkd_CwZhno
End Property

Public Property Get ApFkd_CwBzCode() As String
   ApFkd_CwBzCode = m_ApFkd_CwBzCode
End Property

Public Property Get ApFkd_CwBzno() As Double
   ApFkd_CwBzno = m_ApFkd_CwBzno
End Property

Public Property Get ApFkd_CwBzConv() As Double
   ApFkd_CwBzConv = m_ApFkd_CwBzConv
End Property

Public Property Get ApFkdAmt() As Double
   ApFkdAmt = m_ApFkdAmt
End Property

Public Property Get ApFkdBz() As String
   ApFkdBz = m_ApFkdBz
End Property

Public Property Get ApFkdForm() As String
   ApFkdForm = m_ApFkdForm
End Property

Public Property Get ApFkd_ApFkMxno() As Double
   ApFkd_ApFkMxno = m_ApFkd_ApFkMxno
End Property

Public Property Get ApFkd_ArApno() As Double
   ApFkd_ArApno = m_ApFkd_ArApno
End Property

Public Property Get ApFkdNo() As Double
   ApFkdNo = m_ApFkdNo
End Property

Public Property Let ApFkdId(vApFkdId As Integer)
   m_ApFkdId = vApFkdId
End Property

Public Property Let ApFkdKey(vApFkdKey As Double)
   m_ApFkdKey = vApFkdKey
End Property

Public Property Let ApFkdDocno(vApFkdDocno As String)

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

Public Property Let ApFkdDat(vApFkdDat As String)

   If Trim(vApFkdDat) = "" Then
      Err.Raise vbObjectError + 1, , "收货日期不能为空！"
      Exit Property
   End If
   
   m_ApFkd_CwqjCode = gPublicFunction.GetCwqjCode(vApFkdDat)
   CwQj.Requery m_ApFkd_CwqjCode
   m_ApFkd_CwqjNo = CwQj.CwQjNo
   m_ApFkdDat = vApFkdDat
   
End Property

Public Property Let ApFkd_KhCode(vApFkd_KhCode As String)

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

Public Property Let ApFkd_CwQjCode(vApFkd_CwQjCode As String)

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

Public Property Let ApFkd_CwZhMc(vApFkd_CwZhMc As String)

   If Trim(vApFkd_CwZhMc) = "" Then
      Err.Raise vbObjectError + 1, , "录入的现金银行账号不能为空！"
      Exit Property
   End If
   
   If m_ApFkd_CwZhMc <> vApFkd_CwZhMc Then
      If CwZh.Requery(vApFkd_CwZhMc) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的现金银行账号不存在！"
         Exit Property
      End If
      m_ApFkd_CwZhno = CwZh.CwZhNo
   End If
   
   m_ApFkd_CwZhMc = vApFkd_CwZhMc
   
End Property

Public Property Let ApFkd_CwBzCode(vApFkd_CwBzCode As String)

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

Public Property Let ApFkdAmt(vApFkdAmt As Double)
   m_ApFkdAmt = vApFkdAmt
End Property

Public Property Let ApFkdBz(vApFkdBz As String)
   m_ApFkdBz = vApFkdBz
End Property

Public Property Let ApFkdForm(vApFkdForm As String)
   m_ApFkdForm = vApFkdForm
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_ApFkdId = -1 Then
      Cmd.CommandText = gPublicFunction.GetCallSPString("APFKDREC_INSERT", 13)
      Cmd(0) = m_ApFkdDocno
      Cmd(1) = m_ApFkdDat
      Cmd(2) = m_ApFkd_CwqjNo
      Cmd(3) = m_ApFkd_Khno
      Cmd(4) = m_ApFkd_CwZhno
      Cmd(5) = m_ApFkd_CwBzno
      Cmd(6) = m_ApFkd_CwBzConv
      Cmd(7) = m_ApFkdAmt
      Cmd(8) = m_ApFkdBz
      Cmd(9) = m_ApFkdForm
      Cmd(10).Direction = adParamOutput   'ApFkd_ApFkMxno
      Cmd(11).Direction = adParamOutput   'ApFkd_ArApNo
      Cmd(12).Direction = adParamOutput      'ApFkdNo
   Else
      Cmd.CommandText = gPublicFunction.GetCallSPString("APFKDREC_UPDATE", 10)
      Cmd(0) = m_ApFkdNo
      Cmd(1) = m_ApFkdDocno
      Cmd(2) = m_ApFkdDat
      Cmd(3) = m_ApFkd_CwqjNo
      Cmd(4) = m_ApFkd_Khno
      Cmd(5) = m_ApFkd_CwZhno
      Cmd(6) = m_ApFkd_CwBzno
      Cmd(7) = m_ApFkd_CwBzConv
      Cmd(8) = m_ApFkdAmt
      Cmd(9) = m_ApFkdBz
   End If
   
   gDbCommon.Conn.BeginTrans
   Cmd.Execute
   If m_ApFkdId = -1 Then
      m_ApFkd_ApFkMxno = Cmd(10)
      m_ApFkd_ArApno = Cmd(11)
      m_ApFkdNo = Cmd(12)
   End If
   gDbCommon.Conn.CommitTrans
   
   If m_ApFkdId = -1 Then
      m_ApFkdId = 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 "APFKDREC", "APFKDNO", CStr(m_ApFkdNo)
   
On Error GoTo Errorhandle
      
   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
   
   Cmd.CommandText = "{CALL ApFkdREC_DELETE(?)}"
   Cmd(0) = m_ApFkdNo
   
   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 vApFkdDocno As String = "", Optional vApFkdno As Double = 0) As Integer
   Dim mRs As DbRs
   Dim mSqlStr As String
On Error GoTo Errorhandle

   Requery = -1
   
   mSqlStr = "SELECT ApFkdDOCNO,ApFkdDAT,ApFkd_KHCODE=COALESCE((SELECT KHCODE FROM KHREC WHERE KHNO=ApFkd_KHNO),''),ApFkd_KHNO,"
   mSqlStr = mSqlStr & "ApFkd_CwQjCode=COALESCE((SELECT CWQJCODE FROM CWQJREC WHERE CWQJNO=ApFkd_CwQjno),''),ApFkd_CwQjno,"
   mSqlStr = mSqlStr & "ApFkd_CwZhMc=COALESCE((SELECT CwZhMc FROM CwZhREC WHERE CwZhNO=ApFkd_CwZhno),''),ApFkd_CwZhno,"
   mSqlStr = mSqlStr & "ApFkd_CwBzCode=COALESCE((SELECT CWBZCODE FROM CWBZREC WHERE CWBZNO=ApFkd_CwBzno),''),ApFkd_CwBzno,ApFkd_CWBZCONV,ApFkdAMT,APFKDBZ,"
   mSqlStr = mSqlStr & "ApFkdFORM,ApFkd_ApFkMxno,ApFkd_ARAPNO,ApFkdNO FROM ApFkdREC WHERE (ApFkdDOCNO='" & vApFkdDocno & "' OR ApFkdNO=" & CStr(vApFkdno) & ") "
   
   Set mRs = New DbRs
   mRs.Fillbydb mSqlStr
   
   If Not mRs.EOF Then
      Requery = 1
      BatchLet mRs!ApFkdDocno, mRs!ApFkdDat, mRs!ApFkd_CwQjCode, mRs!ApFkd_CwqjNo, mRs!ApFkd_KhCode, mRs!ApFkd_Khno, mRs!ApFkd_CwZhMc, mRs!ApFkd_CwZhno, mRs!ApFkd_CwBzCode, mRs!ApFkd_CwBzno, mRs!ApFkd_CwBzConv, mRs!ApFkdAmt, mRs!ApFkdBz, mRs!ApFkdForm, mRs!ApFkd_ApFkMxno, mRs!ApFkd_ArApno, mRs!ApFkdNo
   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_ApFkdDocno = Properties(0)
   m_ApFkdDat = Properties(1)
   m_ApFkd_CwqjCode = Properties(2)
   m_ApFkd_CwqjNo = Properties(3)
   m_ApFkd_KhCode = Properties(4)
   m_ApFkd_Khno = Properties(5)
   m_ApFkd_CwZhMc = Properties(6)
   m_ApFkd_CwZhno = Properties(7)
   m_ApFkd_CwBzCode = Properties(8)
   m_ApFkd_CwBzno = Properties(9)
   m_ApFkd_CwBzConv = Properties(10)
   m_ApFkdAmt = Properties(11)
   m_ApFkdBz = Properties(12)
   m_ApFkdForm = Properties(13)
   m_ApFkd_ApFkMxno = Properties(14)
   m_ApFkd_ArApno = Properties(15)
   m_ApFkdNo = Properties(16)

   m_ApFkdId = 1

End Sub