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

Dim oBoms As Collection

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

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

Private Sub Class_Terminate()
   Set oBoms = Nothing
End Sub

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

Public Sub Add(oBom As Bom, Optional NeedSave As Integer = 1)
   Dim Key As Integer
   Dim mBom As Bom
   
   If NeedSave = 1 Then
      oBom.Save
   End If
   
   Key = 0
   
   For Each mBom In oBoms
      If Key < mBom.BomKey Then
         Key = mBom.BomKey
      End If
   Next
   oBom.BomKey = Key + 1
   oBoms.Add Item:=oBom, Key:=CStr(oBom.BomKey)
   
End Sub

Public Sub Chg(oBom As Bom, vOldKey As String, vNewKey As String)

   If oBom.Bom_Id = 1 Then
       oBom.Save
   End If
   
   oBoms.Remove vOldKey
   oBoms.Add oBom, vNewKey

End Sub

Public Function Item(Vindex) As Bom
Attribute Item.VB_UserMemId = 0
   Set Item = oBoms.Item(Vindex)
End Function

Public Sub Remove(Vindex, Optional NeedDel As Integer = 1)
      
   Dim oBom As Bom
   Set oBom = Item(Vindex)
   If NeedDel = 1 And oBom.Bom_Id = 1 Then
      oBom.Del
   End If
   oBoms.Remove (Vindex)
   Set oBom = Nothing
   
End Sub

Public Sub ClearAll()

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

End Sub

Public Function NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
   Set NewEnum = oBoms.[_NewEnum]
End Function

Public Sub LoadData(vBomA_HwbmCode As String, Optional vBomType As Integer = 0)
   Dim mRs As DbRs
   Dim KeyStr As Integer
   Dim oBom As Bom
   Dim SqlStr As String
On Error GoTo ErrorHandle
  
   Set mRs = New DbRs
   
   SqlStr = "BOMREC_BOMTREE '" & vBomA_HwbmCode & "'," & CStr(vBomType)
   mRs.Fillbydb SqlStr
  
   ClearAll
   mRs.MoveFirst
   KeyStr = 1
   
   Do Until mRs.EOF
      Set oBom = New Bom
      oBom.BatchLet mRs!BomLevel, mRs!BomA_HwbmNo, mRs!BomA_HwbmCode, mRs!BomA_HwbmMc, mRs!BomItem, mRs!BomC_HwbmNo, mRs!BomC_HwbmCode, mRs!BomC_HwbmMc, mRs!Bom_HwDwCode, mRs!BomQty, mRs!BomShl, mRs!BomBz, mRs!BomNo
      oBom.BomKey = KeyStr
      oBoms.Add Item:=oBom, Key:=CStr(KeyStr)
      KeyStr = KeyStr + 1
      mRs.MoveNext
   Loop
   
   Set mRs = Nothing

Exit Sub
ErrorHandle:
   Set mRs = Nothing
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Public Sub Save()
   Dim NotSaved As Collection
   Dim mBom As Bom
On Error GoTo ErrorHandle
    
   Set NotSaved = New Collection
   
   gDbCommon.Conn.BeginTrans
   
   For Each mBom In oBoms
      If mBom.Bom_Id = -1 Then
         NotSaved.Add mBom
      End If
      mBom.Save
   Next
   
   gDbCommon.Conn.CommitTrans
   
   Set NotSaved = Nothing
    
Exit Sub
ErrorHandle:
   For Each mBom In NotSaved
      mBom.Bom_Id = -1
   Next
   Set NotSaved = Nothing
   gDbCommon.Conn.RollbackTrans
   Err.Raise vbObjectError + 1, , gDbCommon.Conn.Errors(0)
End Sub

Public Function MaxItem() As Integer
   Dim mMaxItem As Integer
   Dim mBom As Bom
   
   For Each mBom In oBoms
      If mBom.BomItem > MaxItem Then
         mMaxItem = mBom.BomItem
      End If
   Next
   
   MaxItem = mMaxItem + 1

End Function