cgshdaph.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 = "CgshdAph"
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_CgShdAps As CgShdAps

Dim m_CgShdAphType As Integer

Dim m_CgShdAphDocno As String
Dim m_CgShdAphDat As String

Dim m_CgShdAph_CwqjCode As String
Dim m_CgShdAph_CwqjNo As Double

Dim m_CgShdAph_KhCode As String
Dim m_CgShdAph_Khno As Double

Dim m_CgShdAph_CwBzCode As String
Dim m_CgShdAph_CwBzno As Double
Dim m_CgShdAph_CwBzConv As Double

Dim m_CgShdAphAmt As Double

Dim m_CgShdAphForm As String

Dim m_CgShdAph_ApMxNo As Double
Dim m_CgShdAph_ArApNo As Double
Dim m_CgShdAphNo As Double

Dim m_CgShdAphId As Integer
Dim m_CgShdAphKey As Double

Private Sub Class_Initialize()
   m_CgShdAphId = -1
End Sub

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

Public Property Get Kh() As Kh
   If m_Kh Is Nothing Then
      Set m_Kh = New Kh
      If m_CgShdAph_KhCode <> "" Then
         m_Kh.Requery m_CgShdAph_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_CgShdAph_CwqjCode <> "" Then
         m_CwQj.Requery m_CgShdAph_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_CgShdAph_CwBzCode <> "" Then
         m_CwBz.Requery m_CgShdAph_CwBzCode
      End If
   End If
   Set CwBz = m_CwBz
End Property

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

Public Property Get CgShdAphId() As Integer
   CgShdAphId = m_CgShdAphId
End Property

Public Property Get CgShdAphKey() As Double
   CgShdAphKey = m_CgShdAphKey
End Property

Public Property Get CgShdAphType() As Integer
   CgShdAphType = m_CgShdAphType
End Property

Public Property Get CgShdAphDocno() As String
   CgShdAphDocno = m_CgShdAphDocno
End Property

Public Property Get CgShdAphDat() As String
   CgShdAphDat = m_CgShdAphDat
End Property

Public Property Get CgShdAph_CwQjCode() As String
   CgShdAph_CwQjCode = m_CgShdAph_CwqjCode
End Property

Public Property Get CgShdAph_CwqjNo() As Double
   CgShdAph_CwqjNo = m_CgShdAph_CwqjNo
End Property

Public Property Get CgShdAph_KhCode() As String
   CgShdAph_KhCode = m_CgShdAph_KhCode
End Property

Public Property Get CgShdAph_Khno() As Double
   CgShdAph_Khno = m_CgShdAph_Khno
End Property

Public Property Get CgShdAph_CwBzCode() As String
   CgShdAph_CwBzCode = m_CgShdAph_CwBzCode
End Property

Public Property Get CgShdAph_CwBzno() As Double
   CgShdAph_CwBzno = m_CgShdAph_CwBzno
End Property

Public Property Get CgShdAph_CwBzConv() As Double
   CgShdAph_CwBzConv = m_CgShdAph_CwBzConv
End Property

Public Property Get CgShdAphForm() As String
   CgShdAphForm = m_CgShdAphForm
End Property

Public Property Get CgShdAph_ApMxNo() As Double
   CgShdAph_ApMxNo = m_CgShdAph_ApMxNo
End Property

Public Property Get CgShdAph_ArApNo() As Double
   CgShdAph_ArApNo = m_CgShdAph_ArApNo
End Property

Public Property Get CgShdAphNo() As Double
   CgShdAphNo = m_CgShdAphNo
End Property

Public Property Let CgShdAphId(vCgShdAphId As Integer)
   m_CgShdAphId = vCgShdAphId
End Property

Public Property Let CgShdAphKey(vCgShdAphKey As Double)
   m_CgShdAphKey = vCgShdAphKey
End Property

Public Property Let CgShdAphType(vCgShdAphType As Integer)

   If vCgShdAphType <> 1 And vCgShdAphType <> 2 Then
      Err.Raise vbObjectError + 1, , "收货单类型只能为1-采购收货单，2-采购退货单！"
      Exit Property
   End If
   
   m_CgShdAphType = vCgShdAphType
   
