vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Zippen wie die Profis!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik: Variablen/Strings · Array/ArrayList   |   VB-Versionen: VB200819.11.09
Listige Array-Erweiterung

Erweiterungsmethoden für eindimensionale "System.Arrays", die Operationen für einen Bereich von Indizes ermöglichen (InsertRange, MoveRange, ReplaceRange u.a.)

Autor:   Manfred BohnBewertung:     [ Jetzt bewerten ]Views:  11.581 
ohne HomepageSystem:  Win2k, WinXP, Win7, Win8, Win10, Win11kein Beispielprojekt 

Mit der generischen Collection List(of T) steht eine Klasse zur Verfügung, die auch bei langen Listen sehr effizient Ein-, Anfüge- und Löschoperationen von Elementen in einem Indexbereich ermöglicht.

Auch bei System.Arrays sind die Schnittstellen "List(Of T)" und "Collection(Of T)" implementiert. Die entsprechenden Methoden aber nicht zur Verfügung. Das liegt vermutlich daran, dass Arrays die RANK-Eigenschaft besitzen, so dass ein mehrdimensionaler Zugriff auf die Elemente vereinbart werden kann.

System.Arrays verfügen statt dessen über die SHARED-Methoden "Copy" und "Resize". Aus denen lassen sich mit wenigen Codezeilen Listenoperationen für eindimensional deklarierte Arrays erstellen. Solche Routinen arbeiten allerdings weniger effizient, wie die einer "richtigen" Liste.

Das Modul 'modArrayAsList' enthält einige Erweiterungs-Vorschläge für eindimensionale Arrays, deren Elemente von einem Werttyp sind (Constraint: Structure).

Die 'Sub'-Erweiterungen deklarieren den ersten Parameter "ByRef". Sie verändern beim Einfügen, Anhängen oder Löschen von Element-Bereichen den Inhalt der Array-Instanz, für die sie aufgerufen worden sind (InsertRange, AddRange, RemoveRange). Das Ergebnis entspricht jeweils den gleichnamigen Methoden der generischen List-Klasse. Zusätzlich sind die Erweiterungen "MoveRange" und "ReplaceRange" enthalten, für die es in List(Of T) keine direkte Entsprechung gibt.

Bei ungeeigneten Parametern wird stets die Ausnahme "InvalidOperationException" ausgelöst (z.B. falls das Array nicht dimensioniert worden ist).

Ergänzende Hinweise (mehrdimensionale Arrays):
Informationen zur Verwendung von "Array.Copy" bei mehrdimensionalen Arrays enthält der Tipp "Array.Copy bei mehrdimensionalen Arrays".

Eine Klasse für ein- und mehrdimensionale Arrays, deren Indizierung nicht bei 0 beginnt, enthält der Tipp "Klasse für nicht-nullbasierte Arrays".

Wie man beim Zugriff auf mehrdimensionale Arrays die Schleifen organisiert, darüber informiert "Mehrdimensionale Arrays: Effiziente Schleifen".

Beispiele:
Die Demo-Routine "ArrayListDemo" zeigt die äquivalente Wirkung der vorgeschlagenen Array-Erweiterungen und der "List"-Methoden.

