📄 xsfhd.cls

📁 制造业产供销与往来系统源码,包括进销存及全部控件！
💻 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 = True
Option Explicit

Dim m_XsFhdh As XsFhdh

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

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_HwBmMc As String
Dim m_XsFhd_HwBmno As Double

Dim m_XsFhd_HwCkMc As String
Dim m_XsFhd_HwCkno As Double

Dim m_XsFhd_HwDwCode As String
Dim m_XsFhd_HwDwNo As Double
Dim m_XsFhd_HwDwConv As Double

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

Dim m_XsFhd_CwBzConv As Double

Dim m_XsFhd_CwSmCode As String
Dim m_XsFhd_CwSmNo As Double
Dim m_XsFhd_CwSmConv As Double

Dim m_XsFhdOPrice As Double
Dim m_XsFhdOAmt As Double

Dim m_XsFhd_XsArNo As Double
Dim m_XsFhdMioNo As Double

Dim m_XsFhdBz 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 Let XsFhdId(vXsFhdId As Integer)
   m_XsFhdId = vXsFhdId
End Property

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

Public Property Let XsFhdKey(vXsFhdKey As Double)
   m_XsFhdKey = vXsFhdKey
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 Set XsFhdh(vXsFhdh As XsFhdh)
   Set m_XsFhdh = vXsFhdh
End Property

Public Property Get Hwbm() As Hwbm
   If m_Hwbm Is Nothing Then
      Set m_Hwbm = New Hwbm
      If m_XsFhd_HwBmCode <> "" Then
         m_Hwbm.Requery m_XsFhd_HwBmCode
      End If
   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
      If m_XsFhd_HwCkMc <> "" Then
         m_HwCk.Requery m_XsFhd_HwCkMc
      End If
   End If
   Set HwCk = m_HwCk
End Property

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

Public Property Get CwSm() As CwSm
   If m_CwSm Is Nothing Then
      Set m_CwSm = New CwSm
      If m_XsFhd_CwSmCode <> "" Then
         m_CwSm.Requery m_XsFhd_CwSmCode
      End If
   End If
   Set CwSm = m_CwSm
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_HwBmCode() As String
   XsFhd_HwBmCode = m_XsFhd_HwBmCode
End Property

Public Property Get XsFhd_HwBmMc() As String
   XsFhd_HwBmMc = m_XsFhd_HwBmMc
End Property

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

Public Property Get XsFhd_HwCkMc() As String
   XsFhd_HwCkMc = m_XsFhd_HwCkMc
End Property

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

Public Property Get XsFhd_HwDwCode() As String
   XsFhd_HwDwCode = m_XsFhd_HwDwCode
End Property

Public Property Get XsFhd_HwDwno() As Double
   XsFhd_HwDwno = m_XsFhd_HwDwNo
End Property

Public Property Get XsFhd_HwDwConv() As Double
   XsFhd_HwDwConv = m_XsFhd_HwDwConv
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 XsFhd_CwSmCode() As String
   XsFhd_CwSmCode = m_XsFhd_CwSmCode
End Property

Public Property Get XsFhd_CwSmno() As Double
   XsFhd_CwSmno = m_XsFhd_CwSmNo
End Property

Public Property Get XsFhd_CwsmConv() As Double
   XsFhd_CwsmConv = m_XsFhd_CwSmConv
End Property

Public Property Get XsFhdOPrice() As Double
   XsFhdOPrice = m_XsFhdOPrice
End Property

Public Property Get XsFhdOAmt() As Double
   XsFhdOAmt = m_XsFhdOAmt
End Property

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

Public Property Get XsFhd_XsArNo() As Double
   XsFhd_XsArNo = m_XsFhd_XsArNo
End Property

Public Property Get XsFhdMioNo() As Double
   XsFhdMioNo = m_XsFhdMioNo
End Property

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

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

   Dim mXsSod As XsSod
   Set mXsSod = New XsSod
   If mXsSod.Requery(vXsFhd_XsSodno) = -1 Then
      Set mXsSod = Nothing
      Err.Raise vbObjectError + 1, , "对应的销售订单行不存在！"
      Exit Property
   End If
   m_XsFhd_XsSodDocno = mXsSod.XsSodh.XsSodhDocno
   m_XsFhd_HwBmno = mXsSod.XsSod_HwBmno
   m_XsFhd_HwBmCode = mXsSod.XsSod_HwBmCode
   m_XsFhd_HwBmMc = mXsSod.XsSod_HwBmMc
   Set mXsSod = 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
      If Hwbm.Requery(vXsFhd_HwBmCode) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的货物编码不存在！"
         Exit Property
      End If
      m_XsFhd_HwBmno = Hwbm.HwBmNo
      m_XsFhd_HwBmMc = Hwbm.HwBmMc
      m_XsFhd_HwDwCode = Hwbm.HwBm_HwDwCode
      m_XsFhd_HwDwNo = Hwbm.HwBm_HwDwNo
      m_XsFhd_HwDwConv = 1
   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
      If HwCk.Requery(vXsFhd_HwCkMc) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的仓库不存在！"
         Exit Property
      End If
      m_XsFhd_HwCkno = HwCk.HwCkNo
   End If
   m_XsFhd_HwCkMc = vXsFhd_HwCkMc
