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

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

Dim m_XsFhdAr_XsFhdArhno As Double

Dim m_XsFhdAr_XsSodDocno As String
Dim m_XsFhdAr_XsSodno As Double

Dim m_XsFhdAr_HwBmCode As String
Dim m_XsFhdAr_HwBmMc As String
Dim m_XsFhdAr_HwBmno As Double

Dim m_XsFhdAr_HwCkMc As String
Dim m_XsFhdAr_HwCkno As Double

Dim m_XsFhdAr_HwDwCode As String
Dim m_XsFhdAr_HwDwNo As Double
Dim m_XsFhdAr_HwDwConv As Double

Dim m_XsFhdArQty As Double
Dim m_XsFhdArPrice As Double
Dim m_XsFhdArAmt As Double

Dim m_XsFhdAr_CwSmCode As String
Dim m_XsFhdAr_CwSmNo As Double
Dim m_XsFhdAr_CwSmConv As Double

Dim m_XsFhdArOPrice As Double
Dim m_XsFhdArOAmt As Double

Dim m_XsFhdArBz As String

Dim m_XsFhdArMioNo As Double
Dim m_XsFhdArNo As Double

Dim m_XsFhdArId As Integer
Dim m_XsFhdArKey As Double

Private Sub Class_Initialize()
   m_XsFhdArId = -1
End Sub

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

Public Property Get XsFhdArId() As Integer
   XsFhdArId = m_XsFhdArId
End Property

Public Property Let XsFhdArId(vXsFhdArId As Integer)
   m_XsFhdArId = vXsFhdArId
End Property

Public Property Get XsFhdArKey() As Double
   XsFhdArKey = m_XsFhdArKey
End Property

Public Property Let XsFhdArKey(vXsFhdArKey As Double)
   m_XsFhdArKey = vXsFhdArKey
End Property

Public Property Get XsFhdArh() As XsFhdArh
   If m_XsFhdArh Is Nothing Then
      Set m_XsFhdArh = New XsFhdArh
      m_XsFhdArh.Requery "", m_XsFhdAr_XsFhdArhno
   End If
   Set XsFhdArh = m_XsFhdArh
End Property

Public Property Set XsFhdArh(vXsFhdArh As XsFhdArh)
   Set m_XsFhdArh = vXsFhdArh
End Property

Public Property Get Hwbm() As Hwbm
   If m_Hwbm Is Nothing Then
      Set m_Hwbm = New Hwbm
      If m_XsFhdAr_HwBmCode <> "" Then
         m_Hwbm.Requery m_XsFhdAr_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_XsFhdAr_HwCkMc <> "" Then
         m_HwCk.Requery m_XsFhdAr_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_XsFhdAr_HwDwCode <> "" Then
         m_HwDw.Requery m_XsFhdAr_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_XsFhdAr_CwSmCode <> "" Then
         m_CwSm.Requery m_XsFhdAr_CwSmCode
      End If
   End If
   Set CwSm = m_CwSm
End Property

Public Property Get XsFhdAr_XsFhdArhno() As Double
   XsFhdAr_XsFhdArhno = m_XsFhdAr_XsFhdArhno
End Property

Public Property Get XsFhdAr_XsSodDocno() As String
   XsFhdAr_XsSodDocno = m_XsFhdAr_XsSodDocno
End Property

Public Property Get XsFhdAr_XsSodno() As Double
   XsFhdAr_XsSodno = m_XsFhdAr_XsSodno
End Property

Public Property Get XsFhdAr_HwBmCode() As String
   XsFhdAr_HwBmCode = m_XsFhdAr_HwBmCode
End Property

Public Property Get XsFhdAr_HwBmMc() As String
   XsFhdAr_HwBmMc = m_XsFhdAr_HwBmMc
End Property

Public Property Get XsFhdAr_HwBmno() As Double
   XsFhdAr_HwBmno = m_XsFhdAr_HwBmno
End Property

Public Property Get XsFhdAr_HwCkMc() As String
   XsFhdAr_HwCkMc = m_XsFhdAr_HwCkMc
End Property

Public Property Get XsFhdAr_HwCkno() As Double
   XsFhdAr_HwCkno = m_XsFhdAr_HwCkno
End Property

Public Property Get XsFhdAr_HwDwCode() As String
   XsFhdAr_HwDwCode = m_XsFhdAr_HwDwCode
End Property

Public Property Get XsFhdAr_HwDwno() As Double
   XsFhdAr_HwDwno = m_XsFhdAr_HwDwNo
End Property

Public Property Get XsFhdAr_HwDwConv() As Double
   XsFhdAr_HwDwConv = m_XsFhdAr_HwDwConv
End Property

Public Property Get XsFhdArQty() As Double
   XsFhdArQty = m_XsFhdArQty
End Property

Public Property Get XsFhdArPrice() As Double
   XsFhdArPrice = m_XsFhdArPrice
End Property

Public Property Get XsFhdArAmt() As Double
   XsFhdArAmt = m_XsFhdArAmt
End Property

Public Property Get XsFhdAr_CwSmCode() As String
   XsFhdAr_CwSmCode = m_XsFhdAr_CwSmCode
End Property

Public Property Get XsFhdAr_CwSmno() As Double
   XsFhdAr_CwSmno = m_XsFhdAr_CwSmNo
End Property

Public Property Get XsFhdAr_CwsmConv() As Double
   XsFhdAr_CwsmConv = m_XsFhdAr_CwSmConv
End Property

Public Property Get XsFhdArOPrice() As Double
   XsFhdArOPrice = m_XsFhdArOPrice
End Property

Public Property Get XsFhdArOAmt() As Double
   XsFhdArOAmt = m_XsFhdArOAmt
End Property

Public Property Get XsFhdArBz() As String
   XsFhdArBz = m_XsFhdArBz
End Property

Public Property Get XsFhdArMioNo() As Double
   XsFhdArMioNo = m_XsFhdArMioNo
End Property

Public Property Get XsFhdArNo() As Double
   XsFhdArNo = m_XsFhdArNo
End Property

Public Property Let XsFhdAr_XsSodno(vXsFhdAr_XsSodno As Double)
   If vXsFhdAr_XsSodno = 0 Then
      m_XsFhdAr_XsSodDocno = ""
      Exit Property
   End If

   Dim mSod As XsSod
   Set mSod = New XsSod
   If mSod.Requery(vXsFhdAr_XsSodno) = -1 Then
      Set mSod = Nothing
      Err.Raise vbObjectError + 1, , "对应的销售订单行不存在！"
      Exit Property
   End If
   m_XsFhdAr_XsSodDocno = mSod.XsSodh.XsSodhDocno
   m_XsFhdAr_HwBmno = mSod.XsSod_HwBmno
   m_XsFhdAr_HwBmCode = mSod.XsSod_HwBmCode
   m_XsFhdAr_HwBmMc = mSod.XsSod_HwBmMc
   Set mSod = Nothing
   m_XsFhdAr_XsSodno = vXsFhdAr_XsSodno
   
End Property

Public Property Let XsFhdAr_HwBmCode(vXsFhdAr_HwBmCode As String)
   If Trim(vXsFhdAr_HwBmCode) = "" Then
      Err.Raise vbObjectError + 1, , "货物编码不能为空！"
      Exit Property
   End If
   If m_XsFhdAr_HwBmCode <> vXsFhdAr_HwBmCode Then
      If Hwbm.Requery(vXsFhdAr_HwBmCode) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的货物编码不存在！"
         Exit Property
      End If
      m_XsFhdAr_HwBmno = Hwbm.HwBmNo
      m_XsFhdAr_HwBmMc = Hwbm.HwBmMc
      m_XsFhdAr_HwDwCode = Hwbm.HwBm_HwDwCode
      m_XsFhdAr_HwDwNo = Hwbm.HwBm_HwDwNo
      m_XsFhdAr_HwDwConv = 1
   End If
   m_XsFhdAr_HwBmCode = vXsFhdAr_HwBmCode
End Property

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

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

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

Public Property Let XsFhdArQty(vXsFhdArQty As Double)
   If vXsFhdArQty <= 0 Then
      Err.Raise vbObjectError + 1, , "数量必须大于零！"
      Exit Property
   End If
   m_XsFhdArQty = vXsFhdArQty
   m_XsFhdArAmt = Val(Format(vXsFhdArQty * m_XsFhdArPrice, "##"))
