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

Dim m_HwIoRc As HwIoRc
Dim m_CwQj As CwQj

Dim m_Hwods As Hwods

Dim m_HwodhType As Integer

Dim m_HwodhDocno As String
Dim m_HwodhDat As String

Dim m_Hwodh_CwqjCode As String
Dim m_Hwodh_CwqjNo As Double

Dim m_Hwodh_HwIoRcCode As String
Dim m_Hwodh_HwIoRcno As Double

Dim m_HwodhForm As String

Dim m_HwodhNo As Double

Dim m_HwodhId As Integer
Dim m_HwodhKey As Double

Private Sub Class_Initialize()
   m_HwodhId = -1
End Sub

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

Public Property Get HwIoRc() As HwIoRc
   If m_HwIoRc Is Nothing Then
      Set m_HwIoRc = New HwIoRc
      If m_Hwodh_HwIoRcCode <> "" Then
         m_HwIoRc.Requery m_Hwodh_HwIoRcCode
      End If
   End If
   Set HwIoRc = m_HwIoRc
End Property

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

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

Public Property Get HwodhId() As Integer
   HwodhId = m_HwodhId
End Property

Public Property Get HwodhKey() As Double
   HwodhKey = m_HwodhKey
End Property

Public Property Get HwodhType() As Integer
   HwodhType = m_HwodhType
End Property

Public Property Get HwodhDocno() As String
   HwodhDocno = m_HwodhDocno
End Property

Public Property Get HwodhDat() As String
   HwodhDat = m_HwodhDat
End Property

Public Property Get Hwodh_CwQjCode() As String
   Hwodh_CwQjCode = m_Hwodh_CwqjCode
End Property

Public Property Get Hwodh_CwqjNo() As Double
   Hwodh_CwqjNo = m_Hwodh_CwqjNo
End Property

Public Property Get Hwodh_HwIoRcCode() As String
   Hwodh_HwIoRcCode = m_Hwodh_HwIoRcCode
End Property

Public Property Get Hwodh_HwIoRcno() As Double
   Hwodh_HwIoRcno = m_Hwodh_HwIoRcno
End Property

Public Property Get HwodhForm() As String
   HwodhForm = m_HwodhForm
End Property

Public Property Get HwodhNo() As Double
   HwodhNo = m_HwodhNo
End Property

Public Property Let HwodhId(vHwodhId As Integer)
   m_HwodhId = vHwodhId
End Property

Public Property Let HwodhKey(vHwodhKey As Double)
   m_HwodhKey = vHwodhKey
End Property

Public Property Let HwodhType(vHwodhType As Integer)

   If vHwodhType <> 1 And vHwodhType <> 2 Then
      Err.Raise vbObjectError + 1, , "类型只能为1-入库单，2-出库单！"
      Exit Property
   End If
   
   m_HwodhType = vHwodhType
   
End Property

Public Property Let HwodhDocno(vHwodhDocno As String)

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

Public Property Let HwodhDat(vHwodhDat As String)

   If Trim(vHwodhDat) = "" Then
      Err.Raise vbObjectError + 1, , "出库日期不能为空！"
      Exit Property
   End If
   
   m_Hwodh_CwqjCode = gPublicFunction.GetCwqjCode(vHwodhDat)
   CwQj.Requery m_Hwodh_CwqjCode
   m_Hwodh_CwqjNo = CwQj.CwQjNo
   m_HwodhDat = vHwodhDat
   
End Property

Public Property Let Hwodh_HwIoRcCode(vHwodh_HwIoRcCode As String)

   If Trim(vHwodh_HwIoRcCode) = "" Then
      Err.Raise vbObjectError + 1, , "出入库原因不能为空！"
      Exit Property
   End If
   
   If m_Hwodh_HwIoRcCode <> vHwodh_HwIoRcCode Then
      If HwIoRc.Requery(vHwodh_HwIoRcCode) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的出入库原因不存在！"
         Exit Property
      End If
      m_Hwodh_HwIoRcno = HwIoRc.HwIoRcNo
   End If
   
   m_Hwodh_HwIoRcCode = vHwodh_HwIoRcCode
   
