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

Dim m_ScBcdh As ScBcdh

Dim m_Scd As Scd

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

Dim m_ScBcd_ScBcdhno As Double

Dim m_ScBcd_Scdno As Double
Dim m_ScBcd_ScdDocno As String
Dim m_ScBcd_ScdQty As Double
Dim m_ScBcd_ScdWQty As Double

Dim m_ScBcd_HwBmCode As String
Dim m_ScBcd_HwBmMc As String
Dim m_ScBcd_HwBmno As Double

Dim m_ScBcd_HwCkMc As String
Dim m_ScBcd_HwCkno As Double

Dim m_ScBcd_HwDwCode As String
Dim m_ScBcd_HwDwNo As Double
Dim m_ScBcd_HwDwConv As Double

Dim m_ScBcdQty As Double
Dim m_ScBcdPrice As Double
Dim m_ScBcdAmt As Double

Dim m_ScBcdMioNo As Double

Dim m_ScBcdBz As String

Dim m_ScBcdNo As Double

Dim m_ScBcdId As Integer
Dim m_ScBcdKey As Double

Private Sub Class_Initialize()
   m_ScBcdId = -1
End Sub

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

Public Property Get ScBcdId() As Integer
   ScBcdId = m_ScBcdId
End Property

Public Property Let ScBcdId(vScBcdId As Integer)
   m_ScBcdId = vScBcdId
End Property

Public Property Get ScBcdKey() As Double
   ScBcdKey = m_ScBcdKey
End Property

Public Property Let ScBcdKey(vScBcdKey As Double)
   m_ScBcdKey = vScBcdKey
End Property

Public Property Get ScBcdh() As ScBcdh
   If m_ScBcdh Is Nothing Then
      Set m_ScBcdh = New ScBcdh
      m_ScBcdh.Requery "", m_ScBcd_ScBcdhno
   End If
   Set ScBcdh = m_ScBcdh
End Property

Public Property Set ScBcdh(vScBcdh As ScBcdh)
   Set m_ScBcdh = vScBcdh
End Property

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

Public Property Get Hwbm() As Hwbm
   If m_Hwbm Is Nothing Then
      Set m_Hwbm = New Hwbm
      If m_ScBcd_HwBmCode <> "" Then
         m_Hwbm.Requery m_ScBcd_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_ScBcd_HwDwCode <> "" Then
         m_HwDw.Requery m_ScBcd_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_ScBcd_HwCkMc <> "" Then
         m_HwCk.Requery m_ScBcd_HwCkMc
      End If
   End If
   Set HwCk = m_HwCk
End Property

Public Property Get ScBcd_ScBcdhno() As Double
   ScBcd_ScBcdhno = m_ScBcd_ScBcdhno
End Property

Public Property Get ScBcd_Scdno() As Double
   ScBcd_Scdno = m_ScBcd_Scdno
End Property

Public Property Get ScBcd_ScdDocno() As String
   ScBcd_ScdDocno = m_ScBcd_ScdDocno
End Property

Public Property Get ScBcd_ScdQty() As Double
   ScBcd_ScdQty = m_ScBcd_ScdQty
End Property

Public Property Get ScBcd_ScdWQty() As Double
   ScBcd_ScdWQty = m_ScBcd_ScdWQty
End Property

Public Property Get ScBcd_HwBmCode() As String
   ScBcd_HwBmCode = m_ScBcd_HwBmCode
End Property

Public Property Get ScBcd_HwBmMc() As String
   ScBcd_HwBmMc = m_ScBcd_HwBmMc
End Property

Public Property Get ScBcd_HwBmno() As Double
   ScBcd_HwBmno = m_ScBcd_HwBmno
End Property

Public Property Get ScBcd_HwCkMc() As String
   ScBcd_HwCkMc = m_ScBcd_HwCkMc
End Property

Public Property Get ScBcd_HwCkno() As Double
   ScBcd_HwCkno = m_ScBcd_HwCkno
End Property

Public Property Get ScBcd_HwDwCode() As String
   ScBcd_HwDwCode = m_ScBcd_HwDwCode
End Property

Public Property Get ScBcd_HwDwno() As Double
   ScBcd_HwDwno = m_ScBcd_HwDwNo
End Property

