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

Dim m_ScdmFlds As ScdmFlds

Dim m_PsBm As PsBm
Dim m_CwQj As CwQj

Dim m_ScdmFldhType As Integer

Dim m_ScdmFldhDocno As String
Dim m_ScdmFldhDat As String

Dim m_ScdmFldh_CwqjCode As String
Dim m_ScdmFldh_CwqjNo As Double

Dim m_ScdmFldh_PsBmCode As String
Dim m_ScdmFldh_PsBmMc As String
Dim m_ScdmFldh_PsBmno As Double

Dim m_ScdmFldhForm As String

Dim m_ScdmFldhNo As Double

Dim m_ScdmFldhId As Integer
Dim m_ScdmFldhKey As Double

Private Sub Class_Initialize()
   m_ScdmFldhId = -1
End Sub

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

Public Property Get PsBm() As PsBm
   If m_PsBm Is Nothing Then
      Set m_PsBm = New PsBm
      If m_ScdmFldh_PsBmCode <> "" Then
         m_PsBm.Requery m_ScdmFldh_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_ScdmFldh_CwqjCode <> "" Then
         m_CwQj.Requery m_ScdmFldh_CwqjCode
      End If
   End If
   Set CwQj = m_CwQj
End Property

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

Public Property Get ScdmFldhId() As Integer
   ScdmFldhId = m_ScdmFldhId
End Property

Public Property Get ScdmFldhKey() As Double
   ScdmFldhKey = m_ScdmFldhKey
End Property

Public Property Get ScdmFldhType() As Integer
   ScdmFldhType = m_ScdmFldhType
End Property

Public Property Get ScdmFldhDocno() As String
   ScdmFldhDocno = m_ScdmFldhDocno
End Property

Public Property Get ScdmFldhDat() As String
   ScdmFldhDat = m_ScdmFldhDat
End Property

Public Property Get ScdmFldh_CwQjCode() As String
   ScdmFldh_CwQjCode = m_ScdmFldh_CwqjCode
End Property

Public Property Get ScdmFldh_CwqjNo() As Double
   ScdmFldh_CwqjNo = m_ScdmFldh_CwqjNo
End Property

Public Property Get ScdmFldh_PsBmCode() As String
   ScdmFldh_PsBmCode = m_ScdmFldh_PsBmCode
End Property

Public Property Get ScdmFldh_PsBmMc() As String
   ScdmFldh_PsBmMc = m_ScdmFldh_PsBmMc
End Property

Public Property Get ScdmFldh_PsBmno() As Double
   ScdmFldh_PsBmno = m_ScdmFldh_PsBmno
End Property

Public Property Get ScdmFldhForm() As String
   ScdmFldhForm = m_ScdmFldhForm
End Property

Public Property Get ScdmFldhNo() As Double
   ScdmFldhNo = m_ScdmFldhNo
End Property

Public Property Let ScdmFldhId(vScdmFldhId As Integer)
   m_ScdmFldhId = vScdmFldhId
End Property

Public Property Let ScdmFldhKey(vScdmFldhKey As Double)
   m_ScdmFldhKey = vScdmFldhKey
End Property

Public Property Let ScdmFldhType(vScdmFldhType As Integer)

   If vScdmFldhType <> 1 And vScdmFldhType <> 2 Then
      Err.Raise vbObjectError + 1, , "类型只能为1-领料单，2-退料单！"
      Exit Property
   End If
   
   m_ScdmFldhType = vScdmFldhType
   
End Property

Public Property Let ScdmFldhDocno(vScdmFldhDocno As String)

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

Public Property Let ScdmFldhDat(vScdmFldhDat As String)

   If Trim(vScdmFldhDat) = "" Then
      Err.Raise vbObjectError + 1, , "发料日期不能为空！"
      Exit Property
   End If
   
   m_ScdmFldh_CwqjCode = gPublicFunction.GetCwqjCode(vScdmFldhDat)
   CwQj.Requery m_ScdmFldh_CwqjCode
   m_ScdmFldh_CwqjNo = CwQj.CwQjNo
   m_ScdmFldhDat = vScdmFldhDat
   
End Property

Public Property Let ScdmFldh_PsBmCode(vScdmFldh_PsBmCode As String)

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

Public Property Let ScdmFldh_CwQjCode(vScdmFldh_CwQjCode As String)

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

Public Property Let ScdmFldhForm(vScdmFldhForm As String)
   m_ScdmFldhForm = vScdmFldhForm