End Property

Public Property Let CgShdAphDocno(vCgShdAphDocno As String)

   If Trim(vCgShdAphDocno) = "" Then
      Err.Raise vbObjectError + 1, , "收货单号不能为空！"
      Exit Property
   End If
   
   If m_CgShdAphDocno <> vCgShdAphDocno Then
      Dim Rs As DbRs
      Set Rs = New DbRs
      Rs.Fillbydb "SELECT * FROM CgShdApHREC WHERE CgShdApHDOCNO='" & vCgShdAphDocno & "'"
      If Not Rs.EOF Then
         Set Rs = Nothing
         Err.Raise vbObjectError + 1, , "收货单号已经存在！"
         Exit Property
      End If
      Set Rs = Nothing
   End If
   
   m_CgShdAphDocno = vCgShdAphDocno
   
End Property

Public Property Let CgShdAphDat(vCgShdAphDat As String)

   If Trim(vCgShdAphDat) = "" Then
      Err.Raise vbObjectError + 1, , "收货日期不能为空！"
      Exit Property
   End If
   
   m_CgShdAph_CwqjCode = gPublicFunction.GetCwqjCode(vCgShdAphDat)
   CwQj.Requery m_CgShdAph_CwqjCode
   m_CgShdAph_CwqjNo = CwQj.CwQjNo
   m_CgShdAphDat = vCgShdAphDat
   
End Property

Public Property Let CgShdAph_KhCode(vCgShdAph_KhCode As String)

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

Public Property Let CgShdAph_CwQjCode(vCgShdAph_CwQjCode As String)

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

Public Property Let CgShdAph_CwBzCode(vCgShdAph_CwBzCode As String)

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

Public Property Let CgShdAphAmt(vCgShdAphAmt As Double)
   m_CgShdAphAmt = vCgShdAphAmt
End Property

Public Property Let CgShdAphForm(vCgShdAphForm As String)
   m_CgShdAphForm = vCgShdAphForm
End Property

Public Sub Save()
   Dim Cmd As ADODB.Command
   Dim mCgshdAp As CgShdAp
On Error GoTo Errorhandle
      
   If CgShdAps.Count = 0 Then
      On Error GoTo 0
      Err.Raise vbObjectError + 1, , "单据无明细行，不能存盘！"
      Exit Sub
   End If
   
   m_CgShdAphAmt = 0
   For Each mCgshdAp In CgShdAps
      m_CgShdAphAmt = m_CgShdAphAmt + mCgshdAp.CgShdApTAmt
   Next
      
   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
   
   If m_CgShdAphId = -1 Then
      Cmd.CommandText = gPublicFunction.GetCallSPString("CgShdApHREC_INSERT", 12)
      Cmd(0) = m_CgShdAphType
      Cmd(1) = m_CgShdAphDocno
      Cmd(2) = m_CgShdAphDat
      Cmd(3) = m_CgShdAph_CwqjNo
      Cmd(4) = m_CgShdAph_Khno
      Cmd(5) = m_CgShdAph_CwBzno
      Cmd(6).Direction = adParamOutput
      Cmd(7) = m_CgShdAphAmt
      Cmd(8) = m_CgShdAphForm
      Cmd(9).Direction = adParamOutput
      Cmd(10).Direction = adParamOutput
      Cmd(11).Direction = adParamOutput   'CgShdAphNo
   Else
      Cmd.CommandText = gPublicFunction.GetCallSPString("CgShdAphREC_UPDATE", 8)
      Cmd(0) = m_CgShdAphNo
      Cmd(1) = m_CgShdAphDocno
      Cmd(2) = m_CgShdAphDat
      Cmd(3) = m_CgShdAph_CwqjNo
      Cmd(4) = m_CgShdAph_Khno
      Cmd(5) = m_CgShdAph_CwBzno
      Cmd(6).Direction = adParamOutput
      Cmd(7) = m_CgShdAphAmt
   End If
   
   gDbCommon.Conn.BeginTrans
   Cmd.Execute
   If m_CgShdAphId = -1 Then
      m_CgShdAph_CwBzConv = Cmd(6)
      m_CgShdAph_ApMxNo = Cmd(9)
      m_CgShdAph_ArApNo = Cmd(10)
      m_CgShdAphNo = Cmd(11)
   Else
      m_CgShdAph_CwBzConv = Cmd(6)
   End If
   CgShdAps.Save Me
   gDbCommon.Conn.CommitTrans
   
   If m_CgShdAphId = -1 Then
      m_CgShdAphId = 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 "CGSHDAPHREC", "CGSHDAPHNO", CStr(m_CgShdAphNo)
   
