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

Dim m_HwPdRc As HwPdRc
Dim m_CwQj As CwQj
Dim m_HwCk As HwCk

Dim m_HwPdds As HwPdds

Dim m_HwPddhDocno As String
Dim m_HwPddhDat As String

Dim m_HwPddh_CwqjCode As String
Dim m_HwPddh_CwqjNo As Double

Dim m_HwPddh_HwPdRcCode As String
Dim m_HwPddh_HwPdRcno As Double

Dim m_HwPddh_HwCkMc As String
Dim m_HwPddh_HwCkno As Double

Dim m_HwPddhForm As String

Dim m_HwPddhNo As Double

Dim m_HwPddhId As Integer
Dim m_HwPddhKey As Double

Private Sub Class_Initialize()
   m_HwPddhId = -1
End Sub

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

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

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

Public Property Get HwPdRc() As HwPdRc
   If m_HwPdRc Is Nothing Then
      Set m_HwPdRc = New HwPdRc
      If m_HwPddh_HwPdRcCode <> "" Then
         m_HwPdRc.Requery m_HwPddh_HwPdRcCode
      End If
   End If
   Set HwPdRc = m_HwPdRc
End Property

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

Public Property Get HwPddhId() As Integer
   HwPddhId = m_HwPddhId
End Property

Public Property Get HwPddhKey() As Double
   HwPddhKey = m_HwPddhKey
End Property

Public Property Get HwPddhDocno() As String
   HwPddhDocno = m_HwPddhDocno
End Property

Public Property Get HwPddhDat() As String
   HwPddhDat = m_HwPddhDat
End Property

Public Property Get HwPddh_CwQjCode() As String
   HwPddh_CwQjCode = m_HwPddh_CwqjCode
End Property

Public Property Get HwPddh_CwqjNo() As Double
   HwPddh_CwqjNo = m_HwPddh_CwqjNo
End Property

Public Property Get HwPddh_HwPdRcCode() As String
   HwPddh_HwPdRcCode = m_HwPddh_HwPdRcCode
End Property

Public Property Get HwPddh_HwPdRcno() As Double
   HwPddh_HwPdRcno = m_HwPddh_HwPdRcno
End Property

Public Property Get HwPddh_HwCkMc() As String
   HwPddh_HwCkMc = m_HwPddh_HwCkMc
End Property

Public Property Get HwPddh_HwCkno() As Double
   HwPddh_HwCkno = m_HwPddh_HwCkno
End Property

Public Property Get HwPddhForm() As String
   HwPddhForm = m_HwPddhForm
End Property

Public Property Get HwPddhNo() As Double
   HwPddhNo = m_HwPddhNo
End Property

Public Property Let HwPddhId(vHwPddhId As Integer)
   m_HwPddhId = vHwPddhId
End Property

Public Property Let HwPddhKey(vHwPddhKey As Double)
   m_HwPddhKey = vHwPddhKey
End Property

Public Property Let HwPddhDocno(vHwPddhDocno As String)

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

Public Property Let HwPddhDat(vHwPddhDat As String)

   If Trim(vHwPddhDat) = "" Then
      Err.Raise vbObjectError + 1, , "日期不能为空！"
      Exit Property
   End If
   
   m_HwPddh_CwqjCode = gPublicFunction.GetCwqjCode(vHwPddhDat)
   CwQj.Requery m_HwPddh_CwqjCode
   m_HwPddh_CwqjNo = CwQj.CwQjNo
   m_HwPddhDat = vHwPddhDat
   
End Property

Public Property Let HwPddh_CwQjCode(vHwPddh_CwQjCode As String)

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

Public Property Let HwPddh_HwPdRcCode(vHwPddh_HwPdRcCode As String)

   If Trim(vHwPddh_HwPdRcCode) = "" Then
      Err.Raise vbObjectError + 1, , "盘点原因不能为空！"
      Exit Property
   End If
   
   If m_HwPddh_HwPdRcCode <> vHwPddh_HwPdRcCode Then
      If HwPdRc.Requery(vHwPddh_HwPdRcCode) = -1 Then
         Err.Raise vbObjectError + 1, , "盘点原因不存在！"
         Exit Property
      End If
      m_HwPddh_HwPdRcno = HwPdRc.HwPdRcNo
   End If
   
   m_HwPddh_HwPdRcCode = vHwPddh_HwPdRcCode
   
