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

📄 cgshdaphs.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 = "CgShdAphs"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Dim oCgShdAphs As Collection

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

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

Public Sub Add(oCgShdAph As CgShdAph, Optional Needsave As Integer = 1)
   Dim mKey As Integer
   Dim vCgShdAph As CgShdAph
   For Each vCgShdAph In oCgShdAphs
      If mKey < vCgShdAph.CgShdAphKey Then
         mKey = vCgShdAph.CgShdAphKey
      End If
   Next
   oCgShdAph.CgShdAphKey = mKey + 1
   If Needsave = 1 Then
      oCgShdAph.Save
   End If
   oCgShdAphs.Add Item:=oCgShdAph, Key:=CStr(mKey + 1)
End Sub

Public Sub Remove(Vindex, Optional Needdel As Integer = 1)
 
   Dim oCgShdAph As CgShdAph
   Set oCgShdAph = Item(Vindex)
   If Needdel = 1 And oCgShdAph.CgShdAphId = 1 Then
      oCgShdAph.Del
   End If
   oCgShdAphs.Remove (Vindex)
   Set oCgShdAph = Nothing
   
End Sub

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

Public Function Item(Vindex) As CgShdAph
Attribute Item.VB_UserMemId = 0
   Set Item = oCgShdAphs.Item(Vindex)
End Function

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

Public Sub Fillbydb(Optional vWhereStr As String = "")
   Dim oCgShdAph As CgShdAph
   Dim mRs As DbRs
   Dim mKey As Integer
   Dim mSqlStr As String
On Error GoTo Errorhandle

   ClearAll
   
   mSqlStr = "SELECT CgShdApHTYPE,CgShdApHDOCNO,CgShdApHDAT,CgShdApH_KHCODE=COALESCE((SELECT KHCODE FROM KHREC WHERE KHNO=CgShdApH_KHNO),''),CgShdApH_KHNO,"
   mSqlStr = mSqlStr & "CgShdAph_CwQjCode=COALESCE((SELECT CWQJCODE FROM CWQJREC WHERE CWQJNO=CgShdAph_CwQjno),''),CgShdAph_CwQjno,"
   mSqlStr = mSqlStr & "CgShdAph_CwBzCode=COALESCE((SELECT CWBZCODE FROM CWBZREC WHERE CWBZNO=CgShdAph_CwBzno),''),CgShdAph_CwBzno,CgShdAph_CwBzConv,"
   mSqlStr = mSqlStr & "CGSHDAPHAMT,CgShdApHFORM,CgshdAph_ApMxno,CGSHDAPH_ARAPNO,CgShdApHNO FROM CgShdApHREC"
   
   If vWhereStr <> "" Then
      mSqlStr = mSqlStr & " WHERE " & vWhereStr
   End If
   
   mSqlStr = mSqlStr & " ORDER BY CgShdApHDOCNO"
   
   Set mRs = New DbRs
   mRs.Fillbydb mSqlStr
   
   mRs.MoveFirst
   
   mKey = 1
   Do Until mRs.EOF
      Set oCgShdAph = New CgShdAph
      oCgShdAph.CgShdAphKey = mKey
      oCgShdAph.BatchLet mRs!CgShdAphType, mRs!CgShdAphDocno, mRs!CgShdAphDat, mRs!CgShdAph_CwQjCode, mRs!CgShdAph_CwqjNo, mRs!CgShdAph_KhCode, mRs!CgShdAph_Khno, mRs!CgShdAph_CwBzCode, mRs!CgShdAph_CwBzno, mRs!CgShdAph_CwBzConv, mRs!CgShdAphAmt, mRs!CgShdAphForm, mRs!CgShdAph_ApMxNo, mRs!CgShdAph_ArApNo, mRs!CgShdAphNo
      oCgShdAphs.Add Item:=oCgShdAph, Key:=CStr(mKey)
      mRs.MoveNext
      mKey = mKey + 1
   Loop
   
   Set mRs = Nothing

Exit Sub
Errorhandle:
   Set mRs = 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 = oCgShdAphs.[_NewEnum]
End Function

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




⌨️ 快捷键说明

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