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

Dim m_ScdmFldh As ScdmFldh

Dim m_Scdm As Scdm

Dim m_Hwbm As Hwbm
Dim m_HwCk As HwCk
Dim m_HwDw As HwDw

Dim m_ScdmFld_ScdmFldhno As Double

Dim m_ScdmFld_Scdmno As Double
Dim m_ScdmFld_ScdDocno As String
Dim m_ScdmFld_ScdmQty As Double
Dim m_ScdmFld_ScdmFQty As Double

Dim m_ScdmFld_HwBmCode As String
Dim m_ScdmFld_HwBmMc As String
Dim m_ScdmFld_HwBmno As Double

Dim m_ScdmFld_HwCkMc As String
Dim m_ScdmFld_HwCkno As Double

Dim m_ScdmFld_HwDwCode As String
Dim m_ScdmFld_HwDwNo As Double
Dim m_ScdmFld_HwDwConv As Double

Dim m_ScdmFldQty As Double
Dim m_ScdmFldPrice As Double
Dim m_ScdmFldAmt As Double

Dim m_ScdmFldMioNo As Double

Dim m_ScdmFldBz As String

Dim m_ScdmFldNo As Double

Dim m_ScdmFldId As Integer
Dim m_ScdmFldKey As Double

Private Sub Class_Initialize()
   m_ScdmFldId = -1
End Sub

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

Public Property Get ScdmFldId() As Integer
   ScdmFldId = m_ScdmFldId
End Property

Public Property Let ScdmFldId(vScdmFldId As Integer)
   m_ScdmFldId = vScdmFldId
End Property

Public Property Get ScdmFldKey() As Double
   ScdmFldKey = m_ScdmFldKey
End Property

Public Property Let ScdmFldKey(vScdmFldKey As Double)
   m_ScdmFldKey = vScdmFldKey
End Property

Public Property Get ScdmFldh() As ScdmFldh
   If m_ScdmFldh Is Nothing Then
      Set m_ScdmFldh = New ScdmFldh
      m_ScdmFldh.Requery "", m_ScdmFld_ScdmFldhno
   End If
   Set ScdmFldh = m_ScdmFldh
End Property

Public Property Set ScdmFldh(vScdmFldh As ScdmFldh)
   Set m_ScdmFldh = vScdmFldh
End Property

Public Property Get Scdm() As Scdm
   If m_Scdm Is Nothing Then
      Set m_Scdm = New Scdm
      m_Scdm.Requery m_ScdmFld_Scdmno
   End If
   Set Scdm = m_Scdm
End Property

Public Property Get Hwbm() As Hwbm
   If m_Hwbm Is Nothing Then
      Set m_Hwbm = New Hwbm
      If m_ScdmFld_HwBmCode <> "" Then
         m_Hwbm.Requery m_ScdmFld_HwBmCode
      End If
   End If
   Set Hwbm = m_Hwbm
End Property

Public Property Get HwDw() As HwDw
   If m_HwDw Is Nothing Then
      Set m_HwDw = New HwDw
      If m_ScdmFld_HwDwCode <> "" Then
         m_HwDw.Requery m_ScdmFld_HwDwCode
      End If
   End If
   Set HwDw = m_HwDw
End Property

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

Public Property Get ScdmFld_ScdmFldhno() As Double
   ScdmFld_ScdmFldhno = m_ScdmFld_ScdmFldhno
End Property

Public Property Get ScdmFld_Scdmno() As Double
   ScdmFld_Scdmno = m_ScdmFld_Scdmno
End Property

Public Property Get ScdmFld_ScdDocno() As String
   ScdmFld_ScdDocno = m_ScdmFld_ScdDocno
End Property

Public Property Get ScdmFld_ScdmQty() As Double
   ScdmFld_ScdmQty = m_ScdmFld_ScdmQty
End Property

Public Property Get ScdmFld_ScdmFQty() As Double
   ScdmFld_ScdmFQty = m_ScdmFld_ScdmFQty
End Property

Public Property Get ScdmFld_HwBmCode() As String
   ScdmFld_HwBmCode = m_ScdmFld_HwBmCode