Public Property Get ScBcd_HwDwConv() As Double
   ScBcd_HwDwConv = m_ScBcd_HwDwConv
End Property

Public Property Get ScBcdQty() As Double
   ScBcdQty = m_ScBcdQty
End Property

Public Property Get ScBcdPrice() As Double
   ScBcdPrice = m_ScBcdPrice
End Property

Public Property Get ScBcdAmt() As Double
   ScBcdAmt = m_ScBcdAmt
End Property

Public Property Get ScBcdBz() As String
   ScBcdBz = m_ScBcdBz
End Property

Public Property Get ScBcdMioNo() As Double
   ScBcdMioNo = m_ScBcdMioNo
End Property

Public Property Get ScBcdNo() As Double
   ScBcdNo = m_ScBcdNo
End Property

Public Property Let ScBcd_Scdno(vScBcd_Scdno As Double)
   If m_ScBcd_Scdno <> vScBcd_Scdno Then
      If Scd.Requery(, vScBcd_Scdno) = -1 Then
         Err.Raise vbObjectError + 1, , "工单不存在！"
         Exit Property
      End If
      m_ScBcd_HwBmno = Scd.Scd_HwBmno
      m_ScBcd_HwBmMc = Scd.Scd_HwBmMc
      m_ScBcd_HwDwCode = Scd.Scd_HwDwCode
      m_ScBcd_HwDwNo = Scd.Scd_HwDwno
      m_ScBcd_HwDwConv = Scd.Scd_HwDwConv
   End If
   m_ScBcd_Scdno = vScBcd_Scdno
End Property

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

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

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

Public Property Let ScBcdQty(vScBcdQty As Double)
   If vScBcdQty <= 0 Then
      Err.Raise vbObjectError + 1, , "数量必须大于零！"
      Exit Property
   End If
   m_ScBcdQty = vScBcdQty
   m_ScBcdAmt = Val(Format(vScBcdQty * m_ScBcdPrice, "##"))
End Property

Public Property Let ScBcdPrice(vScBcdPrice As Double)
   If vScBcdPrice < 0 Then
      Err.Raise vbObjectError + 1, , "单价不能小于零！"
      Exit Property
   End If
   m_ScBcdPrice = vScBcdPrice
   m_ScBcdAmt = Val(Format(vScBcdPrice * m_ScBcdQty, "##"))
End Property

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

Public Property Let ScBcdBz(vScBcdDBz As String)
   m_ScBcdBz = vScBcdDBz
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_ScBcdId = -1 Then
      Cmd.CommandText = gPublicFunction.GetCallSPString("ScBcdREC_INSERT", 12)
      Cmd(0) = m_ScBcdh.ScBcdhNo
      Cmd(1) = m_ScBcd_Scdno
      Cmd(2) = m_ScBcd_HwBmno
      Cmd(3) = m_ScBcd_HwDwNo
      Cmd(4) = m_ScBcd_HwDwConv
      Cmd(5) = m_ScBcd_HwCkno
      Cmd(6) = m_ScBcdQty
      Cmd(7) = m_ScBcdPrice
      Cmd(8) = m_ScBcdAmt
      Cmd(9) = m_ScBcdBz
      Cmd(10).Direction = adParamOutput 'ScBcdMiono
      Cmd(11).Direction = adParamOutput    'ScBcdNo
   Else
      Cmd.CommandText = gPublicFunction.GetCallSPString("ScBcdREC_UPDATE", 9)
      Cmd(0) = m_ScBcdNo
      Cmd(1) = m_ScBcd_HwBmno
      Cmd(2) = m_ScBcd_HwDwNo
      Cmd(3) = m_ScBcd_HwDwConv
      Cmd(4) = m_ScBcd_HwCkno
      Cmd(5) = m_ScBcdQty
      Cmd(6) = m_ScBcdPrice
      Cmd(7) = m_ScBcdAmt
      Cmd(8) = m_ScBcdBz
   End If
   
   Cmd.Execute
   
   If m_ScBcdId = -1 Then
      m_ScBcdMioNo = Cmd(10)
      m_ScBcdNo = Cmd(11)
      m_ScBcdId = 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 "SCBCDREC", "SCBCDNO", CStr(m_ScBcdNo)
   
