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

Dim OSysUrUgs As Collection

Public Property Get Count() As Integer

Count = OSysUrUgs.Count
    
End Property

Public Sub Add(OSysUrUg As SysUrUg)

Dim vKey As Integer, vSysUrUg As SysUrUg

For Each vSysUrUg In OSysUrUgs
   If vSysUrUg.SysUrUg_Key > vKey Then
      vKey = vSysUrUg.SysUrUg_Key
   End If
Next

vKey = vKey + 1

OSysUrUg.SysUrUg_Key = vKey
OSysUrUgs.Add OSysUrUg, CStr(vKey)

End Sub

Public Function Item(Vindex) As SysUrUg
Attribute Item.VB_UserMemId = 0

   Set Item = OSysUrUgs.Item(Vindex)

End Function

Public Sub Remove(Vindex)
   
OSysUrUgs.Remove (Vindex)
      
End Sub

Public Sub ClearAll()

Dim i, Vcount As Integer
Vcount = OSysUrUgs.Count

For i = 1 To Vcount
   OSysUrUgs.Remove (1)
Next

End Sub

Public Sub Fillbydb(vSysUr As SysUr, Optional Wherestr As String = "", Optional Orderstr As String = "SysUgCODE")
   Dim OSysUrUg As SysUrUg
   Dim Rs As DbRs
   Dim SqlStr As String
   Dim vKey As Integer
On Error GoTo ErrorHandle

   ClearAll
      
   Set Rs = New DbRs
   Rs.Fillbydb "SELECT SELECTFLG=CASE WHEN EXISTS(SELECT * FROM SYSURUGREC WHERE SYSURUG_SYSURNO=" & CStr(vSysUr.SysUrNo) & " AND SYSURUG_SYSUGNO=SYSUGNO) THEN 1 ELSE 0 END,SYSURUG_SYSURNO=" & CStr(vSysUr.SysUrNo) & ",SYSURUG_SYSUGNO=SYSUGNO,SYSURUG_SYSUGCODE=SYSUGCODE,SYSURUG_SYSUGMC=SYSUGMC,SYSURUGNO=COALESCE((SELECT SYSURUGNO FROM SYSURUGREC WHERE SYSURUG_SYSURNO=" & CStr(vSysUr.SysUrNo) & " AND SYSURUG_SYSUGNO=SYSUGNO),0) FROM SYSUGREC"
   
   Rs.MoveFirst
   
   vKey = 1
   
   Do While Not Rs.EOF
      Set OSysUrUg = New SysUrUg
      Set OSysUrUg.Parent = vSysUr
      OSysUrUg.SysUrUg_Key = vKey
      OSysUrUg.BatchLet Rs!SysUrUg_SysUrNo, Rs!SysUrUg_SysUgNo, Rs!SysUrUg_SysUgCode, Rs!SysUrUg_SysUgMc, Rs!SysUrUgNo, Rs!SelectFlg
      If Rs!SelectFlg = 0 Then
         OSysUrUg.SysUrUg_id = -1
      End If
      OSysUrUgs.Add OSysUrUg, CStr(vKey)
      vKey = vKey + 1
      Rs.MoveNext
   Loop
   
   Set Rs = Nothing

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

Public Function NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"

  Set NewEnum = OSysUrUgs.[_NewEnum]
  
End Function

Private Sub Class_Initialize()

Set OSysUrUgs = New Collection

End Sub

Private Sub Class_Terminate()

Set OSysUrUgs = Nothing

End Sub

Public Property Get Name() As String

Name = "SysUrUgs"

End Property

Public Sub DbSave()
   Dim mNotSaved As Collection
   Dim mNotDeled As Collection
   Dim mSysUrUg As SysUrUg
On Error GoTo ErrorHandle
   
   Set mNotSaved = New Collection
   Set mNotDeled = New Collection
      
   For Each mSysUrUg In OSysUrUgs
      If mSysUrUg.SelectFlg = 1 Then
         If mSysUrUg.SysUrUg_id = -1 Then
            mNotSaved.Add mSysUrUg
         End If
         mSysUrUg.DbSave
      Else
         If mSysUrUg.SysUrUg_id = 1 Then
            mNotDeled.Add mSysUrUg
            mSysUrUg.DbDel
         End If
      End If
   Next
   
   Set mNotSaved = Nothing
   Set mNotDeled = Nothing

Exit Sub
ErrorHandle:
   For Each mSysUrUg In mNotSaved
      mSysUrUg.SysUrUg_id = -1
   Next
   For Each mSysUrUg In mNotDeled
      mSysUrUg.SysUrUg_id = 1
   Next
   Set mNotSaved = Nothing
   Set mNotDeled = Nothing
   Err.Raise vbObjectError + 1, , gDbCommon.Conn.Errors(0)
End Sub