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

Dim m_Scd As Scd

Dim m_Hwbm As Hwbm
Dim m_HwDw As HwDw

Dim m_Scdm_Scdno As Double

Dim m_Scdm_HwBmCode As String
Dim m_Scdm_HwBmMc As String
Dim m_Scdm_HwBmno As Double

Dim m_Scdm_HwDwCode As String
Dim m_Scdm_HwDwNo As Double
Dim m_Scdm_HwDwConv As Double

Dim m_ScdmDwQty As Double
Dim m_ScdmDwShl As Double

Dim m_ScdmQty As Double
Dim m_ScdmFQty As Double

Dim m_ScdmBz As String

Dim m_ScdmNo As Double

Dim m_ScdmId As Integer
Dim m_ScdmKey As Double

Private Sub Class_Initialize()
   m_ScdmId = -1
End Sub

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

Public Property Get ScdmId() As Integer
   ScdmId = m_ScdmId
End Property

Public Property Let ScdmId(vScdmId As Integer)
   m_ScdmId = vScdmId
End Property

Public Property Get ScdmKey() As Double
   ScdmKey = m_ScdmKey
End Property

Public Property Let ScdmKey(vScdmKey As Double)
   m_ScdmKey = vScdmKey
End Property

Public Property Get Scd() As Scd
   If m_Scd Is Nothing Then
      Set m_Scd = New Scd
      m_Scd.Requery "", m_Scdm_Scdno
   End If
   Set Scd = m_Scd
End Property

Public Property Set Scd(vScd As Scd)
   Set m_Scd = vScd
End Property

Public Property Get Hwbm() As Hwbm
   If m_Hwbm Is Nothing Then
      Set m_Hwbm = New Hwbm
      If m_Scdm_HwBmCode <> "" Then
         m_Hwbm.Requery m_Scdm_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_Scdm_HwDwCode <> "" Then
         m_HwDw.Requery m_Scdm_HwDwCode
      End If
   End If
   Set HwDw = m_HwDw
End Property

Public Property Get Scdm_Scdno() As Double
   Scdm_Scdno = m_Scdm_Scdno
End Property

Public Property Get Scdm_HwBmCode() As String
   Scdm_HwBmCode = m_Scdm_HwBmCode
End Property

Public Property Get Scdm_HwBmMc() As String
   Scdm_HwBmMc = m_Scdm_HwBmMc
End Property

Public Property Get Scdm_HwBmno() As Double
   Scdm_HwBmno = m_Scdm_HwBmno
End Property

Public Property Get Scdm_HwDwCode() As String
   Scdm_HwDwCode = m_Scdm_HwDwCode
End Property

Public Property Get Scdm_HwDwno() As Double
   Scdm_HwDwno = m_Scdm_HwDwNo
End Property

Public Property Get Scdm_HwDwConv() As Double
   Scdm_HwDwConv = m_Scdm_HwDwConv
End Property

Public Property Get ScdmDwQty() As Double
   ScdmDwQty = m_ScdmDwQty
End Property

Public Property Get ScdmDwShl() As Double
   ScdmDwShl = m_ScdmDwShl
End Property

Public Property Get ScdmQty() As Double
   ScdmQty = m_ScdmQty
End Property

Public Property Get ScdmFQty() As Double
   ScdmFQty = m_ScdmFQty
End Property

Public Property Get ScdmBz() As String
   ScdmBz = m_ScdmBz
End Property

Public Property Get ScdmNo() As Double
   ScdmNo = m_ScdmNo
End Property

Public Property Let Scdm_HwBmCode(vScdm_HwBmCode As String)
   If Trim(vScdm_HwBmCode) = "" Then
      Err.Raise vbObjectError + 1, , "货物编码不能为空！"
      Exit Property
   End If
   If m_Scdm_HwBmCode <> vScdm_HwBmCode Then
      If Hwbm.Requery(vScdm_HwBmCode) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的货物编码不存在！"
         Exit Property
      End If
      m_Scdm_HwBmno = Hwbm.HwBmNo
      m_Scdm_HwBmMc = Hwbm.HwBmMc
      m_Scdm_HwDwCode = Hwbm.HwBm_HwDwCode
      m_Scdm_HwDwNo = Hwbm.HwBm_HwDwNo
      m_Scdm_HwDwConv = 1
   End If
   m_Scdm_HwBmCode = vScdm_HwBmCode
End Property

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

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

Public Property Let ScdmDwQty(vScdmDwQty As Double)
   If vScdmDwQty <= 0 Then
      Err.Raise vbObjectError + 1, , "单位用量必须大于零！"
      Exit Property
   End If
   m_ScdmQty = Round(Scd.ScdQty * vScdmDwQty * (1 + m_ScdmDwShl), 4)
   m_ScdmDwQty = vScdmDwQty
End Property

Public Property Let ScdmDwShl(vScdmDwShl As Double)
   If vScdmDwShl < 0 Then
      Err.Raise vbObjectError + 1, , "单位损耗率不能小于零！"
      Exit Property
   End If
   m_ScdmQty = Round(Scd.ScdQty * m_ScdmDwQty * (1 + vScdmDwShl), 4)
   m_ScdmDwShl = vScdmDwShl
End Property

Public Property Let ScdmQty(vScdmQty As Double)
   If vScdmQty <= 0 Then
      Err.Raise vbObjectError + 1, , "数量必须大于零！"
      Exit Property
   End If
   m_ScdmQty = vScdmQty
End Property

Public Property Let ScdmBz(vScdmDBz As String)
   m_ScdmBz = vScdmDBz
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_ScdmId = -1 Then
      Cmd.CommandText = gPublicFunction.GetCallSPString("SCDMREC_INSERT", 9)
      Cmd(0) = m_Scd.ScdNo
      Cmd(1) = m_Scdm_HwBmno
      Cmd(2) = m_Scdm_HwDwNo
      Cmd(3) = m_Scdm_HwDwConv
      Cmd(4) = m_ScdmDwQty
      Cmd(5) = m_ScdmDwShl
      Cmd(6) = m_ScdmQty
      Cmd(7) = m_ScdmBz
      Cmd(8).Direction = adParamOutput      'ScdmNo
   Else
      Cmd.CommandText = gPublicFunction.GetCallSPString("SCDMREC_UPDATE", 8)
      Cmd(0) = m_ScdmNo
      Cmd(1) = m_Scdm_HwBmno
      Cmd(2) = m_Scdm_HwDwNo
      Cmd(3) = m_Scdm_HwDwConv
      Cmd(4) = m_ScdmDwQty
      Cmd(5) = m_ScdmDwShl
      Cmd(6) = m_ScdmQty
      Cmd(7) = m_ScdmBz
   End If
   
   Cmd.Execute
   
   If m_ScdmId = -1 Then
      m_ScdmNo = Cmd(8)
      m_ScdmId = 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 "SCDMREC", "SCDMNO", CStr(m_ScdmNo)
   
On Error GoTo ErrorHandle

   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
      
   Cmd.CommandText = "{CALL ScdmREC_DELETE(?)}"
   Cmd(0) = m_ScdmNo
   
   gDbCommon.Conn.BeginTrans
   Cmd.Execute
   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(vScdmNo As Double) As Integer
   Dim mRs As DbRs
   Dim mSqlStr As String
On Error GoTo ErrorHandle
   Requery = -1
   
   Set mRs = New DbRs
   
   mSqlStr = "SELECT Scdm_Scdno,Scdm_HwBmCode=COALESCE((SELECT HwBmCode FROM HWBMREC WHERE HWBMNO=Scdm_HWBMNO),''),Scdm_HwBmMc=COALESCE((SELECT HwBmMc FROM HWBMREC WHERE HWBMNO=Scdm_HWBMNO),''),Scdm_HWBMNO,"
   mSqlStr = mSqlStr & "Scdm_HwDwCode=COALESCE((SELECT HWDWCode FROM HWDWREC WHERE HWDWNO=Scdm_HWDWNO),''),Scdm_HWDWNO,Scdm_HWDWCONV,"
   mSqlStr = mSqlStr & "SCDMDWQTY,SCDMDWSHL,ScdmQTY,ScdmFQTY,ScdmBZ,ScdmNO FROM ScdmREC WHERE ScdmNO=" & CStr(vScdmNo)
   
   mRs.Fillbydb mSqlStr
   
   If Not mRs.EOF Then
      Requery = 1
      BatchLet mRs!Scdm_Scdno, mRs!Scdm_HwBmCode, mRs!Scdm_HwBmMc, mRs!Scdm_HwBmno, _
               mRs!Scdm_HwDwCode, mRs!Scdm_HwDwno, mRs!Scdm_HwDwConv, _
               mRs!ScdmDwQty, mRs!ScdmDwShl, mRs!ScdmQty, mRs!ScdmFQty, mRs!ScdmBz, mRs!ScdmNo
   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_Scdm_Scdno = Properties(0)
   
   m_Scdm_HwBmCode = Properties(1)
   m_Scdm_HwBmMc = Properties(2)
   m_Scdm_HwBmno = Properties(3)
   
   m_Scdm_HwDwCode = Properties(4)
   m_Scdm_HwDwNo = Properties(5)
   m_Scdm_HwDwConv = Properties(6)
   
   m_ScdmDwQty = Properties(7)
   m_ScdmDwShl = Properties(8)
   
   m_ScdmQty = Properties(9)
   m_ScdmFQty = Properties(10)
   
   m_ScdmBz = Properties(11)
   
   m_ScdmNo = Properties(12)

   m_ScdmId = 1

End Sub