hwdbdh.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 = "Hwdbdh"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Dim m_HwDbRc As HwDbRc
Dim m_CwQj As CwQj

Dim m_Hwdbds As Hwdbds

Dim m_HwdbdhDocno As String
Dim m_HwdbdhDat As String

Dim m_Hwdbdh_CwqjCode As String
Dim m_Hwdbdh_CwqjNo As Double

Dim m_Hwdbdh_HwDbRcCode As String
Dim m_Hwdbdh_HwDbRcno As Double

Dim m_HwdbdhForm As String

Dim m_HwdbdhNo As Double

Dim m_HwdbdhId As Integer
Dim m_HwdbdhKey As Double

Private Sub Class_Initialize()
   m_HwdbdhId = -1
End Sub

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

Public Property Get HwDbRc() As HwDbRc
   If m_HwDbRc Is Nothing Then
      Set m_HwDbRc = New HwDbRc
      If m_Hwdbdh_HwDbRcCode <> "" Then
         m_HwDbRc.Requery m_Hwdbdh_HwDbRcCode
      End If
   End If
   Set HwDbRc = m_HwDbRc
End Property

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

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

Public Property Get HwdbdhId() As Integer
   HwdbdhId = m_HwdbdhId
End Property

Public Property Get HwdbdhKey() As Double
   HwdbdhKey = m_HwdbdhKey
End Property

Public Property Get HwdbdhDocno() As String
   HwdbdhDocno = m_HwdbdhDocno
End Property

Public Property Get HwdbdhDat() As String
   HwdbdhDat = m_HwdbdhDat
End Property

Public Property Get Hwdbdh_CwQjCode() As String
   Hwdbdh_CwQjCode = m_Hwdbdh_CwqjCode
End Property

Public Property Get Hwdbdh_CwqjNo() As Double
   Hwdbdh_CwqjNo = m_Hwdbdh_CwqjNo
End Property

Public Property Get Hwdbdh_HwDbRcCode() As String
   Hwdbdh_HwDbRcCode = m_Hwdbdh_HwDbRcCode
End Property

Public Property Get Hwdbdh_HwDbRcno() As Double
   Hwdbdh_HwDbRcno = m_Hwdbdh_HwDbRcno
End Property

Public Property Get HwdbdhForm() As String
   HwdbdhForm = m_HwdbdhForm
End Property

Public Property Get HwdbdhNo() As Double
   HwdbdhNo = m_HwdbdhNo
End Property

Public Property Let HwdbdhId(vHwdbdhId As Integer)
   m_HwdbdhId = vHwdbdhId
End Property

Public Property Let HwdbdhKey(vHwdbdhKey As Double)
   m_HwdbdhKey = vHwdbdhKey
End Property

Public Property Let HwdbdhDocno(vHwdbdhDocno As String)

   If Trim(vHwdbdhDocno) = "" Then
      Err.Raise vbObjectError + 1, , "入库单号不能为空！"
      Exit Property
   End If
   
   If m_HwdbdhDocno <> vHwdbdhDocno Then
      Dim Rs As DbRs
      Set Rs = New DbRs
      Rs.Fillbydb "SELECT * FROM HwdbdHREC WHERE HwdbdHDOCNO='" & vHwdbdhDocno & "'"
      If Not Rs.EOF Then
         Set Rs = Nothing
         Err.Raise vbObjectError + 1, , "入库单号已经存在！"
         Exit Property
      End If
      Set Rs = Nothing
   End If
   
   m_HwdbdhDocno = vHwdbdhDocno
   
End Property

Public Property Let HwdbdhDat(vHwdbdhDat As String)

   If Trim(vHwdbdhDat) = "" Then
      Err.Raise vbObjectError + 1, , "入库日期不能为空！"
      Exit Property
   End If
   
   m_Hwdbdh_CwqjCode = gPublicFunction.GetCwqjCode(vHwdbdhDat)
   CwQj.Requery m_Hwdbdh_CwqjCode
   m_Hwdbdh_CwqjNo = CwQj.CwQjNo
   m_HwdbdhDat = vHwdbdhDat
   
End Property

