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

Dim M_HwFl As HwFl
Dim M_HwDw As HwDw

Dim M_HwBm_HwFlNo As Double
Dim M_HwBm_HwFlCode As String
Dim M_HwBm_HwFlMc As String

Dim M_HwBmCode As String
Dim M_HwBmMc As String
Dim M_HwBmEMc As String
Dim M_HwBmSize As String

Dim M_HwBm_HwDwNo As Double
Dim M_HwBm_HwDwCode As String

Dim M_HwBmIsStop As Integer
Dim M_HwBmNo As Double

Dim M_HwBm_id As Integer
Dim M_HwBm_Key As Long

Private Sub Class_Initialize()

M_HwBm_id = -1

End Sub

Public Property Get HwFl() As HwFl

If M_HwFl Is Nothing Then
   Set M_HwFl = New HwFl
   If M_HwBm_HwFlCode <> "" Then
      M_HwFl.Requery M_HwBm_HwFlCode
   End If
End If

Set HwFl = M_HwFl

End Property

Public Property Get HwDw() As HwDw

If M_HwDw Is Nothing Then
   Set M_HwDw = New HwDw
   If M_HwBm_HwDwCode <> "" Then
      M_HwDw.Requery M_HwBm_HwDwCode
   End If
End If

Set HwDw = M_HwDw

End Property

Public Property Get HwBm_HwFlNo() As Double

HwBm_HwFlNo = M_HwBm_HwFlNo

End Property

Public Property Get HwBm_HwFlCode() As String

HwBm_HwFlCode = M_HwBm_HwFlCode

End Property

Public Property Get HwBm_HwFlMc() As String

HwBm_HwFlMc = M_HwBm_HwFlMc

End Property

Public Property Get HwBmCode() As String

HwBmCode = M_HwBmCode

End Property

Public Property Get HwBmMc() As String

HwBmMc = M_HwBmMc

End Property

Public Property Get HwBmEMc() As String

HwBmEMc = M_HwBmEMc

End Property

Public Property Get HwBmSize() As String

HwBmSize = M_HwBmSize

End Property

Public Property Get HwBm_HwDwNo() As Double

HwBm_HwDwNo = M_HwBm_HwDwNo

End Property

Public Property Get HwBm_HwDwCode() As String

HwBm_HwDwCode = M_HwBm_HwDwCode

End Property

Public Property Get HwBmIsStop() As Integer

HwBmIsStop = M_HwBmIsStop

End Property

Public Property Get HwBmNo() As Double

HwBmNo = M_HwBmNo

End Property

Public Property Get HwBm_id() As Integer

    HwBm_id = M_HwBm_id

End Property

Public Property Get HwBm_Key() As Long

    HwBm_Key = M_HwBm_Key

End Property

Public Property Let HwBm_HwFlCode(vHwBm_HwFlCode As String)

If Trim(vHwBm_HwFlCode) = "" Then
   Err.Raise Number:=vbObjectError + 1, Description:="货物分类不能为空！"
   Exit Property
End If

If vHwBm_HwFlCode <> M_HwBm_HwFlCode Then
   If HwFl.Requery(vHwBm_HwFlCode) = -1 Then
      Err.Raise Number:=vbObjectError + 1, Description:="选择的货物分类码不存在！"
      Exit Property
   End If
   M_HwBm_HwFlNo = HwFl.HwFlNo
   M_HwBm_HwFlMc = HwFl.HwFlMc
   M_HwBm_HwFlCode = vHwBm_HwFlCode
End If

End Property

Public Property Let HwBmCode(vHwBmCode As String)

If Trim(vHwBmCode) = "" Then
   Err.Raise Number:=vbObjectError + 1, Description:="货物编码不能为空！"
   Exit Property
End If

If vHwBmCode <> M_HwBmCode Then
    If M_HwBm_id = -1 Or vHwBmCode <> M_HwBmCode Then
       If gPublicFunction.ExistFlg("FROM HwBmREC WHERE HwBmCode='" + vHwBmCode + "'") = 1 Then
          Err.Raise Number:=vbObjectError + 1, Description:="已有货物编码:" & vHwBmCode
          Exit Property
       End If
    End If
End If
    
M_HwBmCode = vHwBmCode

End Property

Public Property Let HwBmMc(VHwBmMc As String)

If Trim(VHwBmMc) = "" Then
   Err.Raise vbObjectError + 1, , "货物名称不能为空！"
   Exit Property
End If

M_HwBmMc = VHwBmMc

End Property

Public Property Let HwBmEMc(VHwBmEMc As String)

M_HwBmEMc = VHwBmEMc

End Property

Public Property Let HwBmSize(VHwBmSize As String)

M_HwBmSize = VHwBmSize

End Property

Public Property Let HwBm_HwDwCode(vHwBm_HwDwCode As String)

If Trim(vHwBm_HwDwCode) = "" Then
   Err.Raise Number:=vbObjectError + 1, Description:="计量单位不能为空！"
   Exit Property
End If

If vHwBm_HwDwCode <> M_HwBm_HwDwCode Then
   If HwDw.Requery(vHwBm_HwDwCode) = -1 Then
      Err.Raise Number:=vbObjectError + 1, Description:="选择的计量单位不存在！"
      Exit Property
   End If
   M_HwBm_HwDwNo = HwDw.HwDwNo
   M_HwBm_HwDwCode = vHwBm_HwDwCode
