cgpodh.cls

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

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CgPodh"
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_Buyer As Buyer

Dim m_CgPods As CgPods

Dim m_CgPodhDocno As String
Dim m_CgPodhDat As String

Dim m_CgPodh_BuyerCode As String
Dim m_CgPodh_BuyerNo As Double

Dim m_CgPodh_KhCode As String
Dim m_CgPodh_Khno As Double

Dim m_CgPodh_CwBzCode As String
Dim m_CgPodh_CwBzno As Double

Dim m_CgPodhForm As String

Dim m_CgPodhNo As Double

Dim m_CgPodhId As Integer
Dim m_CgPodhKey As Double

Private Sub Class_Initialize()
   m_CgPodhId = -1
End Sub

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

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

Public Property Get Buyer() As Buyer
   If m_Buyer Is Nothing Then
      Set m_Buyer = New Buyer
      If m_CgPodh_BuyerCode <> "" Then
         m_Buyer.Requery m_CgPodh_BuyerCode
      End If
   End If
   Set Buyer = m_Buyer
End Property

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

Public Property Get CgPods() As CgPods
   If m_CgPods Is Nothing Then
      Set m_CgPods = New CgPods
      If m_CgPodhId = 1 Then
         m_CgPods.Fillbydb Me
      End If
   End If
   Set CgPods = m_CgPods
End Property

Public Property Get CgPodhId() As Integer
   CgPodhId = m_CgPodhId
End Property

Public Property Get CgPodhKey() As Double
   CgPodhKey = m_CgPodhKey
End Property

Public Property Get CgPodhDocno() As String
   CgPodhDocno = m_CgPodhDocno
End Property

Public Property Get CgPodhDat() As String
   CgPodhDat = m_CgPodhDat
End Property

Public Property Get CgPodh_BuyerCode() As String
   CgPodh_BuyerCode = m_CgPodh_BuyerCode
End Property

Public Property Get CgPodh_BuyerNo() As Double
   CgPodh_BuyerNo = m_CgPodh_BuyerNo
End Property

Public Property Get CgPodh_KhCode() As String
   CgPodh_KhCode = m_CgPodh_KhCode
End Property

Public Property Get CgPodh_Khno() As Double
   CgPodh_Khno = m_CgPodh_Khno
End Property

Public Property Get CgPodh_CwBzCode() As String
   CgPodh_CwBzCode = m_CgPodh_CwBzCode
End Property

Public Property Get CgPodh_CwBzno() As Double
   CgPodh_CwBzno = m_CgPodh_CwBzno
End Property

Public Property Get CgPodhForm() As String
   CgPodhForm = m_CgPodhForm
End Property

Public Property Get CgPodhNo() As Double
   CgPodhNo = m_CgPodhNo
End Property

Public Property Let CgPodhId(vCgPodhId As Integer)
   m_CgPodhId = vCgPodhId
End Property

Public Property Let CgPodhKey(vCgPodhKey As Double)
   m_CgPodhKey = vCgPodhKey
End Property

Public Property Let CgPodhDocno(vCgPodhDocno As String)

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

Public Property Let CgPodhDat(vCgPodhDat As String)

   If Trim(vCgPodhDat) = "" Then
      Err.Raise vbObjectError + 1, , "日期不能为空！"
      Exit Property
   End If
   
   m_CgPodhDat = vCgPodhDat
   
End Property

Public Property Let CgPodh_KhCode(vCgPodh_KhCode As String)

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

Public Property Let CgPodh_BuyerCode(vCgPodh_BuyerCode As String)

   If Trim(vCgPodh_BuyerCode) = "" Then
      m_CgPodh_BuyerCode = ""
      m_CgPodh_BuyerNo = 0
      Exit Property
   End If
   
   If m_CgPodh_BuyerCode <> vCgPodh_BuyerCode Then
      If Buyer.Requery(vCgPodh_BuyerCode) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的采购员不存在！"
         Exit Property
      End If
      m_CgPodh_BuyerNo = Buyer.BuyerNo
   End If
   
   m_CgPodh_BuyerCode = vCgPodh_BuyerCode
   
End Property

Public Property Let CgPodh_CwBzCode(vCgPodh_CwBzCode As String)

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

Public Property Let CgPodhForm(vCgpodhForm As String)
   m_CgPodhForm = vCgpodhForm
End Property

Public Sub Save()
   Dim Cmd As ADODB.Command
On Error GoTo Errorhandle
      
   If CgPods.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_CgPodhId = -1 Then
      Cmd.CommandText = gPublicFunction.GetCallSPString("CgPodHREC_INSERT", 7)
      Cmd(0) = m_CgPodhDocno
      Cmd(1) = m_CgPodhDat
      Cmd(2) = m_CgPodh_Khno
      Cmd(3) = m_CgPodh_CwBzno
      Cmd(4) = m_CgPodh_BuyerNo
      Cmd(5) = m_CgPodhForm
      Cmd(6).Direction = adParamOutput   'CgPodhNo
   Else
      Cmd.CommandText = gPublicFunction.GetCallSPString("CgPodhREC_UPDATE", 6)
      Cmd(0) = m_CgPodhNo
      Cmd(1) = m_CgPodhDocno
      Cmd(2) = m_CgPodhDat
      Cmd(3) = m_CgPodh_Khno
      Cmd(4) = m_CgPodh_CwBzno
      Cmd(5) = m_CgPodh_BuyerNo
   End If
   
   gDbCommon.Conn.BeginTrans
   Cmd.Execute
   If m_CgPodhId = -1 Then
      m_CgPodhNo = Cmd(6)
   End If
   CgPods.Save Me
   gDbCommon.Conn.CommitTrans
   
   If m_CgPodhId = -1 Then
      m_CgPodhId = 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 "CGPODHREC", "CGPODHNO", CStr(m_CgPodhNo)
   
On Error GoTo Errorhandle
      
   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
   
   Cmd.CommandText = "{CALL CgPodHREC_DELETE(?)}"
   Cmd(0) = m_CgPodhNo
   
   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 vCgPodhDocno As String = "", Optional vCgPodhno As Double = 0) As Integer
   Dim mRs As DbRs
   Dim mSqlStr As String
On Error GoTo Errorhandle

   Requery = -1
   
   mSqlStr = "SELECT CgPodHDOCNO,CgPodHDAT,CgPodH_KHCODE=COALESCE((SELECT KHCODE FROM KHREC WHERE KHNO=CgPodH_KHNO),''),CgPodH_KHNO,"
   mSqlStr = mSqlStr & "CgPodh_CwBzCode=COALESCE((SELECT CWBZCODE FROM CWBZREC WHERE CWBZNO=CgPodh_CwBzno),''),CgPodh_CwBzno,"
   mSqlStr = mSqlStr & "CgPodh_BuyerCode=COALESCE((SELECT BuyerCODE FROM BuyerREC WHERE BuyerNO=CgPodh_Buyerno),''),CgPodh_Buyerno,"
   mSqlStr = mSqlStr & "CGPODHFORM,CgPodHNO FROM CgPodHREC WHERE (CgPodHDOCNO='" & vCgPodhDocno & "' OR CgPodHNO=" & CStr(vCgPodhno) & ") "
   
   Set mRs = New DbRs
   mRs.Fillbydb mSqlStr
   
   If Not mRs.EOF Then
      Requery = 1
      BatchLet mRs!CgPodhDocno, mRs!CgPodhDat, mRs!CgPodh_KhCode, mRs!CgPodh_Khno, mRs!CgPodh_CwBzCode, mRs!CgPodh_CwBzno, mRs!CgPodh_BuyerCode, mRs!CgPodh_BuyerNo, mRs!CgPodhForm, mRs!CgPodhNo
   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_CgPodhDocno = Properties(0)
   m_CgPodhDat = Properties(1)
   m_CgPodh_KhCode = Properties(2)
   m_CgPodh_Khno = Properties(3)
   m_CgPodh_CwBzCode = Properties(4)
   m_CgPodh_CwBzno = Properties(5)
   m_CgPodh_BuyerCode = Properties(6)
   m_CgPodh_BuyerNo = Properties(7)
   m_CgPodhForm = Properties(8)
   m_CgPodhNo = Properties(9)

   m_CgPodhId = 1

End Sub