xsfhd.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 = "XsFhd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'QQ:75347626
'MSN:[e-mail]
Option Explicit

Dim m_XsFhdh As XsFhdh
Dim m_XsSod As XsSod
Dim m_Hwbm As Hwbm
Dim m_HwCk As HwCk

Dim m_XsFhd_XsFhdhno As Double

Dim m_XsFhd_XsSodDocno As String
Dim m_XsFhd_XsSodno As Double
Dim m_XsFhd_HwBmCode As String
Dim m_XsFhd_HwBmno As Double

Dim m_XsFhd_HwCkMc As String
Dim m_XsFhd_HwCkno As Double

Dim m_XsFhdQty As Double
Dim m_XsFhdPrice As Double
Dim m_XsFhdAmt As Double

Dim m_XsFhdDDat As String
Dim m_XsFhdBz As String

Dim m_XsFhdSysDat As String
Dim m_XsFhdSysTime As String
Dim m_XsFhdNo As Double

Dim m_XsFhdId As Integer
Dim m_XsFhdKey As Double

Private Sub Class_Initialize()
   m_XsFhdId = -1
End Sub

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

Public Property Get XsFhdId() As Integer
   XsFhdId = m_XsFhdId
End Property

Public Property Get XsFhdKey() As Double
   XsFhdKey = m_XsFhdKey
End Property

Public Property Get XsFhdh() As XsFhdh
   If m_XsFhdh Is Nothing Then
      Set m_XsFhdh = New XsFhdh
      m_XsFhdh.Requery "", m_XsFhd_XsFhdhno
   End If
   Set XsFhdh = m_XsFhdh
End Property

Public Property Get XsSod() As XsSod
   If m_XsSod Is Nothing Then
      Set m_XsSod = New XsSod
      m_XsSod.Requery m_XsFhd_XsSodno
   End If
   Set XsSod = m_XsSod
End Property

Public Property Get Hwbm() As Hwbm
   If m_Hwbm Is Nothing Then
      Set m_Hwbm = New Hwbm
      m_Hwbm.Requery "", m_XsFhd_HwBmno
   End If
   Set Hwbm = m_Hwbm
End Property

Public Property Get HwCk() As HwCk
   If m_HwCk Is Nothing Then
      Set m_HwCk = New HwCk
      m_HwCk.Requery "", m_XsFhd_HwCkno
   End If
   Set HwCk = m_HwCk
End Property

Public Property Get XsFhd_XsFhdhno() As Double
   XsFhd_XsFhdhno = m_XsFhd_XsFhdhno
End Property

Public Property Get XsFhd_XsSodDocno() As String
   XsFhd_XsSodDocno = m_XsFhd_XsSodDocno
End Property

Public Property Get XsFhd_XsSodno() As Double
   XsFhd_XsSodno = m_XsFhd_XsSodno
End Property

Public Property Get XsFhd_HwBmno() As Double
   XsFhd_HwBmno = m_XsFhd_HwBmno
End Property

Public Property Get XsFhd_HwCkno() As Double
   XsFhd_HwCkno = m_XsFhd_HwCkno
End Property

Public Property Get XsFhdQty() As Double
   XsFhdQty = m_XsFhdQty
End Property

Public Property Get XsFhdPrice() As Double
   XsFhdPrice = m_XsFhdPrice
End Property

Public Property Get XsFhdAmt() As Double
   XsFhdAmt = m_XsFhdAmt
End Property

Public Property Get XsFhdDDat() As String
   XsFhdDDat = m_XsFhdDDat
End Property

Public Property Get XsFhdBz() As String
   XsFhdBz = m_XsFhdBz
End Property

Public Property Get XsFhdSysDat() As String
   XsFhdSysDat = m_XsFhdSysDat
End Property

Public Property Get XsFhdSysTime() As String
   XsFhdSysTime = m_XsFhdSysTime
End Property

Public Property Get XsFhdNo() As Double
   XsFhdNo = m_XsFhdNo
End Property

Public Property Let XsFhdId(vXsFhdId As Integer)
   m_XsFhdId = vXsFhdId
End Property

Public Property Let XsFhdKey(vXsFhdKey As Double)
   m_XsFhdKey = vXsFhdKey
End Property

