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

Dim m_Parent As SysCp

Dim M_SysCpCw_SysCpNo As Double
Dim M_SysCpCw_SCwqjNo As Double
Dim M_SysCpCw_SCwqjCode As String
Dim M_SysCpCw_CCwqjNo As Double
Dim M_SysCpCw_CCwqjCode As String
Dim M_SysCpCw_CwBzNo As Double
Dim M_SysCpCw_CwBzCode As String

Dim M_SysCpCwNo As Double

Dim M_SysCpCw_id As Integer
Dim M_SysCpCw_Key As Long

Private Sub Class_Initialize()

M_SysCpCw_id = -1

End Sub

Public Property Get Parent() As SysCp

Set Parent = m_Parent

End Property

Public Property Get SysCpCw_SysCpNo() As Double

SysCpCw_SysCpNo = M_SysCpCw_SysCpNo

End Property

Public Property Get SysCpCw_SCwqjNo() As Double

SysCpCw_SCwqjNo = M_SysCpCw_SCwqjNo

End Property

Public Property Get SysCpCw_SCwqjCode() As String

SysCpCw_SCwqjCode = M_SysCpCw_SCwqjCode

End Property

Public Property Get SysCpCw_CCwqjNo() As Double

SysCpCw_CCwqjNo = M_SysCpCw_CCwqjNo

End Property

Public Property Get SysCpCw_CCwqjCode() As String

SysCpCw_CCwqjCode = M_SysCpCw_CCwqjCode

End Property

Public Property Get SysCpCw_CwBzNo() As Double

SysCpCw_CwBzNo = M_SysCpCw_CwBzNo

End Property

Public Property Get SysCpCw_CwBzCode() As String

SysCpCw_CwBzCode = M_SysCpCw_CwBzCode

End Property

Public Property Get SysCpCwNo() As Double

SysCpCwNo = M_SysCpCwNo

End Property

Public Property Get SysCpCw_id() As Integer

    SysCpCw_id = M_SysCpCw_id

End Property

Public Property Get SysCpCw_Key() As Long

    SysCpCw_Key = M_SysCpCw_Key

End Property

Public Property Let SysCpCw_CwBzCode(vSysCpCw_CwBzCode As String)

   If Trim(vSysCpCw_CwBzCode) = "" Then
      Err.Raise vbObjectError + 1, , "本币不能为空！"
      Exit Property
   End If
   
   If vSysCpCw_CwBzCode <> M_SysCpCw_CwBzCode Then
      Dim mRs As DbRs
      Set mRs = New DbRs
      mRs.Fillbydb "SELECT CWBZCODE,CWBZMC,CWBZNO FROM CWBZREC WHERE CWBZCODE='" & CStr(vSysCpCw_CwBzCode) & "'"
      mRs.MoveFirst
      If mRs.EOF Then
         Set mRs = Nothing
         Err.Raise vbObjectError + 1, , "录入的本币在币种资料中不存在！"
         Exit Property
      End If
      M_SysCpCw_CwBzNo = mRs("CWBZNO")
      M_SysCpCw_CwBzCode = vSysCpCw_CwBzCode
      Set mRs = Nothing
   End If

End Property

Public Property Set Parent(vParent As SysCp)

Set m_Parent = vParent

End Property

Public Property Let SysCpCw_id(vSysCpCw_id As Integer)

M_SysCpCw_id = vSysCpCw_id

End Property

Public Property Let SysCpCw_Key(vSysCpCw_Key As Long)

M_SysCpCw_Key = vSysCpCw_Key

End Property

Public Function Requery(vSysCpCw_SysCpNo As Double) As Integer
   Dim Rs As DbRs
On Error GoTo Errorhandle

   Set Rs = New DbRs
   
   Rs.Fillbydb ("SELECT SYSCPCW_SYSCPNO,SYSCPCW_SCWQJNO,SYSCPCW_SCWQJCODE=COALESCE((SELECT CWQJCODE FROM CWQJREC WHERE CWQJNO=SYSCPCW_SCWQJNO),''),SYSCPCW_CCWQJNO,SYSCPCW_CCWQJCODE=COALESCE((SELECT CWQJCODE FROM CWQJREC WHERE CWQJNO=SYSCPCW_CCWQJNO),''),SYSCPCW_CWBZNO,SYSCPCW_CWBZCODE=COALESCE((SELECT CWBZCODE FROM CWBZREC WHERE CWBZNO=SYSCPCW_CWBZNO),''),SysCpCwNO from SysCpCwrec where SysCpCw_SysCpNo=" + CStr(vSysCpCw_SysCpNo))
   Requery = -1
   If Not Rs.EOF Then
      Requery = 1
      BatchLet Rs!SysCpCw_SysCpNo, Rs!SysCpCw_SCwqjNo, Rs!SysCpCw_SCwqjCode, Rs!SysCpCw_CCwqjNo, Rs!SysCpCw_CCwqjCode, Rs!SysCpCw_CwBzNo, Rs!SysCpCw_CwBzCode, Rs!SysCpCwNo
   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_SysCpCw_SysCpNo = Properties(0)
M_SysCpCw_SCwqjNo = Properties(1)
M_SysCpCw_SCwqjCode = Properties(2)
M_SysCpCw_CCwqjNo = Properties(3)
M_SysCpCw_CCwqjCode = Properties(4)
M_SysCpCw_CwBzNo = Properties(5)
M_SysCpCw_CwBzCode = Properties(6)

M_SysCpCwNo = Properties(7)

M_SysCpCw_id = 1

End Sub

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

Private Sub Class_Terminate()
   Set m_Parent = Nothing
End Sub

Public Sub Start(vSysCpCw_SCwQjCode As String, vSysCpCw_CwBzCode As String)

   If CStr(gPublicCommon.PublicSysDatas("SYSCPCW_SCWQJCODE").SysDataValue) <> "" Then
      Err.Raise vbObjectError + 1, , "系统已启用，不能再次启用！"
      Exit Sub
   End If

   If CStr(vSysCpCw_SCwQjCode) = "" Then
      Err.Raise vbObjectError + 1, , "系统启用月份不能为空！"
      Exit Sub
   End If
   
   If CStr(vSysCpCw_CwBzCode) = "" Then
      Err.Raise vbObjectError + 1, , "未定义系统本位币，不能启动系统！"
      Exit Sub
   End If
   
   If gPublicFunction.ExistFlg("FROM CWQJREC WHERE CWQJCODE='" & vSysCpCw_SCwQjCode & "'") <> 1 Then
      Err.Raise vbObjectError + 1, , "系统启用月份在财务月份资料中未定义！"
      Exit Sub
   End If
   
   If gPublicFunction.ExistFlg("FROM CWBZREC WHERE CWBZCODE='" & vSysCpCw_CwBzCode & "'") <> 1 Then
      Err.Raise vbObjectError + 1, , "系统本位币在币种资料中未定义！"
      Exit Sub
   End If
   
  
On Error GoTo Errorhandle
   
   gDbCommon.Conn.Execute "SYSCPCWREC_UPDATE " & CStr(Parent.SysCpNo) & ",'" & vSysCpCw_SCwQjCode & "','" & vSysCpCw_SCwQjCode & "','" & vSysCpCw_CwBzCode & "'"

Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , gDbCommon.Conn.Errors(0)
End Sub