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): 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: 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.612 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
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. |
sevAniGif (VB/VBA) Anzeigen von animierten GIF-Dateien Ab sofort lassen sich auch unter VB6 und VBA (Access ab Version 2000) animierte GIF-Grafiken anzeigen und abspielen, die entweder lokal auf dem System oder auf einem Webserver gespeichert sind. Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 Access-Tools Vol.1 Über 400 MByte Inhalt Mehr als 250 Access-Beispiele, 25 Add-Ins und ActiveX-Komponenten, 16 VB-Projekt inkl. Source, mehr als 320 Tipps & Tricks für Access und VB |
||||||||||||||||
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. |