Public Property Set XsFhdh(vXsFhdh As XsFhdh)
   Set m_XsFhdh = vXsFhdh
End Property

Public Property Let XsFhd_XsSodno(vXsFhd_XsSodno As Double)
   If vXsFhd_XsSodno = 0 Then
      m_XsFhd_XsSodDocno = ""
      Exit Property
   End If

   Dim Rs As ADODB.Recordset
   Set Rs = Conn.Execute("SELECT XSSODHDOCNO,XSSOD_HWBMNO FROM XSSODREC,XSSODHREC WHERE XSSODNO=" & CStr(vXsFhd_XsSodno) & " AND XSSODHNO=XSSOD_XSSODHNO")
   If Rs.EOF Then
      Rs.Close
      Set Rs = Nothing
      Err.Raise vbObjectError + 1, , "对应的订单行不存在！"
      Exit Property
   End If
   m_XsFhd_XsSodDocno = Rs!XsSodhDocno
   m_XsFhd_HwBmno = Rs!XsSod_HwBmno
   Rs.Close
   Set Rs = Nothing

   m_XsFhd_XsSodno = vXsFhd_XsSodno
End Property

Public Property Let XsFhd_HwBmCode(vXsFhd_HwBmCode As String)
   If Trim(vXsFhd_HwBmCode) = "" Then
      Err.Raise vbObjectError + 1, , "货物编码不能为空！"
      Exit Property
   End If
   If m_XsFhd_HwBmCode <> vXsFhd_HwBmCode Then
      Dim Rs As ADODB.Recordset
      Set Rs = Conn.Execute("SELECT HWBMNO FROM HWBMREC WHERE HwBmCode='" & vXsFhd_HwBmCode & "'")
      If Rs.EOF Then
         Rs.Close
         Set Rs = Nothing
         Err.Raise vbObjectError + 1, , "录入的货物编码不存在！"
         Exit Property
      End If
      m_XsFhd_HwBmno = Rs!HwBmNo
      Rs.Close
      Set Rs = Nothing
   End If
   m_XsFhd_HwBmCode = vXsFhd_HwBmCode
End Property

Public Property Let XsFhd_HwCkMc(vXsFhd_HwCkMc As String)
   If Trim(vXsFhd_HwCkMc) = "" Then
      Err.Raise vbObjectError + 1, , "仓库不能为空！"
      Exit Property
   End If
   If m_XsFhd_HwCkMc <> vXsFhd_HwCkMc Then
      Dim Rs As ADODB.Recordset
      Set Rs = Conn.Execute("SELECT HwCkNO FROM HwCkREC WHERE HwCkMc='" & vXsFhd_HwCkMc & "'")
      If Rs.EOF Then
         Rs.Close
         Set Rs = Nothing
         Err.Raise vbObjectError + 1, , "录入的仓库不存在！"
         Exit Property
      End If
      m_XsFhd_HwCkno = Rs!HwCkNo
      Rs.Close
      Set Rs = Nothing
   End If
   m_XsFhd_HwCkMc = vXsFhd_HwCkMc
End Property

Public Property Let XsFhdQty(vXsFhdQty As Double)
   If vXsFhdQty <= 0 Then
      Err.Raise vbObjectError + 1, , "数量必须大于零！"
      Exit Property
   End If
   m_XsFhdQty = vXsFhdQty
   m_XsFhdAmt = vXsFhdQty * m_XsFhdPrice
End Property

Public Property Let XsFhdPrice(vXsFhdPrice As Double)
   If vXsFhdPrice < 0 Then
      Err.Raise vbObjectError + 1, , "单价不能小于零！"
      Exit Property
   End If
   m_XsFhdPrice = vXsFhdPrice
   m_XsFhdAmt = vXsFhdPrice * m_XsFhdQty
End Property

Public Property Let XsFhdBz(vXsFhdDBz As String)
   m_XsFhdBz = vXsFhdDBz
End Property

