Dim bMarkAdd As Boolean '用于判断是否已加入到BomTop中的标识
'判断方法，如果AssBom不在BomPoint中，那就是顶级了
Dim sBomAssBom As String
For i = 1 To mBom.Count
sBomAssBom = Trim(mBom.Item(i).AssBom)
'再进行循环
bMark = False
For j = 1 To mBom.Count
If sBomAssBom = Trim(mBom.Item(j).BomPoint) Then
bMark = True
End If
Next j
If bMark = False Then
'如果没有发现有相同的，则BomTop加入
'加入前需要进行判断是否已加入
For n = 1 To BomTop.Count
If BomTop.Item(n) = sBomAssBom Then
bMarkAdd = True
End If
Next n
If bMarkAdd = False Then
'如果没有加入过，则加入
BomTop.Add sBomAssBom
End If
End If
Next i
End Sub
'GetBomTrueList的存储过程用VB来描述
Private Sub CalcNextBom(sAssBom As String, sAssPoint As String, sExp As String)
Dim dQuan As Double
Dim sExpression As String
Dim sPoint As String
Dim BomTop As String
'创建point_cursor处的游标
Dim mBomPoint As Collection
Set mBomPoint = New Collection
'装入相关的集合
Call LoadNextPoint(mBomPoint, sAssPoint)
'装入完毕后，再进行判断是否为明细级半成品，如果不是，递归一次本函数，如果是，加入到mBomReturn里面去
Dim i As Integer
Dim mBomReturnValue As cBomReturnValue
For i = 1 To mBomPoint.Count
'判断是否为明细级
If IsDetailPoint(Trim(mBomPoint.Item(i).BomPoint)) = True Then
'如果是明细级，则加入到cBomReturnValue
Set mBomReturnValue = New cBomReturnValue
mBomReturnValue.AssBom = Trim(sAssBom)
mBomReturnValue.BomPoint = Trim(mBomPoint.Item(i).BomPoint)
'构建表达式
mBomReturnValue.Expression = sExp & "*" & Trim(CStr(mBomPoint.Item(i).Quantity))
mBomReturnValue.Quantity = mBomPoint.Item(i).Quantity
'加入
mBomReturn.Add mBomReturnValue
Else
'如果不是明细项，则再次递归，注意传入的第一个参数，总是顶级Bom，仅作标识符用
Call CalcNextBom(sAssBom, Trim(mBomPoint.Item(i).BomPoint), sExp & "*" & Trim(CStr(mBomPoint.Item(i).Quantity)))
End If
Next i
End Sub
Private Sub LoadNextPoint(ByRef BomPoint As Collection, ByVal PointName As String)
'相当于GetBomTrueList中的游标中的select distinct point,sl from te where Assbom = @pointName
Dim i As Integer
Dim j As Integer
Dim bMark As Boolean
Dim mPointValue As cPointValue
For i = 1 To mBom.Count
bMark = False
If Trim(mBom.Item(i).AssBom) = Trim(PointName) Then
'判断是否已加入
For j = 1 To BomPoint.Count
If Trim(BomPoint.Item(j).BomPoint) = Trim(mBom.Item(i).BomPoint) And BomPoint.Item(j).Quantity = mBom.Item(i).Quantity Then
bMark = True
End If
Next j
If bMark = False Then
'表示没有加入
Set mPointValue = New cPointValue
mPointValue.BomPoint = Trim(mBom.Item(i).BomPoint)
mPointValue.Quantity = mBom.Item(i).Quantity
BomPoint.Add mPointValue
End If
End If
Next i
End Sub
Private Function IsDetailPoint(ByVal PointName As String) As Boolean
'判断是否为底级半成品
'只需要判断PointName不在mBom的AssBom项中即可
Dim i As Integer
For i = 1 To mBom.Count
If Trim(mBom.Item(i).AssBom) = Trim(PointName) Then
'如果找到了，直接返回False，并退出函数
IsDetailPoint = False
Exit Function
End If
Next i
'如果到了这里还没有找到，那么就肯定是底级了
IsDetailPoint = True
End Function
Public Function CalcExpression(strExp As String) As Double
'计算处理中的表达式，注意，只有乘法
Dim sItemExp() As String
Dim dReturnValue As Double
Dim iIndex As Integer
sItemExp = Split(Trim(strExp), "*")
If UBound(sItemExp) < 0 Then
CalcExpression = 0
Else
dReturnValue = 1
For iIndex = 0 To UBound(sItemExp)
If Trim(sItemExp(iIndex)) = "" Then
sItemExp(iIndex) = 0
End If
dReturnValue = dReturnValue * CDbl(sItemExp(iIndex))
Next iIndex
CalcExpression = dReturnValue
End If
End Function
类模块一：类名：cBomReturnValue
Option Explicit
'保持属性值的局部变量
Private mvarAssBom As String '局部复制
Private mvarBomPoint As String '局部复制
Private mvarQuantity As Double '局部复制
Private mvarExpression As String '局部复制
Public Property Let Expression(ByVal vData As String)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.Expression = 5
mvarExpression = vData
End Property
Public Property Get Expression() As String
文章整理：西部数码--专业提供域名注册、虚拟主机服务
http://www.west263.com
以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息，谢谢!