End Property

Public Sub Save()
   Dim Cmd As ADODB.Command
On Error GoTo ErrorHandle
      
   If ScdmFlds.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_ScdmFldhId = -1 Then
      Cmd.CommandText = gPublicFunction.GetCallSPString("ScdmFldHREC_INSERT", 7)
      Cmd(0) = m_ScdmFldhType
      Cmd(1) = m_ScdmFldhDocno
      Cmd(2) = m_ScdmFldhDat
      Cmd(3) = m_ScdmFldh_CwqjNo
      Cmd(4) = m_ScdmFldh_PsBmno
      Cmd(5) = m_ScdmFldhForm
      Cmd(6).Direction = adParamOutput    'ScdmFldhNo
   Else
      Cmd.CommandText = gPublicFunction.GetCallSPString("ScdmFldhREC_UPDATE", 5)
      Cmd(0) = m_ScdmFldhNo
      Cmd(1) = m_ScdmFldhDocno
      Cmd(2) = m_ScdmFldhDat
      Cmd(3) = m_ScdmFldh_CwqjNo
      Cmd(4) = m_ScdmFldh_PsBmno
      
   End If
   
   gDbCommon.Conn.BeginTrans
   Cmd.Execute
   If m_ScdmFldhId = -1 Then
      m_ScdmFldhNo = Cmd(6)
   End If
   ScdmFlds.Save Me
   gDbCommon.Conn.CommitTrans
   
   If m_ScdmFldhId = -1 Then
      m_ScdmFldhId = 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 "SCDMFLDHREC", "SCDMFLDHNO", CStr(m_ScdmFldhNo)
   
On Error GoTo ErrorHandle
      
   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
   
   Cmd.CommandText = "{CALL ScdmFldHREC_DELETE(?)}"
   Cmd(0) = m_ScdmFldhNo
   
   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 vScdmFldhDocno As String = "", Optional vScdmFldhno As Double = 0) As Integer
   Dim mRs As DbRs
   Dim mSqlStr As String
On Error GoTo ErrorHandle

   Requery = -1
   
   mSqlStr = "SELECT ScdmFldHTYPE,ScdmFldHDOCNO,ScdmFldHDAT,"
   mSqlStr = mSqlStr & "ScdmFldh_CwQjCode=COALESCE((SELECT CWQJCODE FROM CWQJREC WHERE CWQJNO=ScdmFldh_CwQjno),''),ScdmFldh_CwQjno,"
   mSqlStr = mSqlStr & "ScdmFldH_PsBmCODE=COALESCE((SELECT PsBmCODE FROM PsBmREC WHERE PsBmNO=ScdmFldH_PsBmNO),''),ScdmFldH_PsBmMc=COALESCE((SELECT PsBmMc FROM PsBmREC WHERE PsBmNO=ScdmFldH_PsBmNO),''),ScdmFldH_PsBmNO,"
   mSqlStr = mSqlStr & "ScdmFldHFORM,ScdmFldHNO FROM ScdmFldHREC WHERE (ScdmFldHDOCNO='" & vScdmFldhDocno & "' OR ScdmFldHNO=" & CStr(vScdmFldhno) & ") "
   
   Set mRs = New DbRs
   mRs.Fillbydb mSqlStr
   
   If Not mRs.EOF Then
      Requery = 1
      BatchLet mRs!ScdmFldhType, mRs!ScdmFldhDocno, mRs!ScdmFldhDat, mRs!ScdmFldh_CwQjCode, mRs!ScdmFldh_CwqjNo, mRs!ScdmFldh_PsBmCode, mRs!ScdmFldh_PsBmMc, mRs!ScdmFldh_PsBmno, mRs!ScdmFldhForm, mRs!ScdmFldhNo
   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_ScdmFldhType = Properties(0)
   m_ScdmFldhDocno = Properties(1)
   m_ScdmFldhDat = Properties(2)
   m_ScdmFldh_CwqjCode = Properties(3)
   m_ScdmFldh_CwqjNo = Properties(4)
   m_ScdmFldh_PsBmCode = Properties(5)
   m_ScdmFldh_PsBmMc = Properties(6)
   m_ScdmFldh_PsBmno = Properties(7)
   m_ScdmFldhForm = Properties(8)
   m_ScdmFldhNo = Properties(9)

   m_ScdmFldhId = 1

End Sub