End Property

Public Property Let XsFhdArPrice(vXsFhdArPrice As Double)
   If vXsFhdArPrice < 0 Then
      Err.Raise vbObjectError + 1, , "单价不能小于零！"
      Exit Property
   End If
   m_XsFhdArPrice = vXsFhdArPrice
   m_XsFhdArAmt = Val(Format(vXsFhdArPrice * m_XsFhdArQty, "##"))
End Property

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

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

Public Property Let XsFhdArBz(vXsFhdArDBz As String)
   m_XsFhdArBz = vXsFhdArDBz
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_XsFhdArId = -1 Then
   
      Cmd.CommandText = gPublicFunction.GetCallSPString("XsFhdArREC_INSERT", 16)
      
      Cmd(0) = m_XsFhdArh.XsFhdArhNo
      Cmd(1) = m_XsFhdAr_XsSodno
      Cmd(2) = m_XsFhdAr_HwBmno
      Cmd(3) = m_XsFhdAr_HwDwNo
      Cmd(4) = m_XsFhdAr_HwDwConv
      Cmd(5) = m_XsFhdAr_HwCkno
      Cmd(6) = m_XsFhdArQty
      Cmd(7) = m_XsFhdArPrice
      Cmd(8) = m_XsFhdArAmt
      Cmd(9).Direction = adParamOutput  'm_XsFhdArOPrice
      Cmd(10).Direction = adParamOutput 'm_XsFhdArOAmt
      Cmd(11) = m_XsFhdAr_CwSmNo
      Cmd(12) = m_XsFhdAr_CwSmConv
      Cmd(13) = m_XsFhdArBz
      Cmd(14).Direction = adParamOutput 'XsFhdArMiono
      Cmd(15).Direction = adParamOutput     'CgShdNo
      
   Else
      
      Cmd.CommandText = gPublicFunction.GetCallSPString("XsFhdArREC_UPDATE", 13)
      
      Cmd(0) = m_XsFhdArNo
      Cmd(1) = m_XsFhdAr_HwBmno
      Cmd(2) = m_XsFhdAr_HwDwNo
      Cmd(3) = m_XsFhdAr_HwDwConv
      Cmd(4) = m_XsFhdAr_HwCkno
      Cmd(5) = m_XsFhdArQty
      Cmd(6) = m_XsFhdArPrice
      Cmd(7) = m_XsFhdArAmt
      Cmd(8).Direction = adParamOutput  'm_XsFhdArOPrice
      Cmd(9).Direction = adParamOutput 'm_XsFhdArOAmt
      Cmd(10) = m_XsFhdAr_CwSmNo
      Cmd(11) = m_XsFhdAr_CwSmConv
      Cmd(12) = m_XsFhdArBz
      
   End If
   
   Cmd.Execute
   
   If m_XsFhdArId = -1 Then
      m_XsFhdArOPrice = Cmd(9)
      m_XsFhdArOAmt = Cmd(10)
      m_XsFhdArMioNo = Cmd(14)
      m_XsFhdArNo = Cmd(15)
      m_XsFhdArId = 1
   Else
      m_XsFhdArOPrice = Cmd(8)
      m_XsFhdArOAmt = Cmd(9)
   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 XsFhdArREC_DELETE(?)}"
   Cmd(0) = m_XsFhdArNo
   
   gDbCommon.Conn.BeginTrans
   Cmd.Execute
   If XsFhdArh.XsFhdArs.Count = 1 Then
      XsFhdArh.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(vXsFhdArNo As Double) As Integer
   Dim mRs As DbRs
   Dim mSqlStr As String