End Property

Public Property Get ScdmFld_HwBmMc() As String
   ScdmFld_HwBmMc = m_ScdmFld_HwBmMc
End Property

Public Property Get ScdmFld_HwBmno() As Double
   ScdmFld_HwBmno = m_ScdmFld_HwBmno
End Property

Public Property Get ScdmFld_HwCkMc() As String
   ScdmFld_HwCkMc = m_ScdmFld_HwCkMc
End Property

Public Property Get ScdmFld_HwCkno() As Double
   ScdmFld_HwCkno = m_ScdmFld_HwCkno
End Property

Public Property Get ScdmFld_HwDwCode() As String
   ScdmFld_HwDwCode = m_ScdmFld_HwDwCode
End Property

Public Property Get ScdmFld_HwDwno() As Double
   ScdmFld_HwDwno = m_ScdmFld_HwDwNo
End Property

Public Property Get ScdmFld_HwDwConv() As Double
   ScdmFld_HwDwConv = m_ScdmFld_HwDwConv
End Property

Public Property Get ScdmFldQty() As Double
   ScdmFldQty = m_ScdmFldQty
End Property

Public Property Get ScdmFldPrice() As Double
   ScdmFldPrice = m_ScdmFldPrice
End Property

Public Property Get ScdmFldAmt() As Double
   ScdmFldAmt = m_ScdmFldAmt
End Property

Public Property Get ScdmFldBz() As String
   ScdmFldBz = m_ScdmFldBz
End Property

Public Property Get ScdmFldMioNo() As Double
   ScdmFldMioNo = m_ScdmFldMioNo
End Property

Public Property Get ScdmFldNo() As Double
   ScdmFldNo = m_ScdmFldNo
End Property

Public Property Let ScdmFld_Scdmno(vScdmFld_Scdmno As Double)
   If vScdmFld_Scdmno = 0 Then
      Err.Raise vbObjectError + 1, , "必须根据工单材料表发料！"
      Exit Property
   End If
   If m_ScdmFld_Scdmno <> vScdmFld_Scdmno Then
      If Scdm.Requery(vScdmFld_Scdmno) = -1 Then
         Err.Raise vbObjectError + 1, , "工单材料表不存在！"
         Exit Property
      End If
      m_ScdmFld_HwBmno = Scdm.Scdm_HwBmno
      m_ScdmFld_HwBmMc = Scdm.Scdm_HwBmMc
      m_ScdmFld_HwDwCode = Scdm.Scdm_HwDwCode
      m_ScdmFld_HwDwNo = Scdm.Scdm_HwDwno
      m_ScdmFld_HwDwConv = Scdm.Scdm_HwDwConv
   End If
   m_ScdmFld_Scdmno = vScdmFld_Scdmno
End Property

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

Public Property Let ScdmFld_HwDwCode(vScdmFld_HwDwCode As String)
   If Trim(vScdmFld_HwDwCode) = "" Then
      Err.Raise vbObjectError + 1, , "计量单位不能为空！"
      Exit Property
   End If
   If m_ScdmFld_HwDwCode <> vScdmFld_HwDwCode Then
      If HwDw.Requery(vScdmFld_HwDwCode) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的计量单位不存在！"
         Exit Property
      End If
      m_ScdmFld_HwDwNo = HwDw.HwDwNo
   End If
   m_ScdmFld_HwDwCode = vScdmFld_HwDwCode
End Property

Public Property Let ScdmFld_HwDwConv(vScdmFld_HwdwConv As Double)
   If vScdmFld_HwdwConv <= 0 Then
      Err.Raise vbObjectError + 1, , "换算系数必须大于零！"
      Exit Property
   End If
   m_ScdmFld_HwDwConv = vScdmFld_HwdwConv
End Property

Public Property Let ScdmFldQty(vScdmFldQty As Double)
   If vScdmFldQty <= 0 Then
      Err.Raise vbObjectError + 1, , "数量必须大于零！"
      Exit Property
   End If
   m_ScdmFldQty = vScdmFldQty
   m_ScdmFldAmt = Val(Format(vScdmFldQty * m_ScdmFldPrice, "##"))
End Property

Public Property Let ScdmFldPrice(vScdmFldPrice As Double)
   If vScdmFldPrice < 0 Then
      Err.Raise vbObjectError + 1, , "单价不能小于零！"
      Exit Property
   End If
   m_ScdmFldPrice = vScdmFldPrice
   m_ScdmFldAmt = Val(Format(vScdmFldPrice * m_ScdmFldQty, "##"))
End Property

Public Property Let ScdmFldAmt(vScdmFldAmt As Double)
   If vScdmFldAmt < 0 Then
      Err.Raise vbObjectError + 1, , "金额不能小于零！"
      Exit Property
   End If
   m_ScdmFldAmt = vScdmFldAmt
End Property

Public Property Let ScdmFldBz(vScdmFldDBz As String)
   m_ScdmFldBz = vScdmFldDBz
End Property

Public Sub Save()
   Dim Cmd As ADODB.Command
On Error GoTo ErrorHandle
      
   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
            
   If m_ScdmFldId = -1 Then
      Cmd.CommandText = gPublicFunction.GetCallSPString("SCDMFLDREC_INSERT", 12)
      Cmd(0) = m_ScdmFldh.ScdmFldhNo
      Cmd(1) = m_ScdmFld_Scdmno
      Cmd(2) = m_ScdmFld_HwBmno
      Cmd(3) = m_ScdmFld_HwDwNo
      Cmd(4) = m_ScdmFld_HwDwConv
      Cmd(5) = m_ScdmFld_HwCkno
      Cmd(6) = m_ScdmFldQty
      Cmd(7) = m_ScdmFldPrice
      Cmd(8) = m_ScdmFldAmt
      Cmd(9) = m_ScdmFldBz
      Cmd(10).Direction = adParamOutput 'ScdmFldMiono
      Cmd(11).Direction = adParamOutput    'ScdmFldNo
   Else
      Cmd.CommandText = gPublicFunction.GetCallSPString("SCDMFLDREC_UPDATE", 9)
      Cmd(0) = m_ScdmFldNo
      Cmd(1) = m_ScdmFld_HwBmno
      Cmd(2) = m_ScdmFld_HwDwNo
      Cmd(3) = m_ScdmFld_HwDwConv
      Cmd(4) = m_ScdmFld_HwCkno
      Cmd(5) = m_ScdmFldQty
      Cmd(6) = m_ScdmFldPrice
      Cmd(7) = m_ScdmFldAmt
      Cmd(8) = m_ScdmFldBz
   End If
   
   Cmd.Execute
   
   If m_ScdmFldId = -1 Then
      m_ScdmFldMioNo = Cmd(10)
      m_ScdmFldNo = Cmd(11)
      m_ScdmFldId = 1
   End If
   
   Set Cmd = Nothing
   
Exit Sub
ErrorHandle:
   Set Cmd = Nothing
   Err.Raise vbObjectError + 1, , gDbCommon.Conn.Errors(0)
End Sub

Public Sub Del()
   Dim Cmd As ADODB.Command
   
   gPublicFunction.CheckCanBeDelete "SCDMFLDREC", "SCDMFLDNO", CStr(m_ScdmFldNo)
   
On Error GoTo ErrorHandle

   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
      
   Cmd.CommandText = "{CALL SCDMFLDREC_DELETE(?)}"
   Cmd(0) = m_ScdmFldNo
   
   gDbCommon.Conn.BeginTrans
   Cmd.Execute
   If ScdmFldh.ScdmFlds.Count = 1 Then
      ScdmFldh.Del 1
   End If
   gDbCommon.Conn.CommitTrans
   
   Set Cmd = Nothing
   
Exit Sub
ErrorHandle:
   Set Cmd = Nothing
   gDbCommon.Conn.RollbackTrans
   Err.Raise vbObjectError + 1, , gDbCommon.Conn.Errors(0)
End Sub

Public Function Requery(vScdmFldNo As Double) As Integer
   Dim mRs As DbRs
   Dim mSqlStr As String
