Sortieren von UDT-Arrays nach einer UDT-Komponente In diesem Workshop soll gezeigt werden, wie man ein Array sortieren kann, dessen Elemente aus einem beleibigen benutzerdefinierten Datentyp bestehen.
Autor:  Manfred Bohn	Bewertung:     [ Jetzt bewerten ]	Views:  21.254

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 1 Bewertung insgesamt: sehr gut Durchschnittliche Bewertung: 5.0 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

In diesem Workshop soll gezeigt werden, wie man ein Array sortieren kann, dessen Elemente aus einem beliebigen benutzerdefinierten Datentyp bestehen.

1. Einige Informationen zu benutzerdefinierten Datentypen

Die Erstellung benutzerdefinierter Datentypen ('user defined type' = UDT) ist eine nützliche Methode, um Daten, die in strukturierter Form vorliegen, zu ordnen und zusammenzufassen.

UDTs können als Komponente nicht nur die einfachen VB-Datentypen enthalten (Byte, Long, Double, Strings fester Länge usw.), sondern auch

• statisch deklarierte Arrays
• Variablen vom Typ einer anderen UDT (hierarchische Datentyp-Verschachtelung)

Des Weiteren sind einige Komponenten-Typen einer UDT über einen Zeiger mit der UDT-Variable verknüpft:

• Strings variabler Länge,
• ein- oder mehrdimensionale dynamisch deklarierte Arrays,
• Objektverweise,
• Verweise auf Collections

Ein besonderer Vorteil von UDTs besteht in der effektiven Verarbeitung beim Dateizugriff durch PUT# und GET# (vgl. Extratipp Juni 2005: Die Erstellung persistenter Klassen).

UDTs, die als 'öffentliche Datentypen in öffentlichen Objektmodulen' deklariert sind(vgl. Tipp 1240:  UDT als Parameter einer Klassen-Prozedur II), besitzen einige zusätzliche nützliche Eigenschaften:

• Verwendbarkeit als Parameter in einer Klassenprozedur
• Möglichkeit der Übergabe an einen Variant-Parameter in einer Prozedur-Deklaration
• Möglichkeit der Zuweisung auf eine Variable des Datentyps VARIANT
• Verwendbarkeit der VB-Funktion 'TypeName'

2. Sortieren von Arrays, deren Elemente aus einem UDT gebildet sind

Die Deklaration von Arrays, deren Feldelemente aus einem UDT bestehen, ist in VB problemlos möglich. Die Verwendung unterscheidet sich nicht von anderen Arrays. Die Datenkomponenten und ggf. die Zeiger, aus denen ein einzelnes UDT-Feldelement besteht, sind im Speicher zu einem Datenblock zusammengefasst. Das Sortieren eines eindimensionalenArrays, dessen Felder aus einem beliebig zusammengesetzten UDT bestehen, kann durch Überlagerung der im Speicher enthaltenen - unmittelbar hintereinanderliegenden - Datenblöcke mittels eines zweidimensionalen Byte-Arrays, dessen 'SafeArray'-Struktur geeignet manipuliert wird, realisiert werden.

Die Sortierung erfolgt nach dem Inhalt einer vorzugebenden UDT-Komponente. Diese Komponente kann einer der folgenden Datentypen sein:

• ein numerischer VB-Datentyp (Byte, Integer, Long, Single, Double, Currency, Variant/Decimal)
• ein String fester oder variabler Länge ( --> Sortieren nach der Sortier-Reihenfolge im Gebietsschema des Benutzers)
• eine Variable des Typs DATE ( --> Sortieren nach Zeitpunkten)
• eine boolsche Variable (--> Sortieren nach 'TRUE', 'FALSE')

Strings werden unter Verwendung von 'vbTextCompare' sortiert. Das kann ggf. im Code der Hilfsroutine 'iHeapsort_Bytes' geändert werden ('vbBinaryCompare' / 2 x auswechseln!).

Die UDT-Komponente, die das Sortierkriterium darstellt, kann auch in einem verschachtelten benutzerdefinierten Datentyp enthalten sein oder als Feldelement in einem statisch deklarierten Array. Nach Variant-Komponenten, den Eigenschaften enthaltener Objekt-Instanzen, nach Elementen von enthaltenen Collections oder von dynamisch deklarierten Arrays kann 'HeapSort_UDT' nicht sortieren!

Das Sortieren des UDT-Arrays anhand einer Komponente des Datentyps 'String fester Länge' stellt einen Sonderfall dar. Die VB-Funktion 'VARPTR' liefert bei diesem Datentyp keinen korrekten Zeiger, obwohl die Daten direkt in der UDT-Variable an der erwarteten Stelle angeordnet sind (siehe unten).

Das Sortieren von einfachen eindimensionalen String-Arrays (Strings variabler Länge!) und von eindimensionalen numerischen Arrays ist mit der Routine 'HeapSort_UDT' ebenfalls möglich (zum Funktions-Aufruf: vgl. Demo).

Als Sortieralgorithmus wird 'Heapsort' verwendet.

3. Der Aufruf der Routine 'HeapSort_UDT'

Damit die Sortier-Routine für beliebig definierte UDT-Arrays verwendbar ist, sind ihr als Parameter 'Zeiger' zu übergeben. Aus diesem Grund können auch Arrays sortiert werden, die in einer Klasse oder einem Formular als PRIVATE deklariert sind. Der VB-Geltungsbereich des UDT-Arrays wird von der Routine 'HeapSort_UDT' ignoriert. Obwohl die Routine die übergebenen Zeiger diversen Plausibilitätstests unterzieht, können fehlerhafte Zeiger zu einem Programmabsturz führen. Der Funktionsaufruf muss deshalb besonders sorgfältig programmiert werden und vor dem Test des Programms sollte der erstellte Code gespeichert werden (wg. Verwendung der API-Low-Level-Kopierfunktion 'RtlMoveMemory')!

In den ersten beiden Parametern ist der Zeiger auf das erste bzw. das letzte zu sortierende Element des Arrays zu übergeben - das Sortieren eines Array-Abschnittes ist möglich. Die benötigten Zeiger können über die undokumentierte VB-Funktion 'VarPtr' abgefragt werden.

Der dritte Parameter ('FeldLänge') muss die binäre Länge eines einzelnen UDT-Arrayelementes angeben. Man verwendet die VB-Funktion 'LenB' für das erste zu sortierende Array-Element.

Im vierten Parameter ('pStartFeld_Sortierkomponente') muss der Zeiger auf die Sortierkomponente im ersten zu sortierenden Datenfeld-Element angegeben werden (VarPtr-Funktion). (Beim Sortieren nach einer UDT-Komponente, die als String fester Länge deklariert ist, funktioniert die VarPtr-Funktion nicht. Der 'Byte-Offset' muss deshalb explizit berechnet werden. Steht in der UDT-Deklaration vor der Sortier-String-Komponente z.B. eine Long-Komponente, wendet man die VarPtr-Funktion auf diese Long-Komponente an und addiert 4 Bytes; steht die String-Komponente am Anfang der UDT-Deklaration, wendet man die VarPtr-Funktion auf die gesamte UDT an und verwendet diesen Zeiger. Stehen mehrere Komponenten aus Strings fester Länge hintereinander, muss bei der Berechnung des Offset die interne UNICODE-Darstellung beachtet werden ( = doppelte Bytelänge). Steht die String-Komponente hinter einer 'verzeigerten' UDT-Komponente (Strings variabler Länge, dynamisch deklarierte Arrays, Objekte und Collections) sind nur jeweils 4 Byte ( = 32-Bit-Zeiger) im Offset zu berücksichtigen, bei einer Variant-Komponente sind es 16 Byte.)

Im fünften Parameter ('SortierkomponenteTyp') muss der Datentyp des Sortierkriteriums, das durch den vierten Parameter definiert worden ist, mitgeteilt werden (als 'VbVarType'-Konstante - zulässig: vbBoolean, vbByte, vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbDecimal, vbDate, vbString).

Der optionale sechste Parameter ('StringFix_Länge') wird nur verwendet, falls das Sortierkriterium ein String fester Länge ist. Die Zeichen-Länge des Strings wird angegeben (z.B. String * 30 --> den Wert 30 im Parameter 'StringFix_Länge' angeben). Bei Strings variabler Länge darf dieser Parameter nicht verwendet werden!

Der optionale siebte Parameter ('ansteigend') erlaubt die Umkehrung der Sortier-Reihenfolge ('fallend' wenn der Parameter als 'false' übergeben wird).

Der letzte optionale Parameter ('Meldung') meldet ggf. den Grund für den Abbruch des Sortierens.

Beim Sortieren von Arrays, deren Elemente nicht aus einem UDT bestehen, sondern aus einem numerischen Datentyp oder aus Strings variabler Länge, muss der vierte Parameter durch Verwendung der Hilfsfunktion 'GetSortByteLeng' belegt werden (vgl. Demo).

Warnung: Bei allen Funktions-Argumenten kann eine falsche Belegung die VB-IDE zum Absturz bringen!

4. ActiveX-Tauglichkeit

Die Routine sortiert auch Arrays, deren Elemente aus einer UDT gebildet sind, die als öffentlicher Datentyp in einem öffentlichen Objektmodul (innerhalb einer ActiveX-Komponente) deklariert worden ist. Das Modul 'HeapSort_UDT' kann in ein Klassenmodul umgewandelt und dann auch mittels einer ActiveX-DLL mit VB-Projekten verbunden werden.

5. Demonstrationsbeispiel

Die Routine 'Demo_HeapSort_UDT' sortiert Abschnitte eines Arrays, das aus einem benutzerdefinierten Datentyp besteht, nach verschiedenen Komponenten - in ansteigender oder fallender Reihenfolge. Das Ergebnis der Sortier-Routine wird jeweils in geeigneter Form überprüft (z.B. durch DATEDIFF bzw. STRCOMP).

Es wird auch gezeigt, dass die im Array enthaltenen Collections korrekt mitsortiert werden. Nach den Sortierungen steht in dem geprüften Collection-Item jeweils noch der Wert der zugehörigen 'cur'-Komponente des entsprechenden Feldelements.

Zusätzlich wird ein statisch als PRIVATE modulglobal deklariertes Double-Array sortiert und ein Abschnitt in einem dynamisch lokal deklarierten String-Array, damit die gesamte Bandbreite der Anwendungsmöglichkeiten von 'HeapSort_UDT' deutlich wird.

6. Details zur Überlagerung eines bereits allokierten Speicherbereichs durch ein VB-Array

Wenn man auf den Inhalt eines Bereichs im Hauptspeicher zugreifen möchte, dessen Position, Länge und Struktur man kennt, kann man eine entsprechende UDT-Variable erstellen und durch die API-Funktion 'rtlMoveMemory' den Speicherinhalt einfach in diese Variable kopieren. Dieses Verfahren wird in VB z.B. dann angewendet, wenn eine 'externe' Funktion nur den Zeiger auf einen Datenbereich zurückgibt, dessen Aufbau und Länge beim Funktionsaufruf noch nicht bekannt ist.

