apfkds.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 = "ApFkds"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Dim oApFkds As Collection

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

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

Public Sub Add(oApFkd As ApFkd, Optional Needsave As Integer = 1)
   Dim mKey As Integer
   Dim vApFkd As ApFkd
   For Each vApFkd In oApFkds
      If mKey < vApFkd.ApFkdKey Then
         mKey = vApFkd.ApFkdKey
      End If
   Next
   oApFkd.ApFkdKey = mKey + 1
   If Needsave = 1 Then
      oApFkd.Save
   End If
   oApFkds.Add Item:=oApFkd, Key:=CStr(mKey + 1)
End Sub

Public Sub Remove(Vindex, Optional Needdel As Integer = 1)
 
   Dim oApFkd As ApFkd
   Set oApFkd = Item(Vindex)
   If Needdel = 1 And oApFkd.ApFkdId = 1 Then
      oApFkd.Del
   End If
   oApFkds.Remove (Vindex)
   Set oApFkd = Nothing
   
End Sub

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

Public Function Item(Vindex) As ApFkd
Attribute Item.VB_UserMemId = 0
   Set Item = oApFkds.Item(Vindex)
End Function

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

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

   ClearAll
   
   mSqlStr = "SELECT ApFkdDOCNO,ApFkdDAT,ApFkd_KHCODE=COALESCE((SELECT KHCODE FROM KHREC WHERE KHNO=ApFkd_KHNO),''),ApFkd_KHNO,"
   mSqlStr = mSqlStr & "ApFkd_CwQjCode=COALESCE((SELECT CWQJCODE FROM CWQJREC WHERE CWQJNO=ApFkd_CwQjno),''),ApFkd_CwQjno,"
   mSqlStr = mSqlStr & "ApFkd_CwZhMc=COALESCE((SELECT CwZhMc FROM CwZhREC WHERE CwZhNO=ApFkd_CwZhno),''),ApFkd_CwZhno,"
   mSqlStr = mSqlStr & "ApFkd_CwBzCode=COALESCE((SELECT CWBZCODE FROM CWBZREC WHERE CWBZNO=ApFkd_CwBzno),''),ApFkd_CwBzno,ApFkd_CWBZCONV,ApFkdAMT,APFKDBZ,"
   mSqlStr = mSqlStr & "ApFkdFORM,ApFkd_ApFkMxno,ApFkd_ARAPNO,ApFkdNO FROM ApFkdREC"
   
   If vWhereStr <> "" Then
      mSqlStr = mSqlStr & " WHERE " & vWhereStr
   End If
   
   mSqlStr = mSqlStr & " ORDER BY APFKDDOCNO"
   
   Set mRs = New DbRs
   mRs.Fillbydb mSqlStr
   
   mRs.MoveFirst
   
   mKey = 1
   Do Until mRs.EOF
      Set oApFkd = New ApFkd
      oApFkd.ApFkdKey = mKey
      oApFkd.BatchLet mRs!ApFkdDocno, mRs!ApFkdDat, mRs!ApFkd_CwQjCode, mRs!ApFkd_CwqjNo, mRs!ApFkd_KhCode, mRs!ApFkd_Khno, mRs!ApFkd_CwZhMc, mRs!ApFkd_cwzhno, mRs!ApFkd_CwBzCode, mRs!ApFkd_CwBzno, mRs!ApFkd_CwBzConv, mRs!ApFkdAmt, mRs!ApFkdBz, mRs!ApFkdForm, mRs!ApFkd_ApFkMxno, mRs!ApFkd_ArApno, mRs!ApFkdNo
      oApFkds.Add Item:=oApFkd, 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 = oApFkds.[_NewEnum]
End Function

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