End Property

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

Public Property Let HwPddhForm(vHwPddhForm As String)
   m_HwPddhForm = vHwPddhForm
End Property

Public Sub Save()
   Dim Cmd As ADODB.Command
On Error GoTo Errorhandle
      
   If HwPdds.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_HwPddhId = -1 Then
      Cmd.CommandText = gPublicFunction.GetCallSPString("HwPddHREC_INSERT", 7)
      Cmd(0) = m_HwPddhDocno
      Cmd(1) = m_HwPddhDat
      Cmd(2) = m_HwPddh_CwqjNo
      Cmd(3) = m_HwPddh_HwPdRcno
      Cmd(4) = m_HwPddh_HwCkno
      Cmd(5) = m_HwPddhForm
      Cmd(6).Direction = adParamOutput    'HwPddhNo
   Else
      Cmd.CommandText = gPublicFunction.GetCallSPString("HwPddhREC_UPDATE", 6)
      Cmd(0) = m_HwPddhNo
      Cmd(1) = m_HwPddhDocno
      Cmd(2) = m_HwPddhDat
      Cmd(3) = m_HwPddh_CwqjNo
      Cmd(4) = m_HwPddh_HwPdRcno
      Cmd(5) = m_HwPddh_HwCkno
      
   End If
   
   gDbCommon.Conn.BeginTrans
   Cmd.Execute
   If m_HwPddhId = -1 Then
      m_HwPddhNo = Cmd(6)
   End If
   HwPdds.Save Me
   gDbCommon.Conn.CommitTrans
   
   If m_HwPddhId = -1 Then
      m_HwPddhId = 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 "HWPDDHREC", "HWPDDHNO", CStr(m_HwPddhNo)
   
On Error GoTo Errorhandle
      
   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
   
   Cmd.CommandText = "{CALL HwPddHREC_DELETE(?)}"
   Cmd(0) = m_HwPddhNo
   
   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 vHwPddhDocno As String = "", Optional vHwPddhno As Double = 0) As Integer
   Dim mRs As DbRs
   Dim mSqlStr As String
On Error GoTo Errorhandle

   Requery = -1
   
   mSqlStr = "SELECT HwPddHDOCNO,HwPddHDAT,HwPddh_CwQjCode=COALESCE((SELECT CWQJCODE FROM CWQJREC WHERE CWQJNO=HwPddh_CwQjno),''),HwPddh_CwQjno,"
   mSqlStr = mSqlStr & "HwPddH_HwPdRcCODE=COALESCE((SELECT HwPdRcCODE FROM HwPdRcREC WHERE HwPdRcNO=HwPddH_HwPdRcNO),''),HwPddH_HwPdRcNO,"
   mSqlStr = mSqlStr & "HwPddH_HwCkMc=COALESCE((SELECT HwCkMc FROM HwCkREC WHERE HwCkNO=HwPddH_HwCkNO),''),HwPddH_HwCkNO,"
   mSqlStr = mSqlStr & "HwPddHFORM,HwPddHNO FROM HwPddHREC WHERE (HwPddHDOCNO='" & vHwPddhDocno & "' OR HwPddHNO=" & CStr(vHwPddhno) & ") "
   
   Set mRs = New DbRs
   mRs.Fillbydb mSqlStr
   
   If Not mRs.EOF Then
      Requery = 1
      BatchLet mRs!HwPddhDocno, mRs!HwPddhDat, mRs!HwPddh_CwQjCode, mRs!HwPddh_CwqjNo, mRs!HwPddh_HwPdRcCode, mRs!HwPddh_HwPdRcno, mRs!HwPddh_HwCkMc, mRs!HwPddh_HwCkno, mRs!HwPddhForm, mRs!HwPddhNo
   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_HwPddhDocno = Properties(0)
   m_HwPddhDat = Properties(1)
   m_HwPddh_CwqjCode = Properties(2)
   m_HwPddh_CwqjNo = Properties(3)
   m_HwPddh_HwPdRcCode = Properties(4)
   m_HwPddh_HwPdRcno = Properties(5)
   m_HwPddh_HwCkMc = Properties(6)
   m_HwPddh_HwCkno = Properties(7)
   m_HwPddhForm = Properties(8)
   m_HwPddhNo = Properties(9)

   m_HwPddhId = 1

End Sub