Wenn Daten im Speicher aber nicht kopiert, sondern direkt an ihrem Speicherort bearbeitet werden sollen, muss man in VB ein geeignetes Array deklarieren und dessen SafeArray-Struktur derart manipulieren, dass VB beim Zugriff auf Elemente dieses Arrays die eigentlich benötigten Daten 'erwischt'. Zweckmäßig ist eine derartige Vorgehensweise bei großen Datenmengen. Im Prinzip könnte man den Speicherbereich auch komplett in ein geeignet dimensioniertes temporäres Array kopieren, dort manipulieren und das Ergebnis wieder zurückkopieren. Beim 'Overlay' kommt es nicht zur Verdopplung des Speicherbedarfs und man spart ein wenig Rechenzeit, weil das zweimalige Kopieren entfällt.

Bei der Manipulation von Daten durch eine Array-Überlagerung muss man darauf achten, dass nach Abschluss der entsprechenden Funktion die Daten im Speicher wieder so angeordnet sind, dass ihre korrekte Weiterverarbeitung durch VB möglich ist, sonst drohen unabsehbare Konsequenzen.

Angewendet wird das Overlay-Verfahren (das gelegentlich auch als 'Mapping'-Technik bezeichnet wird) in Anwendungsbeispielen meist beim Zugriff auf Bitmap-Daten oder beim Zugriff auf das Zeigerfeld eines dynamisch deklarierten String-Arrays. Beim Entwickeln einer Routine, die ein Array aus einem beliebigen UDT manipulieren soll, muss es benutzt werden, um dieser 'Beliebigkeit' des Aufbaus eines UDT entsprechen zu können.

Details zur SafeArray-Sruktur können im Extratipp 7/2005 Informationen zu Datenfeldern: die SafeArray-Struktur nachgelesen werden.

Schritte beim Overlay:

1. Man benötigt mindestens die Startadresse und die Byte-Länge der Daten, die überlagert werden sollen. Im Einzelfall sind zusätzliche Informationen sinnvoll, um das Überlagerungsarray für den Zugriff geeignet deklarieren zu können; z.B. bei Arrays: die Länge eines einzelnen Array-Elements.
    
2. Man muss entscheiden, welcher Datentyp des Überlagerungs-Arrays für den Zugriff am besten geeignet ist. (Bei UDTs ist das ein zweidimensionales Bytearray, dessen erste Dimension der Länge einer UDT-Komponente entspricht. In diesem Fall entspricht nämlich der zweite Index des Bytearrays dem Index des UDT-Array. Byte-Arrays ermöglichen 'bytegenaue' Deklaration des Overlay und 'bytegenauen' Zugriff auf die Daten.)
    
3. Es genügt, wenn das Overlay-Array bei der Deklaration in jeder Dimension nur ein Element umfasst. Für dieses Array wird im Grunde überhaupt kein Speicher benötigt, aber eine explizite Deklaration ist trotzdem notwendig, damit VB die SafeArray-Struktur erstellt (Die Anweisung 'DIM a() as Byte' erzeugt noch keine SafeArray-Daten).
    
4. Es wird empfohlen, die SafeArray-Struktur des Overlay-Arrays komplett zu lesen und zu speichern (vgl. Quellcode). Sobald das Overlay nicht mehr benötigt wird, müssen diese Originaldaten zurückkopiert werden. Auf VB-Seiten findet man gelegentlich Beispiele, wo direkt an der SafeArray-Struktur manipuliert wird. Nach meiner Erfahrung kann das zu unangenehmen Folgeproblemen - zumindest beim Debuggen - führen.
    
5. Hergestellt wird das Overlay, indem man die Startadresse der zu überlagernden Daten auf den Datenzeiger der SafeArray-Struktur zuweist und die Dimensionsangabe(n) im SafeArray auf die benötigte Byte-Größe setzt. Diese manipulierte Struktur wird dann an die Stelle der ursprünglichen SafeArray-Daten kopiert.
    
6. Während das Overlay besteht, darf man in der VB-IDE das Programm nicht beenden. Es muss stets zuvor die Anweisung ausgeführt werden, durch die die Original-SafeArray-Struktur des Überlagerungs-Arrays wieder zurückkopiert wird. Die VB-IDE kann den Original-Speicherbereich des Überlagerungsarrays sonst nicht freigeben, und will statt dessen das überlagerte Array zweimal freigeben. Diese Kollision führt normalerweise zum Absturz.

Durch ein Overlay kann man die Position von Daten vertauschen und deren Inhalt verändern. Das Löschen oder Hinzufügen von Daten ist nicht möglich, weil dadurch die VB-Variablenverwaltung beschädigt wird. Man muss auch darauf achten, dass die manipulierten Daten noch mit den Datentypen kompatibel sind, die VB an den entsprechendenSpeicherstellen erwartet.

In Sortier-Funktionen werden oft DoEvents-Anweisungen eingesetzt, um das Programm nicht durch das Sortieren für einige Sekunden zu blockieren. Während ein Overlay besteht, sollte man damit vorsichtig sein. Falls nämlich während der Freigabe eine Ereignis-Behandlungsroutine ausgeführt wird, die die überlagerten Daten manipuliert, kann es zu unabsehbaren Problemen kommen. Die Ursachen für derart bedingte Fehler oder Abstürze sind schwer zu finden.

Das Modul "modHeapSort_UDT"

Erstellen Sie ein neues Projekt und fügen nachfolgenden Code in ein Modul ein.

' ==================================================================
' Start Quellcode 'modHeapSort_UDT'
' ==================================================================
' Sortieren eines UDT-Arrays (eindimensional): Heapsort-Algorithmus
' Der Sortierschlüssel steht in einer UDT-Komponente
' Technik: Überlagerung des UDT-Arrays durch ein
' zweidmensionales Byte-Array
' Version 2.2  (7/2005)
Option Explicit
 