End If

End Property

Public Property Let HwBmIsStop(VHwBmIsStop As Integer)

If VHwBmIsStop <> 0 And VHwBmIsStop <> 1 Then
   Err.Raise vbObjectError + 1, , "停用标志只能为0或1！"
   Exit Property
End If

M_HwBmIsStop = VHwBmIsStop

End Property

Public Property Let HwBm_id(vHwBm_id As Integer)

M_HwBm_id = vHwBm_id

End Property

Public Property Let HwBm_Key(vHwBm_Key As Long)

M_HwBm_Key = vHwBm_Key

End Property

Public Sub DbSave()
   Dim Cmd As ADODB.Command
   Dim mSqlStr As String
On Error GoTo ErrorHandle


   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
   
   If M_HwBm_id = -1 Then
   
       Cmd.CommandText = "{CALL HwBmREC_INSERT(?,?,?,?,?,?,?,?)}"
       
       Cmd.Parameters(0) = M_HwBm_HwFlNo
       Cmd.Parameters(1) = M_HwBmCode
       Cmd.Parameters(2) = M_HwBmMc
       Cmd.Parameters(3) = M_HwBmEMc
       Cmd.Parameters(4) = M_HwBmSize
       Cmd.Parameters(5) = M_HwBm_HwDwNo
       Cmd.Parameters(6) = M_HwBmIsStop
       Cmd.Parameters(7).Direction = adParamOutput
       
       gDbCommon.Conn.BeginTrans
       Cmd.Execute
       gDbCommon.Conn.CommitTrans
       
       M_HwBm_id = 1
   
       M_HwBmNo = Cmd.Parameters(7)
      
   Else
   
       Cmd.CommandText = "{CALL HwBmREC_UPDATE(?,?,?,?,?,?,?,?)}"
       
       Cmd(0) = M_HwBmNo
       
       Cmd(1) = M_HwBm_HwFlNo
       Cmd(2) = M_HwBmCode
       Cmd(3) = M_HwBmMc
       Cmd(4) = M_HwBmEMc
       Cmd(5) = M_HwBmSize
       Cmd(6) = M_HwBm_HwDwNo
       Cmd(7) = M_HwBmIsStop
       
       gDbCommon.Conn.BeginTrans
       Cmd.Execute
       gDbCommon.Conn.CommitTrans
   
   End If
   
   Set Cmd = Nothing

Exit Sub
ErrorHandle:
   Set Cmd = Nothing
   gDbCommon.Conn.RollbackTrans
   Err.Raise vbObjectError + 1, , gDbCommon.Conn.Errors(0)
End Sub

Public Sub DbDel()
   Dim Cmd As ADODB.Command
   
   gPublicFunction.CheckCanBeDelete "HWBMREC", "HWBMNO", CStr(M_HwBmNo)
   
On Error GoTo ErrorHandle

   Set Cmd = New ADODB.Command
   
   Set Cmd.ActiveConnection = gDbCommon.Conn
   
   Cmd.CommandText = "{call HwBmrec_delete(?)}"
   
   Cmd.Parameters(0) = M_HwBmNo
   
   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(vHwBmCode As String) As Integer
   Dim Rs As DbRs
On Error GoTo ErrorHandle

   Set Rs = New DbRs
   
   Rs.Fillbydb ("select HWBM_HWFLNO,HWBM_HWFLCODE=HWFLCODE,HWBM_HWFLMC=HWFLMC,HwBmCode,HwBmMc,HWBMEMC,HWBMSIZE,HWBM_HWDWNO,HWBM_HWDWCODE=HWDWCODE,HwBmISSTOP,HwBmNo FROM HwBmrec,HWFLREC,HWDWREC where HwBmCode='" + vHwBmCode + "' AND HWFLNO=HWBM_HWFLNO AND HWDWNO=HWBM_HWDWNO")
   Requery = -1
   If Not Rs.EOF Then
      Requery = 1
      BatchLet Rs!HwBm_HwFlNo, Rs!HwBm_HwFlCode, Rs!HwBm_HwFlMc, Rs!HwBmCode, Rs!HwBmMc, Rs!HwBmEMc, Rs!HwBmSize, Rs!HwBm_HwDwNo, Rs!HwBm_HwDwCode, Rs!HwBmIsStop, Rs!HwBmNo
   End If
 
   Set Rs = Nothing

Exit Function
ErrorHandle:
   Set Rs = Nothing
   Err.Raise vbObjectError + 1, , Err.Description
End Function

Public Sub BatchLet(ParamArray Properties())

M_HwBm_HwFlNo = Properties(0)
M_HwBm_HwFlCode = Properties(1)
M_HwBm_HwFlMc = Properties(2)
M_HwBmCode = Properties(3)
M_HwBmMc = Properties(4)
M_HwBmEMc = Properties(5)
M_HwBmSize = Properties(6)
M_HwBm_HwDwNo = Properties(7)
M_HwBm_HwDwCode = Properties(8)
M_HwBmIsStop = Properties(9)
M_HwBmNo = Properties(10)

M_HwBm_id = 1

End Sub

Public Property Get Name() As String

Name = "HwBm"

End Property