Public Property Let Hwdbdh_HwDbRcCode(vHwdbdh_HwDbRcCode As String)

   If Trim(vHwdbdh_HwDbRcCode) = "" Then
      Err.Raise vbObjectError + 1, , "调拨原因不能为空！"
      Exit Property
   End If
   
   If m_Hwdbdh_HwDbRcCode <> vHwdbdh_HwDbRcCode Then
      If HwDbRc.Requery(vHwdbdh_HwDbRcCode) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的调拨原因不存在！"
         Exit Property
      End If
      m_Hwdbdh_HwDbRcno = HwDbRc.HwDbRcNo
   End If
   
   m_Hwdbdh_HwDbRcCode = vHwdbdh_HwDbRcCode
   
End Property

Public Property Let Hwdbdh_CwQjCode(vHwdbdh_CwQjCode As String)

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

Public Property Let HwdbdhForm(vHwdbdhForm As String)
   m_HwdbdhForm = vHwdbdhForm
End Property

Public Sub Save()
   Dim Cmd As ADODB.Command
On Error GoTo Errorhandle
      
   If Hwdbds.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_HwdbdhId = -1 Then
      Cmd.CommandText = gPublicFunction.GetCallSPString("HwdbdHREC_INSERT", 6)
      Cmd(0) = m_HwdbdhDocno
      Cmd(1) = m_HwdbdhDat
      Cmd(2) = m_Hwdbdh_CwqjNo
      Cmd(3) = m_Hwdbdh_HwDbRcno
      Cmd(4) = m_HwdbdhForm
      Cmd(5).Direction = adParamOutput     'HwdbdhNo
   Else
      Cmd.CommandText = gPublicFunction.GetCallSPString("HwdbdhREC_UPDATE", 5)
      Cmd(0) = m_HwdbdhNo
      Cmd(1) = m_HwdbdhDocno
      Cmd(2) = m_HwdbdhDat
      Cmd(3) = m_Hwdbdh_CwqjNo
      Cmd(4) = m_Hwdbdh_HwDbRcno
      
   End If
   
   gDbCommon.Conn.BeginTrans
   Cmd.Execute
   If m_HwdbdhId = -1 Then
      m_HwdbdhNo = Cmd(5)
   End If
   Hwdbds.Save Me
   gDbCommon.Conn.CommitTrans
   
   If m_HwdbdhId = -1 Then
      m_HwdbdhId = 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 "HWDBDHREC", "HWDBDHNO", CStr(m_HwdbdhNo)
   
On Error GoTo Errorhandle
      
   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
   
   Cmd.CommandText = "{CALL HwdbdHREC_DELETE(?)}"
   Cmd(0) = m_HwdbdhNo
   
   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 vHwdbdhDocno As String = "", Optional vHwdbdhno As Double = 0) As Integer
   Dim mRs As DbRs
   Dim mSqlStr As String
On Error GoTo Errorhandle

   Requery = -1
   
   mSqlStr = "SELECT HwdbdHDOCNO,HwdbdHDAT,"
   mSqlStr = mSqlStr & "Hwdbdh_CwQjCode=COALESCE((SELECT CWQJCODE FROM CWQJREC WHERE CWQJNO=Hwdbdh_CwQjno),''),Hwdbdh_CwQjno,"
   mSqlStr = mSqlStr & "Hwdbdh_HwDbRcCODE=COALESCE((SELECT HwDbRcCODE FROM HwDbRcREC WHERE HwDbRcNO=Hwdbdh_HwDbRcNO),''),Hwdbdh_HwDbRcNO,"
   mSqlStr = mSqlStr & "HwdbdHFORM,HwdbdHNO FROM HwdbdHREC WHERE (HwdbdHDOCNO='" & vHwdbdhDocno & "' OR HwdbdHNO=" & CStr(vHwdbdhno) & ") "
   
   Set mRs = New DbRs
   mRs.Fillbydb mSqlStr
   
   If Not mRs.EOF Then
      Requery = 1
      BatchLet mRs!HwdbdhDocno, mRs!HwdbdhDat, mRs!Hwdbdh_CwQjCode, mRs!Hwdbdh_CwqjNo, mRs!Hwdbdh_HwDbRcCode, mRs!Hwdbdh_HwDbRcno, mRs!HwdbdhForm, mRs!HwdbdhNo
   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_HwdbdhDocno = Properties(0)
   m_HwdbdhDat = Properties(1)
   m_Hwdbdh_CwqjCode = Properties(2)
   m_Hwdbdh_CwqjNo = Properties(3)
   m_Hwdbdh_HwDbRcCode = Properties(4)
   m_Hwdbdh_HwDbRcno = Properties(5)
   m_HwdbdhForm = Properties(6)
   m_HwdbdhNo = Properties(7)

   m_HwdbdhId = 1

End Sub