End Property

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

Public Property Let XsFhd_HwDwConv(vXsFhd_HwdwConv As Double)
   If vXsFhd_HwdwConv <= 0 Then
      Err.Raise vbObjectError + 1, , "换算系数必须大于零！"
      Exit Property
   End If
   m_XsFhd_HwDwConv = vXsFhd_HwdwConv
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 = Val(Format(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 = Val(Format(vXsFhdPrice * m_XsFhdQty, "##"))
End Property

Public Property Let XsFhdAmt(vXsFhdAmt As Double)
   If vXsFhdAmt < 0 Then
      Err.Raise vbObjectError + 1, , "发货金额不能小于零！"
      Exit Property
   End If
   m_XsFhdAmt = vXsFhdAmt
End Property

Public Property Let XsFhd_CwSmCode(vXsFhd_CwSmCode As String)
   If Trim(vXsFhd_CwSmCode) = "" Then
      Err.Raise vbObjectError + 1, , "税码不能为空！"
      Exit Property
   End If
   If m_XsFhd_CwSmCode <> vXsFhd_CwSmCode Then
      If CwSm.Requery(vXsFhd_CwSmCode) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的税码不存在！"
         Exit Property
      End If
      m_XsFhd_CwSmNo = CwSm.CwsmNo
      m_XsFhd_CwSmConv = CwSm.CwsmSl
   End If
   m_XsFhd_CwSmCode = vXsFhd_CwSmCode
End Property

Public Property Let XsFhdBz(vXsFhdDBz As String)
   m_XsFhdBz = vXsFhdDBz
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_XsFhdId = -1 Then
      Cmd.CommandText = gPublicFunction.GetCallSPString("XsFhDREC_INSERT", 18)
      Cmd(0) = m_XsFhdh.XsFhdhNo
      Cmd(1) = m_XsFhd_XsSodno
      Cmd(2) = m_XsFhd_HwBmno
      Cmd(3) = m_XsFhd_HwDwNo
      Cmd(4) = m_XsFhd_HwDwConv
      Cmd(5) = m_XsFhd_HwCkno
      Cmd(6) = m_XsFhdQty
      Cmd(7) = m_XsFhdPrice
      Cmd(8) = m_XsFhdAmt
      Cmd(9).Direction = adParamOutput 'm_XsFhdOPrice
      Cmd(10).Direction = adParamOutput 'm_XsFhdOAmt
      Cmd(11).Direction = adParamOutput 'm_XsFhd_CwBzConv
      Cmd(12) = m_XsFhd_CwSmNo
      Cmd(13) = m_XsFhd_CwSmConv
      Cmd(14) = m_XsFhdBz
      Cmd(15).Direction = adParamOutput 'XsFhd_XsArNo
      Cmd(16).Direction = adParamOutput 'XsFhdMioNo
      Cmd(17).Direction = adParamOutput   'XsFhdNo
   Else
      Cmd.CommandText = gPublicFunction.GetCallSPString("XsFhDREC_UPDATE", 14)
      Cmd(0) = m_XsFhdNo
      Cmd(1) = m_XsFhd_HwBmno
      Cmd(2) = m_XsFhd_HwDwNo
      Cmd(3) = m_XsFhd_HwDwConv
      Cmd(4) = m_XsFhd_HwCkno
      Cmd(5) = m_XsFhdQty
      Cmd(6) = m_XsFhdPrice
      Cmd(7) = m_XsFhdAmt
      Cmd(8).Direction = adParamOutput 'm_XsFhdOPrice
      Cmd(9).Direction = adParamOutput 'm_XsFhdOAmt
      Cmd(10).Direction = adParamOutput 'm_XsFhd_CwBzConv
      Cmd(11) = m_XsFhd_CwSmNo
      Cmd(12) = m_XsFhd_CwSmConv
      Cmd(13) = m_XsFhdBz
   End If
   
   Cmd.Execute
   
   If m_XsFhdId = -1 Then
      m_XsFhdOPrice = Cmd(9)
      m_XsFhdOAmt = Cmd(10)
      m_XsFhd_CwBzConv = Cmd(11)
      m_XsFhd_XsArNo = Cmd(15)
      m_XsFhdMioNo = Cmd(16)
      m_XsFhdNo = Cmd(17)
      m_XsFhdId = 1
   Else
      m_XsFhdOPrice = Cmd(8)
      m_XsFhdOAmt = Cmd(9)
      m_XsFhd_CwBzConv = Cmd(10)
   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
On Error GoTo Errorhandle

   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
      
   Cmd.CommandText = "{CALL XsFhdREC_DELETE(?)}"
   Cmd(0) = m_XsFhdNo
   
   gDbCommon.Conn.BeginTrans
   Cmd.Execute
   If XsFhdh.XsFhds.Count = 1 Then
      XsFhdh.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(vXsFhdNo As Double) As Integer
   Dim mRs As DbRs
   Dim mSqlStr As String
On Error GoTo Errorhandle
   Requery = -1
   
   Set mRs = New DbRs
   
   mSqlStr = "SELECT XsFhd_XsFhdHNO,XsFhd_XsSodDOCNO=COALESCE((SELECT XsSodHDOCNO FROM XsSodHREC,XsSodREC WHERE XsSodNO=XsFhd_XsSodNO AND XsSodHNO=XsSod_XsSodHNO),''),XsFhd_XsSodNO,"
   mSqlStr = mSqlStr & "XsFhd_HwBmCode=COALESCE((SELECT HwBmCode FROM HWBMREC WHERE HWBMNO=XsFhD_HWBMNO),''),XsFhd_HwBmMc=COALESCE((SELECT HwBmMc FROM HWBMREC WHERE HWBMNO=XsFhD_HWBMNO),''),XsFhd_HWBMNO,"
   mSqlStr = mSqlStr & "XsFhd_HwCkMc=COALESCE((SELECT HwCkMc FROM HWCKREC WHERE HWCKNO=XsFhD_HWCKNO),''),XsFhd_HWCKNO,"
   mSqlStr = mSqlStr & "XsFhd_HwDwCode=COALESCE((SELECT HWDWCode FROM HWDWREC WHERE HWDWNO=XsFhD_HWDWNO),''),XsFhd_HWDWNO,XsFhD_HWDWCONV,"
   mSqlStr = mSqlStr & "XsFhdQTY,XsFhdPRICE,XsFhdAMT,XsFhdOPrice,XsFhdOAmt,XsFhD_CWBZCONV,"
   mSqlStr = mSqlStr & "XsFhD_CWSMCODE=COALESCE((SELECT CWSMCODE FROM CWSMREC WHERE CWSMNO=XsFhD_CWSMNO),''),XsFhD_CWSMNO,XsFhD_CWSMCONV,"
   mSqlStr = mSqlStr & "XsFhdBZ,XsFhd_XsArNo,XsFhDMIONO,XsFhdNO FROM XsFhdREC WHERE XsFhdNO=" & CStr(vXsFhdNo)
   
   mRs.Fillbydb mSqlStr
   
   If Not mRs.EOF Then
      BatchLet mRs!XsFhd_XsFhdhno, mRs!XsFhd_XsSodDocno, mRs!XsFhd_XsSodno, mRs!XsFhd_HwBmCode, mRs!XsFhd_HwBmMc, mRs!XsFhd_HwBmno, _
               mRs!XsFhd_HwCkMc, mRs!XsFhd_HwCkno, mRs!XsFhd_HwDwCode, mRs!XsFhd_HwDwno, mRs!XsFhd_HwDwConv, _
               mRs!XsFhdQty, mRs!XsFhdPrice, mRs!XsFhdAmt, mRs!XsFhdOPrice, mRs!XsFhdOAmt, _
               mRs!XsFhd_cwbzconv, mRs!XsFhd_CwSmCode, mRs!XsFhd_CwSmno, mRs!XsFhd_CwsmConv, _
               mRs!XsFhdBz, mRs!XsFhd_XsArNo, mRs!XsFhdMioNo, 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_HwBmMc = Properties(4)
   m_XsFhd_HwBmno = Properties(5)
   m_XsFhd_HwCkMc = Properties(6)
   m_XsFhd_HwCkno = Properties(7)
   m_XsFhd_HwDwCode = Properties(8)
   m_XsFhd_HwDwNo = Properties(9)
   m_XsFhd_HwDwConv = Properties(10)
   m_XsFhdQty = Properties(11)
   m_XsFhdPrice = Properties(12)
   m_XsFhdAmt = Properties(13)
   m_XsFhdOPrice = Properties(14)
   m_XsFhdOAmt = Properties(15)
   m_XsFhd_CwBzConv = Properties(16)
   m_XsFhd_CwSmCode = Properties(17)
   m_XsFhd_CwSmNo = Properties(18)
   m_XsFhd_CwSmConv = Properties(19)
   m_XsFhdBz = Properties(20)
   m_XsFhd_XsArNo = Properties(21)
   m_XsFhdMioNo = Properties(22)
   m_XsFhdNo = Properties(23)

   m_XsFhdId = 1

End Sub
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -