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

Dim m_HwBfRc As HwBfRc
Dim m_CwQj As CwQj
Dim m_HwCk As HwCk

Dim m_HwBfds As HwBfds

Dim m_HwBfdhDocno As String
Dim m_HwBfdhDat As String

Dim m_HwBfdh_CwqjCode As String
Dim m_HwBfdh_CwqjNo As Double

Dim m_HwBfdh_HwBfRcCode As String
Dim m_HwBfdh_HwBfRcno As Double

Dim m_HwBfdh_HwCkMc As String
Dim m_HwBfdh_HwCkno As Double

Dim m_HwBfdhForm As String

Dim m_HwBfdhNo As Double

Dim m_HwBfdhId As Integer
Dim m_HwBfdhKey As Double

Private Sub Class_Initialize()
   m_HwBfdhId = -1
End Sub

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

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

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

Public Property Get HwBfRc() As HwBfRc
   If m_HwBfRc Is Nothing Then
      Set m_HwBfRc = New HwBfRc
      If m_HwBfdh_HwBfRcCode <> "" Then
         m_HwBfRc.Requery m_HwBfdh_HwBfRcCode
      End If
   End If
   Set HwBfRc = m_HwBfRc
End Property

Public Property Get HwCk() As HwCk
   If m_HwCk Is Nothing Then
      Set m_HwCk = New HwCk
      If m_HwBfdh_HwCkMc <> "" Then
         m_HwCk.Requery m_HwBfdh_HwCkMc
      End If
   End If
   Set HwCk = m_HwCk
End Property

Public Property Get HwBfdhId() As Integer
   HwBfdhId = m_HwBfdhId
End Property

Public Property Get HwBfdhKey() As Double
   HwBfdhKey = m_HwBfdhKey
End Property

Public Property Get HwBfdhDocno() As String
   HwBfdhDocno = m_HwBfdhDocno
End Property

Public Property Get HwBfdhDat() As String
   HwBfdhDat = m_HwBfdhDat
End Property

Public Property Get HwBfdh_CwQjCode() As String
   HwBfdh_CwQjCode = m_HwBfdh_CwqjCode
End Property

Public Property Get HwBfdh_CwqjNo() As Double
   HwBfdh_CwqjNo = m_HwBfdh_CwqjNo
End Property

Public Property Get HwBfdh_HwBfRcCode() As String
   HwBfdh_HwBfRcCode = m_HwBfdh_HwBfRcCode
End Property

Public Property Get HwBfdh_HwBfRcno() As Double
   HwBfdh_HwBfRcno = m_HwBfdh_HwBfRcno
End Property

Public Property Get HwBfdh_HwCkMc() As String
   HwBfdh_HwCkMc = m_HwBfdh_HwCkMc
End Property

Public Property Get HwBfdh_HwCkno() As Double
   HwBfdh_HwCkno = m_HwBfdh_HwCkno
End Property

Public Property Get HwBfdhForm() As String
   HwBfdhForm = m_HwBfdhForm
End Property

Public Property Get HwBfdhNo() As Double
   HwBfdhNo = m_HwBfdhNo
End Property

Public Property Let HwBfdhId(vHwBfdhId As Integer)
   m_HwBfdhId = vHwBfdhId
End Property

Public Property Let HwBfdhKey(vHwBfdhKey As Double)
   m_HwBfdhKey = vHwBfdhKey
End Property

Public Property Let HwBfdhDocno(vHwBfdhDocno As String)

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

Public Property Let HwBfdhDat(vHwBfdhDat As String)

   If Trim(vHwBfdhDat) = "" Then
      Err.Raise vbObjectError + 1, , "日期不能为空！"
      Exit Property
   End If
   
   m_HwBfdh_CwqjCode = gPublicFunction.GetCwqjCode(vHwBfdhDat)
   CwQj.Requery m_HwBfdh_CwqjCode
   m_HwBfdh_CwqjNo = CwQj.CwQjNo
   m_HwBfdhDat = vHwBfdhDat
   
End Property

Public Property Let HwBfdh_CwQjCode(vHwBfdh_CwQjCode As String)

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

Public Property Let HwBfdh_HwBfRcCode(vHwBfdh_HwBfRcCode As String)

   If Trim(vHwBfdh_HwBfRcCode) = "" Then
      Err.Raise vbObjectError + 1, , "盘点原因不能为空！"
      Exit Property
   End If
   
   If m_HwBfdh_HwBfRcCode <> vHwBfdh_HwBfRcCode Then
      If HwBfRc.Requery(vHwBfdh_HwBfRcCode) = -1 Then
         Err.Raise vbObjectError + 1, , "盘点原因不存在！"
         Exit Property
      End If
      m_HwBfdh_HwBfRcno = HwBfRc.HwBfRcNo
   End If
   
   m_HwBfdh_HwBfRcCode = vHwBfdh_HwBfRcCode
   
End Property

Public Property Let HwBfdh_HwCkMc(vHwBfdh_HwCkMc As String)
   If Trim(vHwBfdh_HwCkMc) = "" Then
      Err.Raise vbObjectError + 1, , "仓库不能为空！"
      Exit Property
   End If
   If m_HwBfdh_HwCkMc <> vHwBfdh_HwCkMc Then
      If HwCk.Requery(vHwBfdh_HwCkMc) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的仓库不存在！"
         Exit Property
      End If
      m_HwBfdh_HwCkno = HwCk.HwCkNo
   End If
   m_HwBfdh_HwCkMc = vHwBfdh_HwCkMc
End Property

Public Property Let HwBfdhForm(vHwBfdhForm As String)
   m_HwBfdhForm = vHwBfdhForm
End Property

Public Sub Save()
   Dim Cmd As ADODB.Command
On Error GoTo Errorhandle
      
   If HwBfds.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_HwBfdhId = -1 Then
      Cmd.CommandText = gPublicFunction.GetCallSPString("HwBfdHREC_INSERT", 7)
      Cmd(0) = m_HwBfdhDocno
      Cmd(1) = m_HwBfdhDat
      Cmd(2) = m_HwBfdh_CwqjNo
      Cmd(3) = m_HwBfdh_HwBfRcno
      Cmd(4) = m_HwBfdh_HwCkno
      Cmd(5) = m_HwBfdhForm
      Cmd(6).Direction = adParamOutput    'HwBfdhNo
   Else
      Cmd.CommandText = gPublicFunction.GetCallSPString("HwBfdhREC_UPDATE", 6)
      Cmd(0) = m_HwBfdhNo
      Cmd(1) = m_HwBfdhDocno
      Cmd(2) = m_HwBfdhDat
      Cmd(3) = m_HwBfdh_CwqjNo
      Cmd(4) = m_HwBfdh_HwBfRcno
      Cmd(5) = m_HwBfdh_HwCkno
      
   End If
   
   gDbCommon.Conn.BeginTrans
   Cmd.Execute
   If m_HwBfdhId = -1 Then
      m_HwBfdhNo = Cmd(6)
   End If
   HwBfds.Save Me
   gDbCommon.Conn.CommitTrans
   
   If m_HwBfdhId = -1 Then
      m_HwBfdhId = 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 "HWBFDHREC", "HWBFDHNO", CStr(m_HwBfdhNo)
   
On Error GoTo Errorhandle
      
   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
   
   Cmd.CommandText = "{CALL HwBfdHREC_DELETE(?)}"
   Cmd(0) = m_HwBfdhNo
   
   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 vHwBfdhDocno As String = "", Optional vHwBfdhno As Double = 0) As Integer
   Dim mRs As DbRs
   Dim mSqlStr As String
On Error GoTo Errorhandle

   Requery = -1
   
   mSqlStr = "SELECT HwBfdHDOCNO,HwBfdHDAT,HwBfdh_CwQjCode=COALESCE((SELECT CWQJCODE FROM CWQJREC WHERE CWQJNO=HwBfdh_CwQjno),''),HwBfdh_CwQjno,"
   mSqlStr = mSqlStr & "HwBfdH_HwBfRcCODE=COALESCE((SELECT HwBfRcCODE FROM HwBfRcREC WHERE HwBfRcNO=HwBfdH_HwBfRcNO),''),HwBfdH_HwBfRcNO,"
   mSqlStr = mSqlStr & "HwBfdH_HwCkMc=COALESCE((SELECT HwCkMc FROM HwCkREC WHERE HwCkNO=HwBfdH_HwCkNO),''),HwBfdH_HwCkNO,"
   mSqlStr = mSqlStr & "HwBfdHFORM,HwBfdHNO FROM HwBfdHREC WHERE (HwBfdHDOCNO='" & vHwBfdhDocno & "' OR HwBfdHNO=" & CStr(vHwBfdhno) & ") "
   
   Set mRs = New DbRs
   mRs.Fillbydb mSqlStr
   
   If Not mRs.EOF Then
      Requery = 1
      BatchLet mRs!HwBfdhDocno, mRs!HwBfdhDat, mRs!HwBfdh_CwQjCode, mRs!HwBfdh_CwqjNo, mRs!HwBfdh_HwBfRcCode, mRs!HwBfdh_HwBfRcno, mRs!HwBfdh_HwCkMc, mRs!HwBfdh_HwCkno, mRs!HwBfdhForm, mRs!HwBfdhNo
   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_HwBfdhDocno = Properties(0)
   m_HwBfdhDat = Properties(1)
   m_HwBfdh_CwqjCode = Properties(2)
   m_HwBfdh_CwqjNo = Properties(3)
   m_HwBfdh_HwBfRcCode = Properties(4)
   m_HwBfdh_HwBfRcno = Properties(5)
   m_HwBfdh_HwCkMc = Properties(6)
   m_HwBfdh_HwCkno = Properties(7)
   m_HwBfdhForm = Properties(8)
   m_HwBfdhNo = Properties(9)

   m_HwBfdhId = 1

End Sub