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

Dim m_ScBcds As ScBcds

Dim m_PsBm As PsBm
Dim m_CwQj As CwQj

Dim m_ScBcdhDocno As String
Dim m_ScBcdhDat As String

Dim m_ScBcdh_CwqjCode As String
Dim m_ScBcdh_CwqjNo As Double

Dim m_ScBcdh_PsBmCode As String
Dim m_ScBcdh_PsBmMc As String
Dim m_ScBcdh_PsBmno As Double

Dim m_ScBcdhForm As String

Dim m_ScBcdhNo As Double

Dim m_ScBcdhId As Integer
Dim m_ScBcdhKey As Double

Private Sub Class_Initialize()
   m_ScBcdhId = -1
End Sub

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

Public Property Get PsBm() As PsBm
   If m_PsBm Is Nothing Then
      Set m_PsBm = New PsBm
      If m_ScBcdh_PsBmCode <> "" Then
         m_PsBm.Requery m_ScBcdh_PsBmCode
      End If
   End If
   Set PsBm = m_PsBm
End Property

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

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

Public Property Get ScBcdhId() As Integer
   ScBcdhId = m_ScBcdhId
End Property

Public Property Get ScBcdhKey() As Double
   ScBcdhKey = m_ScBcdhKey
End Property

Public Property Get ScBcdhDocno() As String
   ScBcdhDocno = m_ScBcdhDocno
End Property

Public Property Get ScBcdhDat() As String
   ScBcdhDat = m_ScBcdhDat
End Property

Public Property Get ScBcdh_CwQjCode() As String
   ScBcdh_CwQjCode = m_ScBcdh_CwqjCode
End Property

Public Property Get ScBcdh_CwqjNo() As Double
   ScBcdh_CwqjNo = m_ScBcdh_CwqjNo
End Property

Public Property Get ScBcdh_PsBmCode() As String
   ScBcdh_PsBmCode = m_ScBcdh_PsBmCode
End Property

Public Property Get ScBcdh_PsBmMc() As String
   ScBcdh_PsBmMc = m_ScBcdh_PsBmMc
End Property

Public Property Get ScBcdh_PsBmno() As Double
   ScBcdh_PsBmno = m_ScBcdh_PsBmno
End Property

Public Property Get ScBcdhForm() As String
   ScBcdhForm = m_ScBcdhForm
End Property

Public Property Get ScBcdhNo() As Double
   ScBcdhNo = m_ScBcdhNo
End Property

Public Property Let ScBcdhId(vScBcdhId As Integer)
   m_ScBcdhId = vScBcdhId
End Property

Public Property Let ScBcdhKey(vScBcdhKey As Double)
   m_ScBcdhKey = vScBcdhKey
End Property

Public Property Let ScBcdhDocno(vScBcdhDocno As String)

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

Public Property Let ScBcdhDat(vScBcdhDat As String)

   If Trim(vScBcdhDat) = "" Then
      Err.Raise vbObjectError + 1, , "发料日期不能为空！"
      Exit Property
   End If
   
   m_ScBcdh_CwqjCode = gPublicFunction.GetCwqjCode(vScBcdhDat)
   CwQj.Requery m_ScBcdh_CwqjCode
   m_ScBcdh_CwqjNo = CwQj.CwQjNo
   m_ScBcdhDat = vScBcdhDat
   
End Property

Public Property Let ScBcdh_PsBmCode(vScBcdh_PsBmCode As String)

   If Trim(vScBcdh_PsBmCode) = "" Then
      m_ScBcdh_PsBmno = 0
      m_ScBcdh_PsBmMc = ""
      m_ScBcdh_PsBmCode = ""
      Exit Property
   End If
   
   If m_ScBcdh_PsBmCode <> vScBcdh_PsBmCode Then
      If PsBm.Requery(vScBcdh_PsBmCode) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的部门不存在！"
         Exit Property
      End If
      m_ScBcdh_PsBmno = PsBm.PsBmNo
      m_ScBcdh_PsBmMc = PsBm.PsBmMc
   End If
   
   m_ScBcdh_PsBmCode = vScBcdh_PsBmCode
   
End Property

