⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

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

Dim OSysUgRfds As Collection

Public Property Get Count() As Integer
   Count = OSysUgRfds.Count
End Property

Public Sub Add(OSysUgRfd As SysUgRfd)

   Dim vKey As Integer, vSysUgRfd As SysUgRfd
   
   For Each vSysUgRfd In OSysUgRfds
      If vSysUgRfd.SysUgRfd_Key > vKey Then
         vKey = vSysUgRfd.SysUgRfd_Key
      End If
   Next
   
   vKey = vKey + 1
   
   OSysUgRfd.SysUgRfd_Key = vKey
   OSysUgRfds.Add OSysUgRfd, CStr(vKey)

End Sub

Public Function Item(Vindex) As SysUgRfd
Attribute Item.VB_UserMemId = 0
   Set Item = OSysUgRfds.Item(Vindex)
End Function

Public Sub Remove(Vindex, Optional NeedDel As Integer = 1)

   If NeedDel = 1 Then
      Dim mSysUgRfd As SysUgRfd
      Set mSysUgRfd = OSysUgRfds(Vindex)
      mSysUgRfd.DbDel
   End If
      
   OSysUgRfds.Remove (Vindex)
      
End Sub

Public Sub ClearAll()

   Dim i, Vcount As Integer
   Vcount = OSysUgRfds.Count
   
   For i = 1 To Vcount
      OSysUgRfds.Remove (1)
   Next

End Sub

Public Sub Fillbydb(vSysUg As SysUg, Optional Wherestr As String = "", Optional Orderstr As String = "RfdCode")
   Dim OSysUgRfd As SysUgRfd
   Dim Rs As DbRs
   Dim SqlStr As String
   Dim vKey As Integer
On Error GoTo Errorhandle

   ClearAll
   
   SqlStr = "SELECT SELECTFLG=CASE WHEN EXISTS(SELECT * FROM SysUgRfdREC WHERE SYSUGRFD_SYSUGNO=" & CStr(vSysUg.SysUgNo) & " AND SysUgRfd_RFDNO=RFDNO) THEN 1 ELSE 0 END,SysUgRfd_RFDNO=RFDNO,SysUgRfd_RFDCode=RFDCODE,SysUgRfd_RFDMc=RFDMC,SysUgRfdNo=COALESCE((SELECT SysUgRfdNO FROM SysUgRfdREC WHERE SYSUGRFD_SYSUGNO=" & CStr(vSysUg.SysUgNo) & " AND SysUgRfd_RFDNO=RFDNO),0) FROM RFDREC"
   
   If Wherestr <> "" Then
      SqlStr = SqlStr + " WHERE " + Wherestr
   End If
   
   If Orderstr <> "" Then
      SqlStr = SqlStr + " order by " + Orderstr
   End If
   
   Set Rs = New DbRs
   
   Rs.Fillbydb SqlStr
   Rs.MoveFirst
   
   vKey = 1

   Do Until Rs.EOF
      Set OSysUgRfd = New SysUgRfd
      Set OSysUgRfd.SysUg = vSysUg
      OSysUgRfd.BatchLet Rs!SelectFlg, Rs!SysUgRfd_RfdNo, Rs!SysUgRfd_RfdCode, Rs!SysUgRfd_RfdMc, Rs!SysUgRfdNo
      OSysUgRfd.SysUgRfd_Key = vKey
      If OSysUgRfd.SelectFlg = 1 Then
         OSysUgRfd.SysUgRfd_id = 1
      Else
         OSysUgRfd.SysUgRfd_id = -1
      End If
      OSysUgRfds.Add OSysUgRfd, CStr(vKey)
      Rs.MoveNext
      vKey = vKey + 1
   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 = OSysUgRfds.[_NewEnum]
  
End Function

Private Sub Class_Initialize()

Set OSysUgRfds = New Collection

End Sub

Private Sub Class_Terminate()

Set OSysUgRfds = Nothing

End Sub

Public Property Get Name() As String

Name = "SysUgRfds"

End Property

Public Sub DbSave()
   Dim mNotSaved As Collection
   Dim mNotDeled As Collection
   Dim mSysUgRfd As SysUgRfd
On Error GoTo Errorhandle
   
   Set mNotSaved = New Collection
   Set mNotDeled = New Collection
      
   For Each mSysUgRfd In OSysUgRfds
      If mSysUgRfd.SelectFlg = 1 Then
         If mSysUgRfd.SysUgRfd_id = -1 Then
            mNotSaved.Add mSysUgRfd
            mSysUgRfd.DbSave
         End If
      Else
         If mSysUgRfd.SysUgRfd_id = 1 Then
            mNotDeled.Add mSysUgRfd
            mSysUgRfd.DbDel
            mSysUgRfd.SysUgRfd_id = -1
         End If
      End If
   Next
      
   Set mNotSaved = Nothing

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




⌨️ 快捷键说明

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