On Error GoTo ErrorHandle
   
   Requery = -1
   
   Set mRs = New DbRs
   
   mSqlStr = "SELECT ScdmFld_ScdmFldHNO,SCDMFLD_SCDDOCNO=COALESCE((SELECT SCDDOCNO FROM SCDREC,SCDMREC WHERE SCDMNO=SCFLD_SCDMNO AND SCDNO=SCDM_SCDNO),''),SCDMFLD_SCDMNO,"
   mSqlStr = mSqlStr & "SCDMFLD_SCDMQTY=COALESCE((SELECT SCDMQTY FROM SCDMREC WHERE SCDMNO=SCFLD_SCDMNO),0),SCDMFLD_SCDMFQTY=COALESCE((SELECT SCDMFQTY FROM SCDMREC WHERE SCDMNO=SCFLD_SCDMNO),0),"
   mSqlStr = mSqlStr & "ScdmFld_HwBmCode=COALESCE((SELECT HwBmCode FROM HWBMREC WHERE HWBMNO=ScdmFld_HWBMNO),''),ScdmFld_HwBmMc=COALESCE((SELECT HwBmMc FROM HWBMREC WHERE HWBMNO=ScdmFld_HWBMNO),''),ScdmFld_HWBMNO,"
   mSqlStr = mSqlStr & "ScdmFld_HwCkMc=COALESCE((SELECT HwCkMc FROM HWCKREC WHERE HWCKNO=ScdmFld_HWCKNO),''),ScdmFld_HWCKNO,"
   mSqlStr = mSqlStr & "ScdmFld_HwDwCode=COALESCE((SELECT HWDWCode FROM HWDWREC WHERE HWDWNO=ScdmFld_HWDWNO),''),ScdmFld_HWDWNO,ScdmFld_HWDWCONV,"
   mSqlStr = mSqlStr & "ScdmFldQTY,ScdmFldPRICE,ScdmFldAMT,ScdmFldBZ,ScdmFldMIONO,ScdmFldNO FROM ScdmFldREC WHERE ScdmFldNO=" & CStr(vScdmFldNo)
   
   mRs.Fillbydb mSqlStr
   
   If Not mRs.EOF Then
      Requery = 1
      BatchLet mRs!ScdmFld_ScdmFldhno, mRs!ScdmFld_Scdmno, mRs!ScdmFld_ScdDocno, mRs!ScdmFld_HwBmCode, mRs!ScdmFld_HwBmMc, mRs!ScdmFld_HwBmno, _
               mRs!ScdmFld_HwCkMc, mRs!ScdmFld_HwCkno, mRs!ScdmFld_HwDwCode, mRs!ScdmFld_HwDwno, mRs!ScdmFld_HwDwConv, _
               mRs!ScdmFld_ScdmQty, mRs!ScdmFld_ScdmFQty, mRs!ScdmFldQty, mRs!ScdmFldPrice, mRs!ScdmFldAmt, mRs!ScdmFldBz, mRs!ScdmFldMioNo, mRs!ScdmFldNo
   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_ScdmFld_ScdmFldhno = Properties(0)
   m_ScdmFld_Scdmno = Properties(1)
   
   m_ScdmFld_ScdDocno = Properties(2)
   
   m_ScdmFld_HwBmCode = Properties(3)
   m_ScdmFld_HwBmMc = Properties(4)
   m_ScdmFld_HwBmno = Properties(5)
   
   m_ScdmFld_HwCkMc = Properties(6)
   m_ScdmFld_HwCkno = Properties(7)
   
   m_ScdmFld_HwDwCode = Properties(8)
   m_ScdmFld_HwDwNo = Properties(9)
   m_ScdmFld_HwDwConv = Properties(10)
   
   m_ScdmFld_ScdmQty = Properties(11)
   m_ScdmFld_ScdmFQty = Properties(12)
   
   m_ScdmFldQty = Properties(13)
   m_ScdmFldPrice = Properties(14)
   m_ScdmFldAmt = Properties(15)
   m_ScdmFldBz = Properties(16)
   
   m_ScdmFldMioNo = Properties(17)
   m_ScdmFldNo = Properties(18)

   m_ScdmFldId = 1

End Sub