On Error GoTo ErrorHandle

   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
      
   Cmd.CommandText = "{CALL ScBcdREC_DELETE(?)}"
   Cmd(0) = m_ScBcdNo
   
   gDbCommon.Conn.BeginTrans
   Cmd.Execute
   If ScBcdh.ScBcds.Count = 1 Then
      ScBcdh.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(vScBcdNo As Double) As Integer
   Dim mRs As DbRs
   Dim mSqlStr As String
On Error GoTo ErrorHandle
   
   Requery = -1
   
   Set mRs = New DbRs
   
   mSqlStr = "SELECT ScBcd_ScBcdHNO,ScBcd_SCDDOCNO=COALESCE((SELECT SCDDOCNO FROM SCDREC WHERE ScdNO=SCBCD_SCDNO),''),ScBcd_ScdNO,"
   mSqlStr = mSqlStr & "ScBcd_ScdQTY=COALESCE((SELECT ScdQTY FROM ScdREC WHERE ScdNO=SCBCD_ScdNO),0),ScBcd_ScdWQty=COALESCE((SELECT ScdWQty FROM ScdREC WHERE ScdNO=SCBCD_ScdNO),0),"
   mSqlStr = mSqlStr & "ScBcd_HwBmCode=COALESCE((SELECT HwBmCode FROM HWBMREC WHERE HWBMNO=ScBcd_HWBMNO),''),ScBcd_HwBmMc=COALESCE((SELECT HwBmMc FROM HWBMREC WHERE HWBMNO=ScBcd_HWBMNO),''),ScBcd_HWBMNO,"
   mSqlStr = mSqlStr & "ScBcd_HwCkMc=COALESCE((SELECT HwCkMc FROM HWCKREC WHERE HWCKNO=ScBcd_HWCKNO),''),ScBcd_HWCKNO,"
   mSqlStr = mSqlStr & "ScBcd_HwDwCode=COALESCE((SELECT HWDWCode FROM HWDWREC WHERE HWDWNO=ScBcd_HWDWNO),''),ScBcd_HWDWNO,ScBcd_HWDWCONV,"
   mSqlStr = mSqlStr & "ScBcdQTY,ScBcdPRICE,ScBcdAMT,ScBcdBZ,ScBcdMIONO,ScBcdNO FROM ScBcdREC WHERE ScBcdNO=" & CStr(vScBcdNo)
   
   mRs.Fillbydb mSqlStr
   
   If Not mRs.EOF Then
      Requery = 1
      BatchLet mRs!ScBcd_ScBcdhno, mRs!ScBcd_Scdno, mRs!ScBcd_ScdDocno, mRs!ScBcd_HwBmCode, mRs!ScBcd_HwBmMc, mRs!ScBcd_HwBmno, _
               mRs!ScBcd_HwCkMc, mRs!ScBcd_HwCkno, mRs!ScBcd_HwDwCode, mRs!ScBcd_HwDwno, mRs!ScBcd_HwDwConv, _
               mRs!ScBcd_ScdQty, mRs!ScBcd_ScdWQty, mRs!ScBcdQty, mRs!ScBcdPrice, mRs!ScBcdAmt, mRs!ScBcdBz, mRs!ScBcdMioNo, mRs!ScBcdNo
   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_ScBcd_ScBcdhno = Properties(0)
   m_ScBcd_Scdno = Properties(1)
   
   m_ScBcd_ScdDocno = Properties(2)
   
   m_ScBcd_HwBmCode = Properties(3)
   m_ScBcd_HwBmMc = Properties(4)
   m_ScBcd_HwBmno = Properties(5)
   
   m_ScBcd_HwCkMc = Properties(6)
   m_ScBcd_HwCkno = Properties(7)
   
   m_ScBcd_HwDwCode = Properties(8)
   m_ScBcd_HwDwNo = Properties(9)
   m_ScBcd_HwDwConv = Properties(10)
   
   m_ScBcd_ScdQty = Properties(11)
   m_ScBcd_ScdWQty = Properties(12)
   
   m_ScBcdQty = Properties(13)
   m_ScBcdPrice = Properties(14)
   m_ScBcdAmt = Properties(15)
   m_ScBcdBz = Properties(16)
   
   m_ScBcdMioNo = Properties(17)
   m_ScBcdNo = Properties(18)

   m_ScBcdId = 1

End Sub