hwidh.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 = "HwIdh"
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_HwIds As HwIds

Dim m_HwIdhType As Integer

Dim m_HwIdhDocno As String
Dim m_HwIdhDat As String

Dim m_HwIdh_CwqjCode As String
Dim m_HwIdh_CwqjNo As Double

Dim m_HwIdh_HwIoRcCode As String
Dim m_HwIdh_HwIoRcno As Double

Dim m_HwIdhForm As String

Dim m_HwIdhNo As Double

Dim m_HwIdhId As Integer
Dim m_HwIdhKey As Double

Private Sub Class_Initialize()
   m_HwIdhId = -1
End Sub

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

Public Property Get HwIoRc() As HwIoRc
   If m_HwIoRc Is Nothing Then
      Set m_HwIoRc = New HwIoRc
      If m_HwIdh_HwIoRcCode <> "" Then
         m_HwIoRc.Requery m_HwIdh_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_HwIdh_CwqjCode <> "" Then
         m_CwQj.Requery m_HwIdh_CwqjCode
      End If
   End If
   Set CwQj = m_CwQj
End Property

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

Public Property Get HwIdhId() As Integer
   HwIdhId = m_HwIdhId
End Property

Public Property Get HwIdhKey() As Double
   HwIdhKey = m_HwIdhKey
End Property

Public Property Get HwIdhType() As Integer
   HwIdhType = m_HwIdhType
End Property

Public Property Get HwIdhDocno() As String
   HwIdhDocno = m_HwIdhDocno
End Property

Public Property Get HwIdhDat() As String
   HwIdhDat = m_HwIdhDat
End Property

Public Property Get HwIdh_CwQjCode() As String
   HwIdh_CwQjCode = m_HwIdh_CwqjCode
End Property

Public Property Get HwIdh_CwqjNo() As Double
   HwIdh_CwqjNo = m_HwIdh_CwqjNo
End Property

Public Property Get HwIdh_HwIoRcCode() As String
   HwIdh_HwIoRcCode = m_HwIdh_HwIoRcCode
End Property

Public Property Get HwIdh_HwIoRcno() As Double
   HwIdh_HwIoRcno = m_HwIdh_HwIoRcno
End Property

Public Property Get HwIdhForm() As String
   HwIdhForm = m_HwIdhForm
End Property

Public Property Get HwIdhNo() As Double
   HwIdhNo = m_HwIdhNo
End Property

Public Property Let HwIdhId(vHwIdhId As Integer)
   m_HwIdhId = vHwIdhId
End Property

Public Property Let HwIdhKey(vHwIdhKey As Double)
   m_HwIdhKey = vHwIdhKey
End Property

Public Property Let HwIdhType(vHwIdhType As Integer)

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

Public Property Let HwIdhDocno(vHwIdhDocno As String)

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

Public Property Let HwIdhDat(vHwIdhDat As String)

   If Trim(vHwIdhDat) = "" Then
      Err.Raise vbObjectError + 1, , "入库日期不能为空！"
      Exit Property
   End If
   
   m_HwIdh_CwqjCode = gPublicFunction.GetCwqjCode(vHwIdhDat)
   CwQj.Requery m_HwIdh_CwqjCode
   m_HwIdh_CwqjNo = CwQj.CwQjNo
   m_HwIdhDat = vHwIdhDat
   
End Property

Public Property Let HwIdh_HwIoRcCode(vHwIdh_HwIoRcCode As String)

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

Public Property Let HwIdh_CwQjCode(vHwIdh_CwQjCode As String)

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

Public Property Let HwIdhForm(vHwIdhForm As String)
   m_HwIdhForm = vHwIdhForm
End Property

Public Sub Save()
   Dim Cmd As ADODB.Command
On Error GoTo Errorhandle
      
   If HwIds.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_HwIdhId = -1 Then
      Cmd.CommandText = gPublicFunction.GetCallSPString("HwIdHREC_INSERT", 7)
      Cmd(0) = m_HwIdhType
      Cmd(1) = m_HwIdhDocno
      Cmd(2) = m_HwIdhDat
      Cmd(3) = m_HwIdh_CwqjNo
      Cmd(4) = m_HwIdh_HwIoRcno
      Cmd(5) = m_HwIdhForm
      Cmd(6).Direction = adParamOutput    'HwIdhNo
   Else
      Cmd.CommandText = gPublicFunction.GetCallSPString("HwIdhREC_UPDATE", 5)
      Cmd(0) = m_HwIdhNo
      Cmd(1) = m_HwIdhDocno
      Cmd(2) = m_HwIdhDat
      Cmd(3) = m_HwIdh_CwqjNo
      Cmd(4) = m_HwIdh_HwIoRcno
      
   End If
   
   gDbCommon.Conn.BeginTrans
   Cmd.Execute
   If m_HwIdhId = -1 Then
      m_HwIdhNo = Cmd(6)
   End If
   HwIds.Save Me
   gDbCommon.Conn.CommitTrans
   
   If m_HwIdhId = -1 Then
      m_HwIdhId = 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 "HWIDHREC", "HWIDHNO", CStr(m_HwIdhNo)
   
On Error GoTo Errorhandle
      
   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
   
   Cmd.CommandText = "{CALL HwIdHREC_DELETE(?)}"
   Cmd(0) = m_HwIdhNo
   
   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 vHwIdhDocno As String = "", Optional vHwIdhno As Double = 0) As Integer
   Dim mRs As DbRs
   Dim mSqlStr As String
On Error GoTo Errorhandle

   Requery = -1
   
   mSqlStr = "SELECT HwIdHTYPE,HwIdHDOCNO,HwIdHDAT,"
   mSqlStr = mSqlStr & "HwIdh_CwQjCode=COALESCE((SELECT CWQJCODE FROM CWQJREC WHERE CWQJNO=HwIdh_CwQjno),''),HwIdh_CwQjno,"
   mSqlStr = mSqlStr & "HwIdH_HwIoRcCODE=COALESCE((SELECT HwIoRcCODE FROM HwIoRcREC WHERE HwIoRcNO=HwIdH_HwIoRcNO),''),HwIdH_HwIoRcNO,"
   mSqlStr = mSqlStr & "HwIdHFORM,HwIdHNO FROM HwIdHREC WHERE (HwIdHDOCNO='" & vHwIdhDocno & "' OR HwIdHNO=" & CStr(vHwIdhno) & ") "
   
   Set mRs = New DbRs
   mRs.Fillbydb mSqlStr
   
   If Not mRs.EOF Then
      Requery = 1
      BatchLet mRs!HwIdhType, mRs!HwIdhDocno, mRs!HwIdhDat, mRs!HwIdh_CwQjCode, mRs!HwIdh_CwqjNo, mRs!HwIdh_HwIoRcCode, mRs!HwIdh_HwIoRcno, mRs!HwIdhForm, mRs!HwIdhNo
   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_HwIdhType = Properties(0)
   m_HwIdhDocno = Properties(1)
   m_HwIdhDat = Properties(2)
   m_HwIdh_CwqjCode = Properties(3)
   m_HwIdh_CwqjNo = Properties(4)
   m_HwIdh_HwIoRcCode = Properties(5)
   m_HwIdh_HwIoRcno = Properties(6)
   m_HwIdhForm = Properties(7)
   m_HwIdhNo = Properties(8)

   m_HwIdhId = 1

End Sub