Public Property Let ScBcdh_CwQjCode(vScBcdh_CwQjCode As String)

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

Public Property Let ScBcdhForm(vScBcdhForm As String)
   m_ScBcdhForm = vScBcdhForm
End Property

Public Sub Save()
   Dim Cmd As ADODB.Command
On Error GoTo ErrorHandle
      
   If ScBcds.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_ScBcdhId = -1 Then
      Cmd.CommandText = gPublicFunction.GetCallSPString("ScBcdHREC_INSERT", 6)
      Cmd(0) = m_ScBcdhDocno
      Cmd(1) = m_ScBcdhDat
      Cmd(2) = m_ScBcdh_CwqjNo
      Cmd(3) = m_ScBcdh_PsBmno
      Cmd(4) = m_ScBcdhForm
      Cmd(5).Direction = adParamOutput     'ScBcdhNo
   Else
      Cmd.CommandText = gPublicFunction.GetCallSPString("ScBcdhREC_UPDATE", 5)
      Cmd(0) = m_ScBcdhNo
      Cmd(1) = m_ScBcdhDocno
      Cmd(2) = m_ScBcdhDat
      Cmd(3) = m_ScBcdh_CwqjNo
      Cmd(4) = m_ScBcdh_PsBmno
      
   End If
   
   gDbCommon.Conn.BeginTrans
   Cmd.Execute
   If m_ScBcdhId = -1 Then
      m_ScBcdhNo = Cmd(5)
   End If
   ScBcds.Save Me
   gDbCommon.Conn.CommitTrans
   
   If m_ScBcdhId = -1 Then
      m_ScBcdhId = 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 "SCBCDHREC", "SCBCDHNO", CStr(m_ScBcdhNo)
   
On Error GoTo ErrorHandle
      
   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
   
   Cmd.CommandText = "{CALL ScBcdHREC_DELETE(?)}"
   Cmd(0) = m_ScBcdhNo
   
   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 vScBcdhDocno As String = "", Optional vScBcdhno As Double = 0) As Integer
   Dim mRs As DbRs
   Dim mSqlStr As String
On Error GoTo ErrorHandle

   Requery = -1
   
   mSqlStr = "SELECT ScBcdHDOCNO,ScBcdHDAT,"
   mSqlStr = mSqlStr & "ScBcdh_CwQjCode=COALESCE((SELECT CWQJCODE FROM CWQJREC WHERE CWQJNO=ScBcdh_CwQjno),''),ScBcdh_CwQjno,"
   mSqlStr = mSqlStr & "ScBcdH_PsBmCODE=COALESCE((SELECT PsBmCODE FROM PsBmREC WHERE PsBmNO=ScBcdH_PsBmNO),''),ScBcdH_PsBmMc=COALESCE((SELECT PsBmMc FROM PsBmREC WHERE PsBmNO=ScBcdH_PsBmNO),''),ScBcdH_PsBmNO,"
   mSqlStr = mSqlStr & "ScBcdHFORM,ScBcdHNO FROM ScBcdHREC WHERE (ScBcdHDOCNO='" & vScBcdhDocno & "' OR ScBcdHNO=" & CStr(vScBcdhno) & ") "
   
   Set mRs = New DbRs
   mRs.Fillbydb mSqlStr
   
   If Not mRs.EOF Then
      Requery = 1
      BatchLet mRs!ScBcdhDocno, mRs!ScBcdhDat, mRs!ScBcdh_CwQjCode, mRs!ScBcdh_CwqjNo, mRs!ScBcdh_PsBmCode, mRs!ScBcdh_PsBmMc, mRs!ScBcdh_PsBmno, mRs!ScBcdhForm, mRs!ScBcdhNo
   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_ScBcdhDocno = Properties(0)
   m_ScBcdhDat = Properties(1)
   m_ScBcdh_CwqjCode = Properties(2)
   m_ScBcdh_CwqjNo = Properties(3)
   m_ScBcdh_PsBmCode = Properties(4)
   m_ScBcdh_PsBmMc = Properties(5)
   m_ScBcdh_PsBmno = Properties(6)
   m_ScBcdhForm = Properties(7)
   m_ScBcdhNo = Properties(8)

   m_ScBcdhId = 1

End Sub