On Error GoTo Errorhandle
      
   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
   
   Cmd.CommandText = "{CALL CgShdApHREC_DELETE(?)}"
   Cmd(0) = m_CgShdAphNo
   
   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 vCgShdAphDocno As String = "", Optional vCgShdAphno As Double = 0) As Integer
   Dim mRs As DbRs
   Dim mSqlStr As String
On Error GoTo Errorhandle

   Requery = -1
   
   mSqlStr = "SELECT CgShdApHTYPE,CgShdApHDOCNO,CgShdApHDAT,CgShdApH_KHCODE=COALESCE((SELECT KHCODE FROM KHREC WHERE KHNO=CgShdApH_KHNO),''),CgShdApH_KHNO,"
   mSqlStr = mSqlStr & "CgShdAph_CwQjCode=COALESCE((SELECT CWQJCODE FROM CWQJREC WHERE CWQJNO=CgShdAph_CwQjno),''),CgShdAph_CwQjno,"
   mSqlStr = mSqlStr & "CgShdAph_CwBzCode=COALESCE((SELECT CWBZCODE FROM CWBZREC WHERE CWBZNO=CgShdAph_CwBzno),''),CgShdAph_CwBzno,CgShdAph_CwBzConv,"
   mSqlStr = mSqlStr & "CGSHDAPHAMT,CgShdApHFORM,CgshdAph_ApMxno,CGSHDAPH_ARAPNO,CgShdApHNO FROM CgShdApHREC WHERE (CgShdApHDOCNO='" & vCgShdAphDocno & "' OR CgShdApHNO=" & CStr(vCgShdAphno) & ") "
   
   Set mRs = New DbRs
   mRs.Fillbydb mSqlStr
   
   If Not mRs.EOF Then
      Requery = 1
      BatchLet mRs!CgShdAphType, mRs!CgShdAphDocno, mRs!CgShdAphDat, mRs!CgShdAph_CwQjCode, mRs!CgShdAph_CwqjNo, mRs!CgShdAph_KhCode, mRs!CgShdAph_Khno, _
               mRs!CgShdAph_CwBzCode, mRs!CgShdAph_CwBzno, mRs!CgShdAph_CwBzConv, mRs!CgShdAphAmt, mRs!CgShdAphForm, mRs!CgShdAph_ApMxNo, mRs!CgShdAph_ArApNo, mRs!CgShdAphNo
   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_CgShdAphType = Properties(0)
   m_CgShdAphDocno = Properties(1)
   m_CgShdAphDat = Properties(2)
   m_CgShdAph_CwqjCode = Properties(3)
   m_CgShdAph_CwqjNo = Properties(4)
   m_CgShdAph_KhCode = Properties(5)
   m_CgShdAph_Khno = Properties(6)
   m_CgShdAph_CwBzCode = Properties(7)
   m_CgShdAph_CwBzno = Properties(8)
   m_CgShdAph_CwBzConv = Properties(9)
   m_CgShdAphAmt = Properties(10)
   m_CgShdAphForm = Properties(11)
   m_CgShdAph_ApMxNo = Properties(12)
   m_CgShdAph_ArApNo = Properties(13)
   m_CgShdAphNo = Properties(14)

   m_CgShdAphId = 1

End Sub