' Kopierfunktion für eine Anzahl von Bytes
Private Declare Sub CopyMemory Lib "kernel32" _
  Alias "RtlMoveMemory" ( _
  Dest As Any, _
  Source As Any, _
  ByVal Bytes As Long)
 
' indirekter Varptr-Funktionsaufruf (für Arrays)
Public Declare Function VarPtrArray Lib "msvbvm60.dll" _
  Alias "VarPtr" ( _
  ptr() As Any) As Long
 
' UDT zur Aufnahme der SafeArray-Struktur
' eines zweidimensionalen Arrays
Private Type udtSafeArrayD2
  Dimensionen As Integer          ' Zahl der Dimensionen
  Features As Integer             ' Array-Attribute (als Bitfolge)
  Bytes_Pro_Feld As Long          ' Anzahl der Bytes pro Array-Feld
  Locks As Long                   ' Anzahl der gesetzten Array-Sperren
  Data_Pointer As Long            ' bei Strings: Varptr --> Deskriptor
                                  ' (Adresse des Desk. des ersten Strings)
  Elemente2 As Long               ' Elemente im Array ( = Anzahl Felder)
  Untergrenze2 As Long            ' Deklarations-Untergrenze Dim2
  Elemente1 As Long               ' Elemente im Array ( = Anzahl Felder)
  Untergrenze1 As Long            ' Deklarations-Untergrenze Dim1
End Type
 
Const cMaxStringLen As Long = 255  ' maximale Länge Sortierstring

Public Function HeapSort_UDT(ByVal pStartFeld As Long, _
  ByVal pEndeFeld As Long, _
  ByVal FeldLänge As Long, _
  ByVal pStartFeld_SortierKomponente As Long, _
  ByVal SortierKomponenteTyp As VbVarType, _
  Optional ByVal StringFix_Länge As Integer = -1, _
  Optional ByVal Ansteigend As Boolean = True, _
  Optional ByRef Meldung As String) As Boolean
 
  ' Kopieren eines UDT-Array (eindimensional)
  ' Heapsort-Algorithmus / ansteigend sortieren
  ' der Sortierschlüssel steht in einer UDT-Komponente
 
  ' Technik: Überlagerung des UDT-Array durch ein
  ' zweidmensionales Byte-Array
 
  Dim Anzahl_UDT As Long            ' Zahl der zu sortierenden Arrayfelder
  Dim SortBytes As Long             ' ByteLänge des SortierKey-Elements
  Dim OffsetBytes As Long           ' Offset des SortierKey-Elements
 
  Dim key_dec As Variant            ' Typ-Schablone f. Sortierschlüssel
  Dim i As Long, k As Long          ' Loop
 
  Dim SortKey() As Variant          ' Vektor für Sortierschlüssel
  Dim OverLay_Bytes() As Byte       ' Überlagerung des UDT-Array
  Dim Pointer_To_SafeArray As Long  ' Zeiger auf ArrayInfo-Block
  Dim SafeArray As udtSafeArrayD2   ' ArrayInfo-Block (2 Dimensionen)
  Dim s2 As udtSafeArrayD2
 
  Dim ret As Long                   ' Für den Zugriff auf
  Dim ptr As Long                   ' String-Schlüssel
  Dim StringFix As String
 
  On Error GoTo exitfunction
  Err.Clear
 
  Meldung = "Ungeeignete Eingabeparameter"
  If FeldLänge < 3 Then Exit Function
  If pEndeFeld < pStartFeld Then Exit Function
 
  ' Länge des Schlüsselstrings in Abh. vom Datentyp besorgen
  SortBytes = GetSortByteLeng(SortierKomponenteTyp, key_dec)
  If SortBytes < 1 Then Exit Function
 
  If SortierKomponenteTyp = vbString And StringFix_Länge > 0 Then
    If StringFix_Länge > cMaxStringLen Then Exit Function
  End If
 
  ' relative Position der Sortierkomponente in UDT
  OffsetBytes = pStartFeld_SortierKomponente - pStartFeld
  If OffsetBytes < 0 Or OffsetBytes + SortBytes > FeldLänge Then Exit Function
 
  If pEndeFeld = pStartFeld Then
    ' nur ein Element: nichts zu tun
    Meldung = ""
    HeapSort_UDT = True: Exit Function
  End If
 
  ' Zahl der zu sortierenden Elemente im UDT-Array
  Anzahl_UDT = Sort_Number(pStartFeld, pEndeFeld, FeldLänge)
  If Anzahl_UDT < 2 Then Exit Function
 
  ' geeignete Dummy-Deklaration des Bytearray, das für
  ' die spätere Überlagerung des UDT-Array verwendet wird
  ReDim OverLay_Bytes(1 To FeldLänge, 1 To 1)
 
  ' SafeArray des Overlay-Array besorgen
  ' zunächst Zeiger ....
  Call CopyMemory(Pointer_To_SafeArray, ByVal VarPtrArray(OverLay_Bytes()), 4&)
 
  ' ... dann SafeArray-Struktur
  Call CopyMemory(SafeArray, ByVal Pointer_To_SafeArray, Len(SafeArray))
 
  ' SafeArray auf 's2' zuweisen und
  ' 's2' für den Overlay manipulieren
  s2 = SafeArray
  s2.Elemente2 = Anzahl_UDT
  s2.Data_Pointer = pStartFeld
 
  ' manipuliertes SafeArray kopieren:
  ' Overlay wird hergestellt!
  Call CopyMemory(ByVal Pointer_To_SafeArray, s2, Len(s2))
 
  ' --------------------------------------------------------------
  ' ab hier bis zum Routinenende in der IDE das Programm
  ' nicht abschiessen, sonst wahrscheinlich Absturz! (wg. Overlay)
  ' --------------------------------------------------------------
 
  ' Vektor für Sortierschlüssel dimensionieren
  ReDim SortKey(1 To Anzahl_UDT) As Variant
 
  If StringFix_Länge > 0 Then
    ' geeigneten Leerstring für String fester Länge erzeugen
    StringFix = String(StringFix_Länge, " ")
  End If
 
  ' Variant-DatenVektor 'SortKey' mit den Sortierschlüsseln füllen
  ' (abhängig vom Datentyp des Sortierkriteriums)
  For i = 1 To Anzahl_UDT
    SortKey(i) = key_dec
    If SortierKomponenteTyp <> vbString Then
      If SortierKomponenteTyp <> vbDecimal Then
        ' numerischer Typ der Sortierkomponente
        ' incl. Date, Boolean, Byte
        ' Wert der Sortier-Variable in Sortkey-Array (Variant)
        ' durch API-Funktion kopieren
        Call CopyMemory(ByVal VarPtr(SortKey(i)) + 8, _
          OverLay_Bytes(OffsetBytes + 1, i), SortBytes)
      Else
        ' Sortierkomponente vom Typ Decimal
        Call CopyMemory(ByVal VarPtr(SortKey(i)), _
          OverLay_Bytes(OffsetBytes + 1, i), SortBytes + 4)
      End If
    Else
      If StringFix_Länge < 1 Then
        ' Typ der Sortierkomponente: String variabler Länge
        ' Zeiger auf den Sortierschlüssel-String besorgen
        Call CopyMemory(ptr, OverLay_Bytes(OffsetBytes + 1, i), 4&)
        ' String am Zeiger aus UDT auslesen
        SortKey(i) = GetStringFromPointer(ptr)
      Else
        ' Typ der Sortierkomponente: String fester Länge
        ' (Achtung: VARPTR-Funktion kann in diesem Fall nicht direkt
        ' beim Funktionsaufruf verwendet werden!)
        ' ASCII-Codes direkt byteweise auslesen aus UNICODE-Zeichenfolge
        ' und per CHR$-Funktion wandeln
        For k = 1 To StringFix_Länge
          Mid$(StringFix, k, 1) = _
            Chr$(OverLay_Bytes(OffsetBytes + 1 + ((k - 1) * 2), i))
        Next k
        ' String in Sortier-Vektor eintragen
        SortKey(i) = StringFix
      End If
    End If
  Next i
 
  Meldung = "Interner Fehler beim Sortieren"
 
  ' UDT-Array-Sortieren: HeapSort-Algorithmus
  ' (SortKey-Array wird separat übergeben und mitsortiert)
  HeapSort_UDT = HeapSort_Bytes(OverLay_Bytes(), SortKey())
 
  ' Falls fallend sortiert werden soll ...
  ' Reihenfolge der Array-Elemente umkehren
  If HeapSort_UDT And Not Ansteigend Then
    HeapSort_UDT = InverseOrder(pStartFeld, pEndeFeld, FeldLänge)
  End If
 
  If HeapSort_UDT Then Meldung = ""
 
