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

📄 xsfhdhs.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 = "XsFhdhs"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'QQ:75347626
'MSN:whailin2000@hotmail.com
Option Explicit
Dim oXsFhdhs As Collection

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

Private Sub Class_Initialize()
   Set oXsFhdhs = New Collection
End Sub

Public Sub Add(oXsFhdh As XsFhdh, Optional Needsave As Integer = 1)
   Dim mKey As Integer
   Dim vXsFhdh As XsFhdh
   For Each vXsFhdh In oXsFhdhs
      If mKey < vXsFhdh.XsFhdhKey Then
         mKey = vXsFhdh.XsFhdhKey
      End If
   Next
   oXsFhdh.XsFhdhKey = mKey + 1
   If Needsave = 1 Then
      oXsFhdh.Save
   End If
   oXsFhdhs.Add Item:=oXsFhdh, Key:=CStr(mKey + 1)
End Sub

Public Sub Remove(Vindex, Optional Needdel As Integer = 1)
 
   Dim oXsFhdh As XsFhdh
   Set oXsFhdh = Item(Vindex)
   If Needdel = 1 And oXsFhdh.XsFhdhId = 1 Then
      oXsFhdh.Del
   End If
   oXsFhdhs.Remove (Vindex)
   Set oXsFhdh = Nothing
   
End Sub

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

Public Function Item(Vindex) As XsFhdh
Attribute Item.VB_UserMemId = 0
   Set Item = oXsFhdhs.Item(Vindex)
End Function

Public Sub ClearAll()
   Dim I, Vcount As Integer
   Vcount = oXsFhdhs.Count
   For I = 1 To Vcount
      oXsFhdhs.Remove (1)
   Next
End Sub

Public Sub Fillbydb(Optional vWhereStr As String = "")
   Dim oXsFhdh As XsFhdh
   Dim Rs As ADODB.Recordset
   Dim mKey As Integer
   Dim mSqlStr As String
On Error GoTo Errorhandle

   ClearAll
   
   mSqlStr = "SELECT XSFHDHTYPE,XsFhdHDOCNO,XsFhdHDAT,XsFhdH_KHCODE=KHCODE,XsFhdH_KHNO,XsFhdHSYSDAT,XsFhdHSYSTIME,XsFhdHNO FROM XsFhdHREC,KHREC WHERE KHNO=XsFhdH_KHNO"
   
   If vWhereStr <> "" Then
      mSqlStr = mSqlStr & " AND " & vWhereStr
   End If
   
   mSqlStr = mSqlStr & "  ORDER BY XsFhdHDOCNO"
   
   Set Rs = Conn.Execute(mSqlStr)
   
   mKey = 1
   Do Until Rs.EOF
      Set oXsFhdh = New XsFhdh
      oXsFhdh.XsFhdhKey = mKey
      oXsFhdh.BatchLet Rs!XsFhdhType, Rs!XsFhdhDocno, Rs!XsFhdhDat, Rs!XsFhdh_KhCode, Rs!XsFhdh_Khno, Rs!XsFhdhSysDat, Rs!XsFhdhSysTime, Rs!XsFhdhNo
      oXsFhdhs.Add Item:=oXsFhdh, Key:=CStr(mKey)
      Rs.MoveNext
      mKey = mKey + 1
   Loop
   
   Rs.Close
   Set Rs = Nothing

Exit Sub
Errorhandle:
   If Not Rs Is Nothing Then
     Rs.Close
   End If
   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 = oXsFhdhs.[_NewEnum]
End Function

Private Sub Class_Terminate()
   ClearAll
   Set oXsFhdhs = Nothing
End Sub

⌨️ 快捷键说明

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