On Error GoTo Errorhandle
   Requery = -1
   
   Set mRs = New DbRs
   
   mSqlStr = "SELECT XsFhdAr_XsFhdArHNO,XsFhdAr_XsSodDOCNO=COALESCE((SELECT XsSodHDOCNO FROM XsSodHREC,XsSodREC WHERE XsSodNO=XsFhdAr_XsSodNO AND XsSodHNO=XsSod_XsSodHNO),''),XsFhdAr_XsSodNO,"
   mSqlStr = mSqlStr & "XsFhdAr_HwBmCode=COALESCE((SELECT HwBmCode FROM HWBMREC WHERE HWBMNO=XsFhdAr_HWBMNO),''),XsFhdAr_HwBmMc=COALESCE((SELECT HwBmMc FROM HWBMREC WHERE HWBMNO=XsFhdAr_HWBMNO),''),XsFhdAr_HWBMNO,"
   mSqlStr = mSqlStr & "XsFhdAr_HwCkMc=COALESCE((SELECT HwCkMc FROM HWCKREC WHERE HWCKNO=XsFhdAr_HWCKNO),''),XsFhdAr_HWCKNO,"
   mSqlStr = mSqlStr & "XsFhdAr_HwDwCode=COALESCE((SELECT HWDWCode FROM HWDWREC WHERE HWDWNO=XsFhdAr_HWDWNO),''),XsFhdAr_HWDWNO,XsFhdAr_HWDWCONV,"
   mSqlStr = mSqlStr & "XsFhdArQTY,XsFhdArPRICE,XsFhdArAMT,XsFhdArOPrice,XsFhdArOAmt,"
   mSqlStr = mSqlStr & "XsFhdAr_CWSMCODE=COALESCE((SELECT CWSMCODE FROM CWSMREC WHERE CWSMNO=XsFhdAr_CWSMNO),''),XsFhdAr_CWSMNO,XsFhdAr_CWSMCONV,"
   mSqlStr = mSqlStr & "XsFhdArBZ,XsFhdArMIONO,XsFhdArNO FROM XsFhdArREC WHERE XsFhdArNO=" & CStr(vXsFhdArNo)
   
   mRs.Fillbydb mSqlStr
   
   If Not mRs.EOF Then
      BatchLet mRs!XsFhdAr_XsFhdArhno, mRs!XsFhdAr_XsSodDocno, mRs!XsFhdAr_XsSodno, mRs!XsFhdAr_HwBmCode, mRs!XsFhdAr_HwBmMc, mRs!XsFhdAr_HwBmno, _
               mRs!XsFhdAr_HwCkMc, mRs!XsFhdAr_HwCkno, mRs!XsFhdAr_HwDwCode, mRs!XsFhdAr_HwDwno, mRs!XsFhdAr_HwDwConv, _
               mRs!XsFhdArQty, mRs!XsFhdArPrice, mRs!XsFhdArAmt, mRs!XsFhdArOPrice, mRs!XsFhdArOAmt, _
               mRs!XsFhdAr_CwSmCode, mRs!XsFhdAr_CwSmno, mRs!XsFhdAr_CwsmConv, _
               mRs!XsFhdArBz, mRs!XsFhdArMioNo, mRs!XsFhdArNo
   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_XsFhdAr_XsFhdArhno = Properties(0)
   m_XsFhdAr_XsSodDocno = Properties(1)
   m_XsFhdAr_XsSodno = Properties(2)
   m_XsFhdAr_HwBmCode = Properties(3)
   m_XsFhdAr_HwBmMc = Properties(4)
   m_XsFhdAr_HwBmno = Properties(5)
   m_XsFhdAr_HwCkMc = Properties(6)
   m_XsFhdAr_HwCkno = Properties(7)
   m_XsFhdAr_HwDwCode = Properties(8)
   m_XsFhdAr_HwDwNo = Properties(9)
   m_XsFhdAr_HwDwConv = Properties(10)
   m_XsFhdArQty = Properties(11)
   m_XsFhdArPrice = Properties(12)
   m_XsFhdArAmt = Properties(13)
   
   m_XsFhdArOPrice = Properties(14)
   m_XsFhdArOAmt = Properties(15)

   m_XsFhdAr_CwSmCode = Properties(16)
   m_XsFhdAr_CwSmNo = Properties(17)
   m_XsFhdAr_CwSmConv = Properties(18)
   m_XsFhdArBz = Properties(19)
   
   m_XsFhdArMioNo = Properties(20)
   m_XsFhdArNo = Properties(21)

   m_XsFhdArId = 1

End Sub