exitfunction:
 
  ' Das Overlay-ByteArray wieder freigeben
  ' (Das Original-SafeArray muss zuvor unbedingt zurückkopiert
  ' werden, sonst treten unabsehbare Folgeprobleme auf!)
  Call CopyMemory(ByVal Pointer_To_SafeArray, SafeArray, Len(SafeArray))
 
  If Err.Number <> 0 Then
    Meldung = Err.Description
  End If
End Function

Private Function Sort_Number(ByVal pStartFeld As Long, _
  ByVal pEndeFeld As Long, _
  ByVal FeldLänge As Long) As Long
 
  ' Zahl der zu sortierenden Array-Elemente aus den
  ' Zeigern und der Längen-Angabe ermitteln
 
  Dim ToTal_Bytes As Long, Anzahl_UDT As Long
 
  Sort_Number = -1
  If pStartFeld < 1 Or FeldLänge < 1 Then Exit Function
 
  ' Anzahl Bytes im letzten zu sortierenden Element addieren!
  ToTal_Bytes = pEndeFeld - pStartFeld + FeldLänge
  If ToTal_Bytes < 3 Then Exit Function
 
  Anzahl_UDT = ToTal_Bytes \ FeldLänge
  ' angegebener Speicherbereich auf Elementzahl exakt aufteilbar?
  If Anzahl_UDT * FeldLänge <> ToTal_Bytes Then Exit Function
  ' Rückgabe
  Sort_Number = Anzahl_UDT
End Function

Private Function HeapSort_Bytes(ByRef Bytes() As Byte, _
  ByRef SortKey() As Variant) As Boolean
 
  ' Heapsort-Algorithmus zum Sortieren eines UDT-Arrays
  ' Daten werden ansteigend sortiert
 
  ' UDT-Array als zweidimensionales Array in bytes()!
  ' Sortierschlüssel steht in sortkey()
 
  Dim v() As Byte           ' Swappen von UDT als Bytefolge
  Dim t As Variant          ' Swappen des Sortierschlüssels
  Dim i As Long             ' Loop
  Dim anz As Long           ' zu sortierende Elemente
  Dim udtlen As Long        ' Byte-Länge einer UDT
 
  On Error GoTo fehler
  ' Eingabeparameter prüfen
  If LBound(Bytes, 1) <> 1 Or LBound(Bytes, 2) <> 1 Then
    Exit Function
  End If
  If LBound(SortKey) <> 1 Or UBound(SortKey) <> UBound(Bytes, 2) Then
    Exit Function
  End If
 
  ' nur ein Feld?
  anz = UBound(Bytes, 2)
  If anz = 1 Then HeapSort_Bytes = True: Exit Function
 
  udtlen = UBound(Bytes, 1)    ' Byte-Länge eines UDT-Blocks
  ReDim v(1 To udtlen)
  For i = anz \ 2 To 1 Step -1
    If Not iHeapSort_Bytes(i, anz, Bytes(), SortKey()) Then
      Exit Function
    End If
  Next i
 
  Do
    ' Swap: Schlüssel und UDT-Feld Index 1, ANZ
    t = SortKey(1)
    SortKey(1) = SortKey(anz)
    SortKey(anz) = t
    Call CopyMemory(v(1), Bytes(1, 1), udtlen)
    Call CopyMemory(Bytes(1, 1), Bytes(1, anz), udtlen)
    Call CopyMemory(Bytes(1, anz), v(1), udtlen)
 
    anz = anz - 1
    If Not iHeapSort_Bytes(1, anz, Bytes(), SortKey()) Then
      Exit Function
    End If
  Loop Until anz <= 1
 
  HeapSort_Bytes = True
 