Public Sub Save()
On Error GoTo Errorhandle
      
   If m_XsFhdId = -1 Then
      Cmd.CommandText = "{CALL XSFHDREC_INSERT(?,?,?,?,?,?,?,?,?,?,?)}"
      Cmd(0) = m_XsFhdh.XsFhdhNo
      Cmd(1) = m_XsFhd_XsSodno
      Cmd(2) = m_XsFhd_HwBmno
      Cmd(3) = m_XsFhd_HwCkno
      Cmd(4) = m_XsFhdQty
      Cmd(5) = m_XsFhdPrice
      Cmd(6) = m_XsFhdAmt
      Cmd(7) = m_XsFhdBz
      Cmd(8).Direction = adParamOutput 'XsFhdSysDate
      Cmd(9).Direction = adParamOutput 'XsFhdSysTime
      Cmd(10).Direction = adParamOutput 'XsFhdNo
   Else
      Cmd.CommandText = "{CALL XSFHDREC_UPDATE(?,?,?,?,?,?,?)}"
      Cmd(0) = m_XsFhdNo
      Cmd(1) = m_XsFhd_HwBmno
      Cmd(2) = m_XsFhd_HwCkno
      Cmd(3) = m_XsFhdQty
      Cmd(4) = m_XsFhdPrice
      Cmd(5) = m_XsFhdAmt
      Cmd(6) = m_XsFhdBz
   End If
   
   Cmd.Execute
   
   If m_XsFhdId = -1 Then
      m_XsFhdSysDat = Cmd(8)
      m_XsFhdSysTime = Cmd(9)
      m_XsFhdNo = Cmd(10)
      m_XsFhdId = 1
   End If
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Public Sub Del()
On Error GoTo Errorhandle
      
   Cmd.CommandText = "{CALL XSFHDREC_DELETE(?)}"
   Cmd(0) = m_XsFhdNo
   
   Conn.BeginTrans
   Cmd.Execute
   If XsFhdh.XsFhds.Count = 1 Then
      XsFhdh.Del
   End If
   Conn.CommitTrans
   
Exit Sub
Errorhandle:
   Conn.RollbackTrans
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Public Function Requery(vXsFhdNo As Double) As Integer
   Dim mRs As ADODB.Recordset
On Error GoTo Errorhandle
   Requery = -1
   Set mRs = Conn.Execute("SELECT XsFhd_XSFHDHNO,XSFHD_XSSODDOCNO=COALESCE((SELECT XSSODHDOCNO FROM XSSODHREC,XSSODREC WHERE XSSODNO=XSFHD_XSSODNO AND XSSODHNO=XSSOD_XSSODHNO),''),XSFHD_XSSODNO,XsFhd_HwBmCode=HwBmCode,XsFhd_HWBMNO,XSFHD_HwCkMc=HwCkMc,XSFHD_HWCKNO,XsFhdQTY,XsFhdPRICE,XsFhdAMT,XsFhdBZ,XsFhdSYSDAT,XsFhdSYSTIME,XsFhdNO FROM XsFhdREC,HWBMREC,HWCKREC WHERE XsFhdNO=" & CStr(vXsFhdNo) & " AND HWBMNO=XsFhd_HWBMNO AND HWCKNO=XSFHD_HWCKNO")
   If Not mRs.EOF Then
      BatchLet mRs!XsFhd_XsFhdhno, mRs!XsFhd_XsSodDocno, mRs!XsFhd_XsSodno, mRs!XsFhd_HwBmCode, mRs!XsFhd_HwBmno, mRs!XsFhd_HwCkMc, mRs!XsFhd_HwCkno, mRs!XsFhdQty, mRs!XsFhdPrice, mRs!XsFhdAmt, mRs!XsFhdBz, mRs!XsFhdSysDat, mRs!XsFhdSysTime, mRs!XsFhdNo
   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_XsFhd_XsFhdhno = Properties(0)
   m_XsFhd_XsSodDocno = Properties(1)
   m_XsFhd_XsSodno = Properties(2)
   m_XsFhd_HwBmCode = Properties(3)
   m_XsFhd_HwBmno = Properties(4)
   m_XsFhd_HwCkMc = Properties(5)
   m_XsFhd_HwCkno = Properties(6)
   m_XsFhdQty = Properties(7)
   m_XsFhdPrice = Properties(8)
   m_XsFhdAmt = Properties(9)
   m_XsFhdBz = Properties(10)
   m_XsFhdSysDat = Properties(11)
   m_XsFhdSysTime = Properties(12)
   m_XsFhdNo = Properties(13)

   m_XsFhdId = 1

End Sub