scds.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 = "Scds"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Dim OScds As Collection

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

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

Public Sub Add(oScd As Scd, Optional Needsave As Integer = 1)
   Dim mKey As Integer
   Dim vScd As Scd
   For Each vScd In OScds
      If mKey < vScd.ScdKey Then
         mKey = vScd.ScdKey
      End If
   Next
   oScd.ScdKey = mKey + 1
   If Needsave = 1 Then
      oScd.Save
   End If
   OScds.Add Item:=oScd, Key:=CStr(mKey + 1)
End Sub

Public Sub Remove(Vindex, Optional Needdel As Integer = 1)
 
   Dim oScd As Scd
   Set oScd = Item(Vindex)
   If Needdel = 1 And oScd.ScdId = 1 Then
      oScd.Del
   End If
   OScds.Remove (Vindex)
   Set oScd = Nothing
   
End Sub

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

Public Function Item(Vindex) As Scd
Attribute Item.VB_UserMemId = 0
   Set Item = OScds.Item(Vindex)
End Function

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

Public Sub Fillbydb(Optional vWhereStr As String = "", Optional vOrderStr As String = "SCDDOCNO")
   Dim oScd As Scd
   Dim mRs As DbRs
   Dim mKey As Integer
   Dim mSqlStr As String
On Error GoTo Errorhandle

   ClearAll
   
   mSqlStr = "SELECT SCDTYPE,SCDDOCNO,SCDDAT,"
   mSqlStr = mSqlStr & "Scd_PsBmCODE=COALESCE((SELECT PsBmCODE FROM PsBmREC WHERE PsBmNO=Scd_PsBmNO),''),Scd_PsBmMc=COALESCE((SELECT PsBmMc FROM PsBmREC WHERE PsBmNO=Scd_PsBmNO),''),Scd_PsBmNO,"
   mSqlStr = mSqlStr & "Scd_HwBmCode=COALESCE((SELECT HwBmCode FROM HWBMREC WHERE HWBMNO=Scd_HWBMNO),''),Scd_HwBmMc=COALESCE((SELECT HwBmMc FROM HWBMREC WHERE HWBMNO=Scd_HWBMNO),''),Scd_HWBMNO,"
   mSqlStr = mSqlStr & "Scd_HwDwCode=COALESCE((SELECT HWDWCode FROM HWDWREC WHERE HWDWNO=Scd_HWDWNO),''),Scd_HWDWNO,Scd_HWDWCONV,"
   mSqlStr = mSqlStr & "ScdQTY,SCDWQTY,SCDBDAT,SCDWDAT,ScdBZ,SCDFORM,ScdNO FROM ScdREC"
   
   If vWhereStr <> "" Then
      mSqlStr = mSqlStr & " WHERE " & vWhereStr
   End If
   
   If vOrderStr <> "" Then
      mSqlStr = mSqlStr & " ORDER BY " & vOrderStr
   End If
   
   Set mRs = New DbRs
   mRs.Fillbydb mSqlStr
   
   mRs.MoveFirst
   
   mKey = 1
   Do Until mRs.EOF
      Set oScd = New Scd
      oScd.ScdKey = mKey
      oScd.BatchLet mRs!ScdType, mRs!ScdDocno, mRs!ScdDat, mRs!Scd_PsBmCode, mRs!Scd_PsBmMc, mRs!Scd_PsBmno, mRs!Scd_HwBmCode, mRs!Scd_HwBmMc, mRs!Scd_HwBmno, _
                    mRs!Scd_HwDwCode, mRs!Scd_HwDwno, mRs!Scd_HwDwConv, _
                    mRs!ScdQty, mRs!ScdWQty, mRs!ScdBDat, mRs!ScdWDat, mRs!ScdBz, mRs!ScdForm, mRs!ScdNo
      OScds.Add Item:=oScd, 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 = OScds.[_NewEnum]
End Function

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