77 lines
2.0 KiB
OpenEdge ABL
77 lines
2.0 KiB
OpenEdge ABL
|
VERSION 1.0 CLASS
|
||
|
|
BEGIN
|
||
|
|
MultiUse = -1 'True
|
||
|
|
END
|
||
|
|
Attribute VB_Name = "CDS_Factorizator"
|
||
|
|
Attribute VB_GlobalNameSpace = False
|
||
|
|
Attribute VB_Creatable = False
|
||
|
|
Attribute VB_PredeclaredId = False
|
||
|
|
Attribute VB_Exposed = False
|
||
|
|
' ========= Module for floating point value groupings ===============
|
||
|
|
' Shared module version: 20210412
|
||
|
|
' Tested in: TestVisio
|
||
|
|
' Depends on:
|
||
|
|
' Required reference: Scripting
|
||
|
|
|
||
|
|
' Note: elements should be comparable
|
||
|
|
Option Explicit
|
||
|
|
|
||
|
|
Private gap_ As Double
|
||
|
|
Private values_ As Scripting.Dictionary
|
||
|
|
Private factors_ As Scripting.Dictionary
|
||
|
|
|
||
|
|
Public Function Init(dDividerGap As Double)
|
||
|
|
gap_ = dDividerGap
|
||
|
|
Set factors_ = New Scripting.Dictionary
|
||
|
|
Set values_ = New Scripting.Dictionary
|
||
|
|
End Function
|
||
|
|
|
||
|
|
Public Property Get Values() As Scripting.Dictionary
|
||
|
|
Set Values = values_
|
||
|
|
End Property
|
||
|
|
|
||
|
|
Public Function Insert(vNewItem As Variant, dValue As Double) As Boolean
|
||
|
|
Insert = Not values_.Exists(vNewItem)
|
||
|
|
If Not Insert Then _
|
||
|
|
Exit Function
|
||
|
|
|
||
|
|
values_(vNewItem) = dValue
|
||
|
|
factors_(vNewItem) = vNewItem
|
||
|
|
If values_.Count = 1 Then _
|
||
|
|
Exit Function
|
||
|
|
|
||
|
|
Dim vItem As Variant
|
||
|
|
For Each vItem In values_
|
||
|
|
If vItem = vNewItem Then _
|
||
|
|
GoTo NEXT_ITEM
|
||
|
|
If VBA.Abs(values_(vItem) - dValue) > gap_ Then _
|
||
|
|
GoTo NEXT_ITEM
|
||
|
|
|
||
|
|
If FactorValueFor(vItem) >= FactorValueFor(vNewItem) Then
|
||
|
|
Call MergeFactors(factors_(vNewItem), factors_(vItem))
|
||
|
|
Else
|
||
|
|
Call MergeFactors(factors_(vItem), factors_(vNewItem))
|
||
|
|
End If
|
||
|
|
NEXT_ITEM:
|
||
|
|
Next vItem
|
||
|
|
End Function
|
||
|
|
|
||
|
|
Public Function FactorFor(vItem As Variant) As Variant
|
||
|
|
If values_.Exists(vItem) Then _
|
||
|
|
FactorFor = factors_(vItem)
|
||
|
|
End Function
|
||
|
|
|
||
|
|
Public Function FactorValueFor(vItem As Variant) As Double
|
||
|
|
If values_.Exists(vItem) Then _
|
||
|
|
FactorValueFor = values_(factors_(vItem))
|
||
|
|
End Function
|
||
|
|
|
||
|
|
' =====
|
||
|
|
Private Function MergeFactors(vOld As Variant, vNew As Variant)
|
||
|
|
Dim vItem As Variant
|
||
|
|
For Each vItem In factors_
|
||
|
|
If factors_(vItem) = vOld Then _
|
||
|
|
factors_(vItem) = vNew
|
||
|
|
Next vItem
|
||
|
|
End Function
|