End Property

Public Property Let Hwodh_CwQjCode(vHwodh_CwQjCode As String)

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

Public Property Let HwodhForm(vHwodhForm As String)
   m_HwodhForm = vHwodhForm
End Property

Public Sub Save()
   Dim Cmd As ADODB.Command
On Error GoTo Errorhandle
      
   If Hwods.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_HwodhId = -1 Then
      Cmd.CommandText = gPublicFunction.GetCallSPString("HwodHREC_INSERT", 7)
      Cmd(0) = m_HwodhType
      Cmd(1) = m_HwodhDocno
      Cmd(2) = m_HwodhDat
      Cmd(3) = m_Hwodh_CwqjNo
      Cmd(4) = m_Hwodh_HwIoRcno
      Cmd(5) = m_HwodhForm
      Cmd(6).Direction = adParamOutput    'HwodhNo
   Else
      Cmd.CommandText = gPublicFunction.GetCallSPString("HwodhREC_UPDATE", 5)
      Cmd(0) = m_HwodhNo
      Cmd(1) = m_HwodhDocno
      Cmd(2) = m_HwodhDat
      Cmd(3) = m_Hwodh_CwqjNo
      Cmd(4) = m_Hwodh_HwIoRcno
      
   End If
   
   gDbCommon.Conn.BeginTrans
   Cmd.Execute
   If m_HwodhId = -1 Then
      m_HwodhNo = Cmd(6)
   End If
   Hwods.Save Me
   gDbCommon.Conn.CommitTrans
   
   If m_HwodhId = -1 Then
      m_HwodhId = 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 "HWODHREC", "HWODHNO", CStr(m_HwodhNo)
   
On Error GoTo Errorhandle
      
   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
   
   Cmd.CommandText = "{CALL HwodHREC_DELETE(?)}"
   Cmd(0) = m_HwodhNo
   
   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 vHwodhDocno As String = "", Optional vHwodhno As Double = 0) As Integer
   Dim mRs As DbRs
   Dim mSqlStr As String
On Error GoTo Errorhandle

   Requery = -1
   
   mSqlStr = "SELECT HwodHTYPE,HwodHDOCNO,HwodHDAT,HwodH_HwIoRcCODE=COALESCE((SELECT HwIoRcCODE FROM HwIoRcREC WHERE HwIoRcNO=HwodH_HwIoRcNO),''),HwodH_HwIoRcNO,"
   mSqlStr = mSqlStr & "Hwodh_CwQjCode=COALESCE((SELECT CWQJCODE FROM CWQJREC WHERE CWQJNO=Hwodh_CwQjno),''),Hwodh_CwQjno,"
   mSqlStr = mSqlStr & "HwodHFORM,HwodHNO FROM HwodHREC WHERE (HwodHDOCNO='" & vHwodhDocno & "' OR HwodHNO=" & CStr(vHwodhno) & ") "
   
   Set mRs = New DbRs
   mRs.Fillbydb mSqlStr
   
   If Not mRs.EOF Then
      Requery = 1
      BatchLet mRs!HwodhType, mRs!HwodhDocno, mRs!HwodhDat, mRs!Hwodh_CwQjCode, mRs!Hwodh_CwqjNo, mRs!Hwodh_HwIoRcCode, mRs!Hwodh_HwIoRcno, mRs!HwodhForm, mRs!HwodhNo
   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_HwodhType = Properties(0)
   m_HwodhDocno = Properties(1)
   m_HwodhDat = Properties(2)
   m_Hwodh_CwqjCode = Properties(3)
   m_Hwodh_CwqjNo = Properties(4)
   m_Hwodh_HwIoRcCode = Properties(5)
   m_Hwodh_HwIoRcno = Properties(6)
   m_HwodhForm = Properties(7)
   m_HwodhNo = Properties(8)

   m_HwodhId = 1

End Sub