Private Sub ArrayListDemo()
 
  ' Zufallszahlen-Generator einrichten
  Dim rndm As New System.Random(1234)
 
  Dim steps As Integer = 100 ' Länge der Aktionsschleife
  Dim Use_MoveRange As Boolean = False ' MoveRange verwenden?
  Dim al As Integer = 1000 ' Array-/Listenlänge
  Dim dec_arr(al - 1) As Decimal ' Array (eindimensional, Werttyp)
 
  ' Array mit Zufallszahlen fühlen
  For i As Integer = 0 To dec_arr.Length - 1
    dec_arr(i) = CDec(rndm.NextDouble * 100)
  Next i
 
  ' Liste, gleich gefüllt mit dem Inhalt des Array
  Dim dec_lst As New System.Collections.Generic.List(Of Decimal)(dec_arr)
 
  Dim rng_arr() As Decimal ' Array für Element-Range
  Dim rng_lst As _
  System.Collections.Generic.List(Of Decimal) ' Liste für Element-Range
 
  ' Verschiebe-Aktionen durchführen
  Dim srcpos As Integer ' Startindex Verschiebe-Bereich
  Dim rangelength As Integer ' Länge zu verschiebender Teilbereich 
  Dim destpos As Integer ' StartIndex: Ziel d. Verschiebung
 
  For i As Integer = 0 To steps - 1
 
    ' ======================================
    ' Verschieben von Elementen
    ' ======================================
 
    ' zufällige Länge des Teilbereichs
    rangelength = rndm.Next(1, al + 1)
    ' zufällige StartPosition Teilbereich
    srcpos = rndm.Next(0, al - rangelength + 1)
    ' zufällige Zielposition Teilbereich
    destpos = rndm.Next(0, al - rangelength + 1)
 
    If Not Use_MoveRange Then
      ' Elemente auslesen
      rng_arr = dec_arr.GetRange(srcpos, rangelength)
      ' ausgelesene Elemente entfernen
      dec_arr.RemoveRange(srcpos, rangelength)
      ' Elemente an Zielposition wieder einfügen
      dec_arr.InsertRange(destpos, rng_arr)
    Else
      ' Alternative: Verschiebung durch MoveRange 
      ' (Arraylänge fixiert!)
      dec_arr.MoveRange(srcpos, destpos, rangelength)
    End If
 
    ' Entsprechende Operationen mit der Liste durchführen
    rng_lst = dec_lst.GetRange(srcpos, rangelength)
    dec_lst.RemoveRange(srcpos, rangelength)
    dec_lst.InsertRange(destpos, rng_lst)
 
    ' Das Ergebnis sollte stets gleich sein
    If dec_lst.Count <> dec_arr.Length Then Stop ' ???
    For ind As Integer = 0 To dec_lst.Count - 1
      If Not dec_lst(ind).ToString = dec_arr(ind).ToString Then
        Stop ' sollte nicht passieren !!
      End If
    Next ind
 
    ' =======================================================
    ' Anhängen von Elementen
    ' =======================================================
    ' zufällige Länge des Teilbereichs
    rangelength = rndm.Next(1, al + 1)
    ' zufällige StartPosition Teilbereich
    srcpos = rndm.Next(0, al - rangelength + 1)
 
    ' Bereich auslesen und an Array anhängen
    rng_arr = dec_arr.GetRange(srcpos, rangelength)
    dec_arr.AddRange(rng_arr)
    ' Bereich auslesen und an Liste anhängen
    rng_lst = dec_lst.GetRange(srcpos, rangelength)
    dec_lst.AddRange(rng_lst)
 
    ' Das Ergebnis sollte stets gleich sein
    If dec_lst.Count <> dec_arr.Length Then Stop ' ???
    For ind As Integer = 0 To dec_lst.Count - 1
      If Not dec_lst(ind).ToString = dec_arr(ind).ToString Then
        Stop ' sollte nicht passieren !!
      End If
    Next ind
 
    ' Ausgangslänge wieder herstellen
    dec_arr.RemoveRange(al, rng_arr.Length)
    dec_lst.RemoveRange(al, rng_lst.Count)
 
    ' =============================================
    ' Ersetzen von Elementen (Array-Länge fixiert!)
    ' =============================================
    ' zufällige StartPosition für den Teilbereich
    srcpos = rndm.Next(0, al - rng_arr.Length + 1)
 
    ' Elemente im Teilbereich des Array ersetzen
    dec_arr.ReplaceRange(srcpos, rng_arr)
 
    ' entsprechend in der Liste (Remove Old -> Insert New)
    dec_lst.RemoveRange(srcpos, rng_lst.Count)
    dec_lst.InsertRange(srcpos, rng_lst)
 
    ' Das Ergebnis sollte stets gleich sein
    If dec_lst.Count <> dec_arr.Length Then Stop ' ???
    For ind As Integer = 0 To dec_lst.Count - 1
      If Not dec_lst(ind).ToString = dec_arr(ind).ToString Then
        Stop ' sollte nicht passieren !!
      End If
    Next ind
 
    ' nächste Aktionen
  Next i
 
  MsgBox("ArrayListDemo beendet")
End Sub

Und hier das Modul "modArrayList", das die Erweiterungen enthält:

Option Strict On
Option Explicit On
Option Infer Off
 
Imports System
Imports System.Runtime.CompilerServices
 