fehler:
End Function

Private Function iHeapSort_Bytes(ByVal Start As Long, _
  ByVal Ende As Long, _
  ByRef Bytes() As Byte, _
  ByRef SortKey() As Variant) As Boolean
 
  ' Hilfsfunktion für HeapSort_Bytes
  ' (für Sortieren eines UDT-Arrays)
 
  ' Bytes()   : UDT-Array-Überlagerung
  ' SortKey() : Vektor mit den Sortierschlüsseln
 
  Dim k As Long, j As Long     ' Loop
  Dim udtlen As Long           ' Länge einer UDT im Array
  udtlen = UBound(Bytes, 1)
 
  ' Für den Austausch von UDTs:
  Dim t As Variant, tb() As Byte
  ReDim tb(1 To udtlen)
 
  Dim str As Boolean       ' Ist Sortierschlüssel String?
  Dim jKleiner As Boolean  ' Ergebnis des Vergleichs von 2 Array-Elementen
 
  On Error GoTo fehler
  ' Zuweisung: Schlüssel und UDT-Feldelement
  t = SortKey(Start)
  Call CopyMemory(tb(1), Bytes(1, Start), udtlen)
 
  ' Ist String-Schlüssel zu sortieren oder numerisch?
  str = VarType(SortKey(Start)) = vbString
 
  ' Sortieren
  k = Start
  Do While k <= Ende \ 2
    j = k + k
    If j < Ende Then
      If Not str Then
        ' numerischer Vergleich
        jKleiner = SortKey(j) < SortKey(j + 1)
      Else
        ' String-Vergleich
        jKleiner = (StrComp(SortKey(j), SortKey(j + 1), vbTextCompare) < 0)
      End If
      If jKleiner Then j = j + 1
    End If
 
    If Not str Then
      ' Sortieren nach numerischem Schlüssel (incl. DATE)
      If t >= SortKey(j) Then Exit Do
    Else
      ' Sortieren nach String-Schlüssel
      If StrComp(t, SortKey(j), vbTextCompare) >= 0 Then Exit Do
    End If
 
    ' Zuweisung: Schlüssel und UDT-Feldelement
    SortKey(k) = SortKey(j)
    Call CopyMemory(Bytes(1, k), Bytes(1, j), udtlen)
    k = j
  Loop
 
  ' Zuweisung: Schlüssel und UDT-Feldelement
  SortKey(k) = t
  Call CopyMemory(Bytes(1, k), tb(1), udtlen)
  iHeapSort_Bytes = True
 
fehler:
End Function

Public Function GetSortByteLeng(ByVal SK_Typ As VbVarType, _
  Optional ByRef key_dec As Variant) As Long
 
  ' Byte-Länge eines unterstützten Datentyps
  ' in der Sortierschlüssel-Komponente liefern
  ' und (optional) eine Variant-Variable auf den
  ' Datentyp einstellen
 
  Dim l As Long
 
  l = -1
  If SK_Typ = vbBoolean Then l = 2: key_dec = CBool(0)
  If SK_Typ = vbByte Then l = 1: key_dec = CByte(0)
  If SK_Typ = vbCurrency Then l = 8: key_dec = CCur(0)
  If SK_Typ = vbDate Then l = 8: key_dec = CDate(0)
  If SK_Typ = vbDecimal Then l = 12: key_dec = CDec(0)
  If SK_Typ = vbDouble Then l = 8: key_dec = CDbl(0)
  If SK_Typ = vbInteger Then l = 2: key_dec = CInt(0)
  If SK_Typ = vbLong Then l = 4: key_dec = CLng(0)
  If SK_Typ = vbSingle Then l = 4: key_dec = CSng(0)
  If SK_Typ = vbString Then l = 4: key_dec = CLng(0) 'Zeiger
 
  GetSortByteLeng = l
End Function

Private Function GetStringFromPointer(ByRef Pointer As Long) As String
  ' String variabler Länge an Position 'Pointer' lesen 
 
  Dim strLänge As Long, str As String
 
  ' Auslesen der Stringlänge
  Call CopyMemory(strLänge, ByVal (Pointer - 4), 4&)
  If strLänge < 1 Or strLänge > cMaxStringLen Then Exit Function
  ' Stringbuffer 'str' erstellen
  str = String(strLänge, " ")
  ' String in 'str' kopieren
  Call CopyMemory(ByVal StrPtr(str), ByVal Pointer, strLänge)
  ' Rückgabe
  GetStringFromPointer = str
End Function

Private Function InverseOrder(ByVal pStartFeld As Long, _
  ByVal pEndeFeld As Long, _
  ByVal FeldLänge As Long) As Boolean
 
  ' Die Abfolge der Array-Elemente im sortierten Abschnitt wird
  ' umgekehrt (Sortierrichtung: fallend)
 
  Dim Anzahl_UDT                  ' Zahl der sortierten Array-Elemente
  Dim ptr1 As Long, ptr2 As Long  ' Zeiger auf auszutauschende Elemente
  Dim i As Long                   ' Loop
  Dim TmpBuffer() As Byte         ' Byte-Zwischenspeicher einer UDT
 
  Anzahl_UDT = Sort_Number(pStartFeld, pEndeFeld, FeldLänge)
  If Anzahl_UDT < 2 Then Exit Function
 
  ReDim TmpBuffer(1 To FeldLänge)
  For i = 1 To Anzahl_UDT \ 2
    ' Zeiger auf Elementpaarung
    ptr1 = pStartFeld + (i - 1) * FeldLänge
    ptr2 = pEndeFeld - (i - 1) * FeldLänge
 
    ' start-relatives Array-Element i zwischenspeichern
    Call CopyMemory(TmpBuffer(1), ByVal ptr1, FeldLänge)
 
    ' Abfolge der sortierten Array-Elemente umkehren
    Call CopyMemory(ByVal ptr1, ByVal ptr2, FeldLänge)
    Call CopyMemory(ByVal ptr2, TmpBuffer(1), FeldLänge)
  Next i
 
  InverseOrder = True
End Function
' =================================================================
'  Ende Quellcode Modul HeapSort_UDT
' =================================================================

Das Modul "DEMO_HeapSort_UDT"

Fügen Sie dem Projekt ein neues Modul mit nachfolgendem Code hinzu.

' ===================================================================
' Start Quellcode Modul DEMO_HeapSort_UDT
' ===================================================================
Option Explicit
 
' Deklaration eines benutzerdefinierten Datentyps zum Testen
Private Type SubType_DEMO
  str10 As String * 10     ' String fester Länge
  str20 As String * 20     ' String fester Länge
  farr(1 To 10) As Date    ' Zeitpunkte in statischem Array
End Type
 
Private Type UDT_DEMO
  cur As Currency          ' Currency-Komponente
  str As String            ' String variabler Länge
  st As SubType_DEMO       ' enthaltene UDT
  col As New Collection    ' enthaltene Collection
End Type
 
' modulglobales Array zum Testen
Private dbl(-100 To 100) As Double

Public Function DEMO_HeapSort_UDT() As Boolean
  ' Demonstrationsbeispiel zur Verwendung der
  ' Routine 'HeapSort_UDT'
  ' (Sortieren eines UDT-Arrays nach einer UDT-Komponente)
 
  Dim i As Long              ' Loop
  Dim l As Long              ' zufällige StringLänge
  Dim Meldung As String      ' Rückmeldung bei Problemen
 
  ' dynamisch deklariertes UDT-Array
  Dim demo() As UDT_DEMO
  ' Deklarations-Grenzen des Arrays sind beliebig wählbar
  ReDim demo(-100 To 100)
 
  ' UDT-Array füllen
  For i = LBound(demo) To UBound(demo)
    ' Array-Element i füllen
    With demo(i)
      ' zufälliger Currency-Wert
      .cur = CCur(Rnd * 10000)
      ' zufälliger String variabler Länge
      l = 1 + (Rnd * 20)
      .str = GetRandomString(l)
      ' Element des statischen Arrays
      ' mit Zeitpunkt füllen
      .st.farr(3) = GetRandomDateTime
      ' Strings fester Länge füllen 
      .st.str10 = GetRandomString(10)
      .st.str20 = GetRandomString(20)
      ' ein Collection-Item zuweisen
      ' für späteren Test
      .col.Add CStr(.cur)
     End With
  Next i
 
  ' Die ersten 50 Array-Elemente ansteigend nach der
  ' Currency-Komponente 'cur' sortieren
  If Not HeapSort_UDT(VarPtr(demo(LBound(demo))), _
    VarPtr(demo(LBound(demo) + 49)), _
    LenB(demo(LBound(demo))), _
    VarPtr(demo(LBound(demo)).cur), _
    vbCurrency, , , Meldung) Then
 
    MsgBox "Sortieren CURRENCY scheitert" + vbCrLf + Meldung, vbExclamation
    Exit Function
  End If
 
  ' steigende Sortierung überprüfen (Komponente 'cur')
  For i = LBound(demo) To LBound(demo) + 48
    If demo(i).cur > demo(i + 1).cur Then
      MsgBox "Sortieren CURRENCY fehlerhaft", vbExclamation
      Exit Function
    End If
  Next i
 
  ' 50 Array-Elemente ab dem (relativ) 51. Element fallend
  ' sortieren nach den variablen Strings in Komponente 'str'
  If Not HeapSort_UDT(VarPtr(demo(LBound(demo) + 50)), _
    VarPtr(demo(LBound(demo) + 99)), _
    LenB(demo(LBound(demo) + 50)), _
    VarPtr(demo(LBound(demo) + 50).str), _
    vbString, , False, Meldung) Then
 
    MsgBox "Sortieren STRING scheitert" + vbCrLf + Meldung, vbExclamation
    Exit Function
  End If
 
  ' fallende Sortierung überprüfen (Komponente 'str')
  For i = LBound(demo) + 50 To LBound(demo) + 98
    If StrComp(demo(i).str, demo(i + 1).str, vbTextCompare) < 0 Then
      MsgBox "Sortieren STRING fehlerhaft", vbExclamation
      Exit Function
    End If
  Next i
 
  ' 50 Array-Elemente ab dem (relativ) 101. Element nach
  ' String fester Länge 'str20' in Subtyp 'st' sortieren
  ' Im 4. Parameter muss Offset addiert werden:
  ' 8 Byte für Komponente 'Cur' CURRENCY
  ' 4 Byte für Zeiger auf variablen String 'Str'
  ' 20 Byte für String der Länge 10 'str10'
  ' ergibt Summe ---> 32 Byte
  If Not HeapSort_UDT(VarPtr(demo(LBound(demo) + 100)), _
    VarPtr(demo(LBound(demo) + 149)), _
    LenB(demo(LBound(demo) + 100)), _
    VarPtr(demo(LBound(demo) + 100)) + 32, _
    vbString, 20, False, Meldung) Then
 
    MsgBox "Sortieren STRING_FIX scheitert" + vbCrLf + Meldung, vbExclamation
    Exit Function
  End If
 
  ' Sortierung (fallend) überprüfen (Komponente 'st.str20') 
  For i = LBound(demo) + 100 To LBound(demo) + 148
    If StrComp(demo(i).st.str20, demo(i + 1).st.str20, vbTextCompare) < 0 Then
      MsgBox "Sortieren STRING_FIX fehlerhaft", vbExclamation
      Exit Function
    End If
  Next i
 
  ' 50 Array-Elemente ab dem 151. Element
  ' ansteigend nach den Zeitpunkten im statischen Array
  ' im Untertyp 'st' Komponente 'farr(3)' sortieren
  If Not HeapSort_UDT(VarPtr(demo(LBound(demo) + 150)), _
    VarPtr(demo(LBound(demo) + 199)), _
    LenB(demo(LBound(demo) + 150)), _
    VarPtr(demo(LBound(demo) + 150).st.farr(3)), _
    vbDate, , , Meldung) Then
 
    MsgBox "Sortieren ZEITPUNKTE im ARRAY scheitert" + vbCrLf + Meldung, vbExclamation
    Exit Function
  End If
 
  ' Sortierung (ansteigend) überprüfen (Komponente 'st.farr(3)')
  For i = LBound(demo) + 150 To LBound(demo) + 198
    If DateDiff("s", demo(i).st.farr(3), demo(i + 1).st.farr(3)) < 0 Then
      MsgBox "Sortieren ZEITPUNKTE fehlerhaft", vbExclamation
      Exit Function
    End If
  Next i
 
  ' Ist der Verweis auf die Collections der Komponente  'col'
  ' immer korrekt mitsortiert worden?
  For i = LBound(demo) To UBound(demo)
    If demo(i).cur <> CCur(demo(i).col(1)) Then
      MsgBox "COLLECTION nicht korrekt verknüpft", vbExclamation
      Exit Function
    End If
  Next i
 
  ' =======================================================
  ' Beispiele für Arrays aus integrierten VB-Datentypen
  ' =======================================================
 
  ' Sortieren eines statischen modulglobalen Double-Arrays
  ' Double-Array mit Zufallszahlen füllen
  For i = LBound(dbl) To UBound(dbl)
    dbl(i) = CDbl(Rnd)
  Next i
  ' Array sortieren (fallend)
  If Not HeapSort_UDT(VarPtr(dbl(LBound(dbl))), _
    VarPtr(dbl(UBound(dbl))), _
    GetSortByteLeng(vbDouble), _
    VarPtr(dbl(LBound(dbl))), _
    vbDouble, , False, Meldung) Then
 
    MsgBox "Sortieren DOUBLE-ARRAY scheitert", vbExclamation: Exit Function
  End If
 
  ' Sortierung (fallend) überprüfen (Double-Array 'dbl')
  For i = LBound(dbl) To UBound(dbl) - 1
    If dbl(i) < dbl(i + 1) Then
      MsgBox "Sortieren DOUBLE-ARRAY fehlerhaft", vbExclamation: Exit Function
    End If
  Next i
 
  ' Sortieren eines lokalen dynamischen String-Arrays
  ' (funktioniert nicht bei Strings fester Länge !!)
  Dim str(-100 To 100) As String
  ' Stringarray füllen
  For i = LBound(str) To UBound(str)
    l = 1 + Rnd * 30 'zufällige Stringlänge
    str(i) = GetRandomString(l)
  Next i
 
  ' Sortieren (ansteigend) im Index-Abschnitt -50 bis +50
  If Not HeapSort_UDT(VarPtr(str(-50)), _
    VarPtr(str(50)), _
    GetSortByteLeng(vbString), _
    VarPtr(str(-50)), _
    vbString, , , Meldung) Then
 
    MsgBox "Sortieren STRING-ARRAY scheitert", vbExclamation
    Exit Function
  End If
 
  ' Sortierung (steigend) überprüfen (String-Array: 'str')
  For i = -50 To 49
    If StrComp(str(i), str(i + 1), vbTextCompare) > 0 Then
      MsgBox "Sortieren STRING-ARRAY fehlerhaft", vbExclamation
      Exit Function
    End If
  Next i
 
  ' Das war's ...
  MsgBox "Demo Heapsort_UDT abgeschlossen", vbInformation
 
  DEMO_HeapSort_UDT = True
End Function

Public Function GetRandomString(ByVal Länge As Long) As String
  ' Zufalls-String der 'Länge' als Buchstabenfolge
  Dim i As Long, str As String
 
  If Länge < 1 Then Exit Function
 
  str = String(Länge, " ")
  For i = 1 To Länge
    Mid$(str, i, 1) = Chr$(Rnd * 25 + 65)
  Next i
  GetRandomString = str
End Function

Public Function GetRandomDateTime() As Date
  ' Zufallszeitpunkt 2001 - 2006
 
  Dim st As Double, en As Double
 
  st = CDbl(CDate("1.1.2001 00:00:00"))
  en = CDbl(CDate("1.1.2006 00:00:00"))
 
  GetRandomDateTime = CDate(st + Rnd * (en - st))
End Function
' =================================================================
' Ende Quellcode DEMO_Heapsort_UDT
' =================================================================