laatzen/Pruef2000/source/CVorpruefpunktCol.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 = "CVorpruefpunktCol"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'==============================================================================
'
' File   : PruefpunktCollection.cls
' Author : Andreas Schmidt, lindner & partner
' Date   : 14.04.1999
' Version: 1.00
'
'==============================================================================
'
' Verwaltung einer Menge von CVorpruefpunkt-Objekten in einer Collection mit
' Funktionalität zum Sortieren der Objekte nach Durchfluss und useCount.
'
'==============================================================================
'
' History:
'
' Übernommen aus CPruefpunktCol am 12.12.2001
' Erste Version.
'
'==============================================================================

Option Explicit

' Private Member
' --------------
Private m_colPP As Collection


Private Sub Class_Initialize()
    Call init
End Sub

' Alle Member neu initialisieren
'
Private Sub init()
    Set m_colPP = New Collection
End Sub

Public Sub Add(PP As CVorpruefpunkt)
    m_colPP.Add PP
End Sub

' @return CVorpruefpunkt-Objekt an der angegebenen Position
'
Public Function Item(i As Integer) As CVorpruefpunkt
    Set Item = m_colPP.Item(i)
End Function

' @return Position des Pruefpunkt-Objekt in der PruefpunktCollection
'
Public Function ItemNr(Pruefpunkt As CVorpruefpunkt) As Integer
Dim Index As Integer
    For Index = 1 To m_colPP.Count
    If m_colPP.Item(Index) Is Pruefpunkt Then
        ItemNr = Index
        Exit Function
    End If
    Next
End Function


' @return Anzahl der Prüfpunkte
'
Public Function Count() As Integer
    Count = m_colPP.Count
End Function

' @return internes Collection-Objekt
'
Public Function getCollection() As Collection
    Set getCollection = m_colPP
End Function

' @return true = gesuchter Durchfluss ist in der Menge der Pruefpunkte
'
Public Function hasQ(dQ As Double) As Boolean
Dim PP As CVorpruefpunkt
    For Each PP In getCollection
        If PP.getQ() = dQ Then
            hasQ = True
            Exit Function
        End If
    Next
End Function


' @return Pruefpunkt Objekt aus der Collection mit vorgegebenen Durchfluss
'
Public Function getPP(dQ As Double) As CVorpruefpunkt
Dim PP As CVorpruefpunkt
    For Each PP In getCollection
        If PP.getQ() = dQ Then
            Set getPP = PP
            Exit Function
        End If
    Next
    getPP = Nothing
End Function

' Prüfpunkte absteigend nach Durchfluss sortieren
'
Public Sub sortQ()
    Call sortQFrom(1)
End Sub

' Hauptfunktion für das Sortieren nach dem Durchfluss.
' Wir führen hier einen einfachen Bubblesort durch.
'
Private Sub sortQFrom(nIndex As Integer)
    Dim i As Integer
    Dim tmpPP As CVorpruefpunkt
    
    For i = nIndex To m_colPP.Count
        If i > 1 Then
            If m_colPP.Item(i - 1).getQ() < m_colPP.Item(i).getQ() Then
                If tmpPP Is Nothing Then
                    Set tmpPP = New CVorpruefpunkt
                End If
                
                Call tmpPP.copyFrom(m_colPP.Item(i))
                Call m_colPP.Item(i).copyFrom(m_colPP.Item(i - 1))
                Call m_colPP.Item(i - 1).copyFrom(tmpPP)
                Call sortQFrom(i - 1)
            End If
        End If
    Next i
End Sub

' Prüfpunkte aufsteigend nach dem useCount-Member sortieren
'
Public Sub sortUseCount()
    Call sortUseCountFrom(1)
End Sub

Public Sub Clear()
    Set m_colPP = Nothing
    Set m_colPP = New Collection
End Sub


' Hauptfunktion für das Sortieren nach dem useCount-Member.
' Wir führen hier einen einfachen Bubblesort durch.
'
Private Sub sortUseCountFrom(nIndex As Integer)
    Dim i As Integer
    Dim tmpPP As CVorpruefpunkt
    
    For i = nIndex To m_colPP.Count
        If i > 1 Then
            If m_colPP.Item(i - 1).getUseCount() > m_colPP.Item(i).getUseCount() Then
                If tmpPP Is Nothing Then Set tmpPP = New CVorpruefpunkt
                Call tmpPP.copyFrom(m_colPP.Item(i))
                Call m_colPP.Item(i).copyFrom(m_colPP.Item(i - 1))
                Call m_colPP.Item(i - 1).copyFrom(tmpPP)
                Call sortUseCountFrom(i - 1)
            End If
        End If
    Next i
End Sub