''' <summary>Erweiterungsmethoden für List-Operationen bei 
''' eindimensionalen Arrays, deren Elemente Werttypen sind </summary>
Module modArrayAsList
#Region "InsertRange, AddRange"
 
  ''' <summary>Einfügen eines Array</summary>
  ''' <typeparam name="Entrytype">Datentyp der Array-Elemente</typeparam>
  ''' <param name="arr">Array, in das Elemente eingefügt werden</param>
  ''' <param name="InsertPosition">Startposition des Einfügens im Quellarray</param>
  ''' <param name="ArrToInsert">einzufügendes Array</param>
  ''' <param name="StartPosition">Startposition im einzufügenden Array</param>
  ''' <param name="Length">Anzahl der einzufügenden Elemente</param>
  <Extension()> _
  Public Sub InsertRange(Of Entrytype As Structure) (ByRef arr() As Entrytype, _
    ByVal InsertPosition As Integer, _
    ByVal ArrToInsert() As Entrytype, _
    ByVal StartPosition As Integer, _
    ByVal Length As Integer)
 
    ' Parameter checken
    CheckRange(arr, InsertPosition, Length, False)
    CheckRange(ArrToInsert, StartPosition, Length)
 
    ' Bisherige Array-Länge speichern
    Dim l As Integer = arr.Length
 
    ' Array verlängern
    Array.Resize(arr, arr.Length + Length)
 
    ' Array-Elemente ab Einfügeposition nach hinten schieben
    Array.Copy(arr, InsertPosition, arr, _
      InsertPosition + Length, l - InsertPosition)
 
    ' Ausgewählte Elemente aus 'ArrToInsert' an der 'InsertPosition' 
    ' ìn 'Arr' einfügen
    Array.Copy(ArrToInsert, StartPosition, arr, InsertPosition, Length)
  End Sub
 
  ''' <summary>Einfügen eines Array</summary>
  ''' <typeparam name="Entrytype">Datentyp der Array-Elemente</typeparam>
  ''' <param name="arr">Array, in das Elemente eingefügt werden</param>
  ''' <param name="InsertPosition">Startposition des Einfügens im Quellarray</param>
  ''' <param name="ArrToInsert">einzufügendes Array</param>
  <Extension()> _
  Public Sub InsertRange(Of Entrytype As Structure)(ByRef arr() As Entrytype, _
    ByVal InsertPosition As Integer, _
    ByVal ArrToInsert() As Entrytype)
 
    If ArrToInsert Is Nothing Then Throw New InvalidOperationException
    InsertRange(arr, InsertPosition, ArrToInsert, 0, ArrToInsert.Length)
  End Sub
 
  ''' <summary>Einfügen eines Wertes in ein Array</summary>
  ''' <typeparam name="Entrytype">Typ der Array-Elemente</typeparam>
  ''' <param name="arr">Array, in das Elemente eingefügt werden</param>
  ''' <param name="ValToInsert">Der einzufügende Wert</param>
  ''' <param name="InsertPosition">Die Einfügeposition (0 -- arr.Length)</param>
  <Extension()> _
  Public Sub InsertRange(Of Entrytype As Structure)(ByRef arr() As Entrytype, _
    ByVal InsertPosition As Integer, ByVal ValToInsert As Entrytype)
 
    Dim iarr() As Entrytype = {ValToInsert}
    InsertRange(arr, InsertPosition, iarr, 0, 1)
  End Sub
 
  ''' <summary>Ein Element am Array anhängen</summary>
  ''' <typeparam name="EntryType">Datentyp der Array-Elemente</typeparam>
  ''' <param name="arr">Array, an das Elemente angehängt werden</param>
  ''' <param name="ValToAdd">Wert des anzuhängenden Elements</param>
  <Extension()> _
  Public Sub AddRange(Of EntryType As Structure)(ByRef arr() As EntryType, _
    ByVal ValToAdd As EntryType)
 
    If arr Is Nothing Then Throw New InvalidOperationException
    Dim iarr() As EntryType = {ValToAdd}
    InsertRange(arr, arr.Length, iarr, 0, 1)
  End Sub
 
  ''' <summary>Einen Arraybereich an ein Array anhängen</summary>
  ''' <typeparam name="EntryType">Datentyp der Array-Elemente</typeparam>
  ''' <param name="arr">Array, an das Elemente angehängt werden</param>
  ''' <param name="ArrToAdd">Array, dessen Elemente angehängt werden sollen</param>
  ''' <param name="StartPosition">Erstes anzuhängendes Element</param>
  ''' <param name="Length">Anzahl der anzuhängenden Element</param>
  <Extension()> _
  Public Sub AddRange(Of EntryType As Structure)(ByRef arr() As EntryType, _
    ByVal ArrToAdd() As EntryType, _
    ByVal StartPosition As Integer, ByVal Length As Integer)
 
    If arr Is Nothing Then Throw New InvalidOperationException
    InsertRange(arr, arr.Length, ArrToAdd, StartPosition, Length)
  End Sub
 
  ''' <summary>Ein Array an ein Array anhängen</summary>
  ''' <typeparam name="EntryType">Datentyp der Array-Elemente</typeparam>
  ''' <param name="arr">Array, an das Elemente angehängt werden</param>
  ''' <param name="ArrToAdd">Array, dessen Elemente angehängt werden sollen</param>
  <Extension()> _
  Public Sub AddRange(Of EntryType As Structure) (ByRef arr() As EntryType, _
    ByVal ArrToAdd() As EntryType)
 
    If arr Is Nothing Or ArrToAdd Is Nothing Then
      Throw New InvalidOperationException
    End If
    InsertRange(arr, arr.Length, ArrToAdd, 0, ArrToAdd.Length)
  End Sub
 
#End Region
#Region "RemoveRange"
 
  ''' <summary>Einen Arraybereich entfernen</summary>
  ''' <typeparam name="Entrytype">Datentyp der Arrayelemente</typeparam>
  ''' <param name="arr">Das Quell-Array</param>
  ''' <param name="RemovePosition">
  ''' Der Index des ersten zu entfernenden Elements</param>
  ''' <param name="Length">Die Zahl der zu entfernenden Elemente</param>
  <Extension()> _
  Public Sub RemoveRange(Of Entrytype)(ByRef arr() As Entrytype, _
    ByVal RemovePosition As Integer, ByVal Length As Integer)
 
    If arr Is Nothing OrElse (RemovePosition < 0 Or Length < 1 Or _
      RemovePosition + Length - 1 > arr.Length) Then
 
      Throw New InvalidOperationException
    End If
 
    If RemovePosition = 0 And Length = arr.Length Then
      ' Alle Elemente sind entfernt worden
      arr = Nothing : Exit Sub
    End If
 
    ' Elemente hinter dem gelöschten Bereich nach vorne schieben
    Array.Copy(arr, RemovePosition + Length, arr, _
      RemovePosition, arr.Length - RemovePosition - Length)
 
    ' Den nun überstehenden hinteren Bereich abschneiden
    Array.Resize(arr, arr.Length - Length)
  End Sub
 
  ''' <summary>Ein Arrayelement entfernen</summary>
  ''' <typeparam name="Entrytype">Datentyp der Arrayelemente</typeparam>
  ''' <param name="arr">Das zu kürzende Array</param>
  ''' <param name="RemovePosition">Der Index des zu entfernenden Elements</param>
  <Extension()> _
  Public Sub RemoveRange(Of Entrytype)(ByRef arr() As Entrytype, _
    ByVal RemovePosition As Integer)
 
    RemoveRange(arr, RemovePosition, 1)
  End Sub
 
#End Region
A#Region "GetRange, MoveRange, ReplaceRange"
 
  ''' <summary>Teilbereich eines Array abfragen</summary>
  ''' <typeparam name="Entrytype">Datentyp der Array-Elemente</typeparam>
  ''' <param name="arr">Quell-Array</param>
  ''' <param name="StartPosition">Erstes auszugebendes Element</param>
  ''' <param name="Length">Anzahl der auszugebenden Elemente</param>
  ''' <returns>Array mit einem Teilbereich der Elemente</returns>
  <Extension()> _
  Public Function GetRange(Of Entrytype As Structure)(ByVal arr() As Entrytype, _
    ByVal StartPosition As Integer, ByVal Length As Integer) As Entrytype()
 
    ' Parameter checken
    CheckRange(arr, StartPosition, Length)
    ' RückgabeArray einrichten 
    Dim iarr(Length - 1) As Entrytype
    ' Die Elemente im angeforderten Bereich kopieren
    Array.Copy(arr, StartPosition, iarr, 0, Length)
    ' Rückgabe
    Return iarr
  End Function
 
  ''' <summary>Verschiebung von Array-Elementen 
  ''' (Array-Länge ändert sich nicht, Elemente bleiben erhalten)</summary>
  ''' <typeparam name="EntryType">Datentyp des Array</typeparam>
  ''' <param name="arr">Das Array für die Verschiebe-Operation</param>
  ''' <param name="StartPosition">StartIndex der zu verschiebenden Elemente</param>
  ''' <param name="DestinationPosition">StartIndex der Elemente 
  ''' nach der Verschiebung</param>
  ''' <param name="Length">Anzahl der zu verschiebenden Elemente</param>
  <Extension()> _
  Public Sub MoveRange(Of EntryType As Structure)(ByRef arr() As EntryType, _
    ByVal StartPosition As Integer, ByVal DestinationPosition As Integer, _
    ByVal Length As Integer)
 
    ' Beide Bereiche prüfen
    CheckRange(arr, StartPosition, Length)
    CheckRange(arr, DestinationPosition, Length)
 
    ' Ist etwas zu tun?
    If StartPosition = DestinationPosition Then Exit Sub
 
    Dim iarr(Length - 1) As EntryType
    ' zu verschiebende Elemente auslesen 
    Array.Copy(arr, StartPosition, iarr, 0, Length)
    ' Anzahl noch zu verschiebender Elemente im Array (hinten)
    Dim movelength As Integer = arr.Length - (StartPosition + Length)
    ' Elemente zusammenschieben
    Array.Copy(arr, StartPosition + Length, arr, StartPosition, movelength)
    ' Elemente am DestinationIndex auseinanderschieben
    movelength = arr.Length - (DestinationPosition + Length)
    Array.Copy(arr, DestinationPosition, _
      arr, DestinationPosition + Length, movelength)
    ' zu verschiebende Elemente an der Zielposition einfügen
    Array.Copy(iarr, 0, arr, DestinationPosition, Length)
  End Sub
 
  ''' <summary>Werte von Elementen in einem Bereich des Array ersetzen</summary>
  ''' <typeparam name="Entrytype">Datentyp der Array-Elemente</typeparam>
  ''' <param name="arr">Array, in dem Werte zu ersetzen sind</param>
  ''' <param name="StartPosition">Index des ersten zu ersetzenden Elements</param>
  ''' <param name="ArrNewValues">Array mit den Ersetzungs-Werten</param>
  ''' <param name="StartPositionNewValues">Index des ersten Ersetzungswertes
  ''' in 'ArrNewValues'</param>
  ''' <param name="Length">Zahl der zu ersetzenden Werte</param>
  <Extension()> _
  Public Sub ReplaceRange(Of Entrytype As Structure)(ByRef arr() As Entrytype, _
    ByVal StartPosition As Integer, ByVal ArrNewValues() As Entrytype, _
    ByVal StartPositionNewValues As Integer, ByVal Length As Integer)
 
    CheckRange(arr, StartPosition, Length)
    CheckRange(ArrNewValues, StartPositionNewValues, Length)
 
    ' Bereich in ArrNewValues ab StartPosition einfügen 
    Array.Copy(ArrNewValues, StartPositionNewValues, arr, StartPosition, Length)
  End Sub
 
  ''' <summary>Werte von Elementen in einem Bereich des Array ersetzen</summary>
  ''' <typeparam name="Entrytype">Datentyp der Array-Elemente</typeparam>
  ''' <param name="arr">Array, in dem Werte zu ersetzen sind</param>
  ''' <param name="StartPosition">Index des ersten zu ersetzenden Elements</param>
  ''' <param name="ArrNewValues">Array mit den Ersetzungs-Werten</param>
  <Extension()> _
  Public Sub ReplaceRange(Of Entrytype As Structure)(ByRef arr() As Entrytype, _
    ByVal StartPosition As Integer, ByVal ArrNewValues() As Entrytype)
 
    If ArrNewValues Is Nothing Then Throw New InvalidOperationException
    ReplaceRange(arr, StartPosition, ArrNewValues, 0, ArrNewValues.Length)
  End Sub
 
#End Region
#Region "Hilfsfunktion"
  Private Sub CheckRange(Of Entrytype As Structure) (ByVal Arr() As Entrytype, _
    ByVal StartRange As Integer, ByVal RangeLength As Integer, _
    Optional ByVal FixedLength As Boolean = True)
 
    ' Liegt ein Range im Bereich des Array? (sonst: Ausnahme)
    If Arr Is Nothing OrElse _
      (Arr.Length < 1 Or RangeLength < 1 Or _
      StartRange < 0 Or StartRange > Arr.Length) Then
 
      Throw New InvalidOperationException
    End If
    If FixedLength Then
      If StartRange + RangeLength > Arr.Length Then
        Throw New InvalidOperationException
      End If
    End If
  End Sub
#End Region
End Module

Dieser Tipp wurde bereits 11.581 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Aktuelle Diskussion anzeigen (11 Beiträge)

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2024 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel