Rubrik: Variablen/Strings · Arrays | VB-Versionen: VB5, VB6 | 20.06.05 |
Teilmatrix lesen und schreiben Schnelles Lesen und Schreiben von Daten in numerischen Arrays | ||
Autor: Manfred Bohn | Bewertung: | Views: 10.522 |
ohne Homepage | System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | kein Beispielprojekt |
Viele numerische Prozeduren arbeiten auf der Grundlage von Datenmatrizen ( = zweidimensional deklarierte numerische Arrays). Dabei müssen manchmal Teilbereiche von Arrays gelesen, kopiert oder verschoben werden.
Üblicherweise programmiert man eine Doppelschleife, die die einzelnen Array-Elemente im benötigten Teilbereich vom Quell-Array in das Ziel-Array überträgt. Bei sehr großen Datenfeldern und sich wiederholenden Kopier-Operationen verbraucht diese Vorgehensweise ordentlich Rechenzeit.
Bei den Routinen im Modul 'modTeilmatrix' wird deshalb ein anderer Weg beschritten.
Bei Arrays, deren Elemente aus einem numerischen Datentyp bestehen, sind diese im Speicher hintereinander aufgereiht. Wenn man die Adresse des ersten Elementes kennt und die Byte-Länge der Elemente, kann die Position jedes einzelnen Array-Feldes im Speicher leicht berechnet werden.
Die Position des ersten Elements der Matrix 'a' kann z.B. abgefragt werden durch die undokumentierte VB-Funktion 'VarPtr': Adresse = VarPtr(a(LBound(a, 1), LBound(a, 2)))
Die Länge eines einzelnen Array-Elementes hängt vom Datentyp ab: Byte = 1Byte; Integer/Boolean = 2 Byte; Long/Single = 4 Byte; Currency/Double/Date = 8; Byte, Variant = 16 Byte.
Damit steht der Anwendung der API-Funktion 'RtlMoveMemory' nichts im Wege. Im Speicher direkt hintereinander stehende Array-Elemente können durch einen einzigen Aufruf kopiert werden. Falls diese zusammenhängenden Bereiche sehr groß sind, wird das Übertragen von Daten erheblich beschleunigt.
Ausschlaggebend ist die Zahl der Indices der zweiten Dimension, die zu kopieren sind. Eine Teilmatrix vom Format 1000 * 10 benötigt nur 10 Kopiervorgänge, eine Teilmatrix im Format 10 * 1000 benötigt 1000 Kopiervorgänge, weil nur jeweils 10 Feldelemente im Speicher direkt hintereinander stehen.
Damit die Routinen flexibel für verschiedene Datentypen anwendbar sind, werden Quell- und Ziel-Array als Variant-Parameter übergeben (ByRef). Aus diesem Grund kann zur Ermittlung der Speicheradresse die VarPtr-Funktion nicht benutzt werden. Es ist erforderlich, einen Dreifach-Zeiger aufzulösen und die SafeArray-Struktur der Datenfelder zu lesen (vgl. Routine: 'ArrayInfo'). Diese Struktur enthält den benötigten Zeiger und wird zusätzlich herangezogen zur Kontrolle der Array-Dimensionen und der Art der Deklaration.
Der Kopiervorgang läuft über eine einfache Schleife im gewünschten Bereich der zweiten Matrix-Dimension. Dabei können die Zeiger auf die Daten durch einfache Addition der im Speicher dazwischenliegenden Bytes hochgesetzt werden.
Aufruf der Routine 'TeilMatrix_Lesen':
Im ersten Parameter ist eine zweidimensionale Datenmatrix anzugeben (Quell-Array; statisch oder dynamisch).
Im zweiten Parameter wird ein dynamisch deklariertes Array erwartet, dessen Elemente vom gleichen Datentyp wie das Quell-Array sein müssen. Dieses Zielarray wird in der Routine dimensioniert (in beiden Dimensionen jeweils ab 1).
Im dritten und vierten Parameter sind die Indices des ersten zu kopierenden Array-Elementes zu übergeben [ = a(Start1, Start2) ].
Im vierten und fünften Parameter muss die Zahl der zu kopierenden Indices auf der ersten und der zweiten Dimension angegeben werden.
Kopierter Datenblock von: a(Start1, Start2) bis a(Start1+ZuLesen1 - 1, Start2 + ZuLesen2 -1)
Das Ziel-Array (= Teilmatrix) erhält die Dimension b(1 to ZuLesen1, 1 to ZuLesen2).
Aufruf der Routine 'TeilMatrix_Schreiben':
Im ersten Parameter ist die Datenmatrix anzugeben, in die die Daten eingetragen werden sollen.
Der zweite Parameter erwartet die zu schreibenden Daten (Matrix).
Der dritte und vierte Parameter definiert den ersten Index in der Matrix (1. Parameter) ab der die Teilmatrix (2. Parameter) eingetragen wird. Es wird stets die gesamte Teilmatrix in die Matrix geschrieben.
Beide Routinen melden 'False' wenn der zu lesende bzw. zu schreibende Bereich die Dimensionen der Matrix über- oder unterschreitet (näheres ist dem Quellcode zu entnehmen).
Die Routinen akzeptieren auch Arrays, deren Elemente aus dem Datentyp Variant bestehen. Sollten (einzelne oder alle) Elemente im zu kopierenden Bereich nicht-numerisch sein (einschließlich BOOLEAN und DATE), droht ein Programmabsturz. Der Datentyp DECIMAL ist zugelassen, aber auch numerisch interpretierbare Strings sind nicht erlaubt.
Die Routine 'Demo_TeilMatrix' zeigt, wie in einer Matrix gelesen und geschrieben wird.
' ================================================================ ' Start Quellcode 'modTeilMatrix' ' ================================================================ Option Explicit ' Lesen und Schreiben einer Teilmatrix ' Die Routinen verarbeiten alle numerischen VB-Datentypen ' Kopierfunktion für eine Bytefolge Private Declare Sub CopyMemory Lib "kernel32" _ Alias "RtlMoveMemory" ( _ Ziel As Any, _ Quelle As Any, _ ByVal Anzahl_Bytes As Long) ' Teil der 'SafeArray'-Struktur eines Datenfeldes Private Type udtArrayInfo Dimensionen As Integer ' Zahl der Dimensionen Features As Integer ' Array-Attribute (als Bitfolge) Bytes_Pro_Feld As Long ' Anzahl der Bytes pro Element Locks As Long ' Anzahl der gesetzten Array-Sperren Data_Pointer As Long ' numerisch: Zeiger auf Array-Start End Type Public Function TeilMatrix_Lesen(ByRef Matrix As Variant, _ ByRef TeilMatrix As Variant, _ ByVal Start1 As Long, _ ByVal Start2 As Long, _ ByVal ZuLesen1 As Long, _ ByVal ZuLesen2 As Long) As Boolean ' In 'Matrix' wird die 'Teilmatrix' ausgelesen ' Start1: 1. zu lesender Index in Matrix (Dim 1) ' ZuLesen1: zu lesende Indices in Dimension 1 ' Start2: 1. zu lesender Index in Matrix (Dim 2) ' ZuLesen2: zu lesende Indices in Dimension 2 Dim quell_ptr As Long, ziel_ptr As Long Dim pos As Long, i As Long, z As Long Dim ai_m As udtArrayInfo, ai_tm As udtArrayInfo Dim lb1 As Long, lb2 As Long Dim ub1 As Long, ub2 As Long On Error GoTo fehler ' Eingabeparameter prüfen If Not IsArray(Matrix) Then Exit Function If Not IsArray(TeilMatrix) Then Exit Function If VarType(Matrix) <> VarType(TeilMatrix) Then Exit Function If ZuLesen1 < 1 Or ZuLesen2 < 1 Then Exit Function If Not ArrayInfo(Matrix, ai_m) Then Exit Function ' 2 Dimensionen sind gefordert If ai_m.Dimensionen <> 2 Then Exit Function ' unterstützter Datentyp If Not CheckDatenTyp(Matrix) Then Exit Function lb1 = LBound(Matrix, 1): ub1 = UBound(Matrix, 1) lb2 = LBound(Matrix, 2): ub2 = UBound(Matrix, 2) ' Bereich innerhalb der Matrix? If Start1 < lb1 Or Start1 + ZuLesen1 - 1 > ub1 Then Exit Function If Start2 < lb2 Or Start2 + ZuLesen2 - 1 > ub2 Then Exit Function ' Ausgabe-Teilmatrix verwendbar? If ArrayInfo(TeilMatrix, ai_tm) Then ' bereits deklariertes Array: ' gesperrt, statisch oder fixiert? With ai_tm If .Locks > 0 Then Exit Function If .Features And &H2 Then Exit Function If .Features And &H10 Then Exit Function End With End If ' Ausgabe-Teilmatrix einrichten ReDim TeilMatrix(1 To ZuLesen1, 1 To ZuLesen2) ' nach REDIM ArrayInfo neu lesen If Not ArrayInfo(TeilMatrix, ai_tm) Then Exit Function ' Erstes zu kopierendes Element (Feld-Reihung) pos = (GetPosition(lb1, ub1, lb2, ub2, Start1, Start2) - 1) If pos < 0 Then Exit Function ' Zeiger auf erstes zu kopierendes Element ' in Quell- und Zielarray quell_ptr = pos * ai_m.Bytes_Pro_Feld + ai_m.Data_Pointer ziel_ptr = ai_tm.Data_Pointer ' Bereich in 2. Dimension durchlaufen z = 0 For i = Start2 To Start2 + ZuLesen2 - 1 z = z + 1 ' Byte-Abschnitt kopieren Call CopyMemory(ByVal ziel_ptr, ByVal quell_ptr, ZuLesen1 * ai_tm.Bytes_Pro_Feld) ' Zeiger um eine Dimension hochsetzen quell_ptr = quell_ptr + _ (ub1 - lb1 + 1) * ai_m.Bytes_Pro_Feld ziel_ptr = ziel_ptr + _ ZuLesen1 * ai_tm.Bytes_Pro_Feld Next i TeilMatrix_Lesen = True fehler: End Function
Public Function TeilMatrix_Schreiben(ByRef Matrix As Variant, _ ByRef TeilMatrix As Variant, _ ByVal Start1 As Long, _ ByVal Start2 As Long) As Boolean ' In 'Matrix' wird die 'Teilmatrix' eingetragen ' Start1: 1. zu beschreibender Index in Matrix (Dim1) ' Start2: 1. zu beschreibender Index in Matrix (Dim2) Dim quell_ptr As Long, ziel_ptr As Long Dim pos As Long, i As Long, z As Long Dim ai_m As udtArrayInfo, ai_tm As udtArrayInfo Dim lb1 As Long, lb2 As Long Dim ub1 As Long, ub2 As Long Dim ZuSchreiben1 As Long, ZuSchreiben2 As Long On Error GoTo fehler ' Eingabeparameter prüfen If Not IsArray(Matrix) Then Exit Function If Not IsArray(TeilMatrix) Then Exit Function If VarType(Matrix) <> VarType(TeilMatrix) Then Exit Function If Not CheckDatenTyp(Matrix) Then Exit Function ' Array deklariert (SafeArray verfügbar)? If Not ArrayInfo(Matrix, ai_m) Then Exit Function ' 2 Dimensionen sind gefordert If ai_m.Dimensionen <> 2 Then Exit Function lb1 = LBound(Matrix, 1): ub1 = UBound(Matrix, 1) lb2 = LBound(Matrix, 2): ub2 = UBound(Matrix, 2) ' Teilmatrix verwendbar? If Not ArrayInfo(TeilMatrix, ai_tm) Then Exit Function If ai_tm.Dimensionen <> 2 Then Exit Function ZuSchreiben1 = UBound(TeilMatrix, 1) - LBound(TeilMatrix, 1) + 1 ZuSchreiben2 = UBound(TeilMatrix, 2) - LBound(TeilMatrix, 2) + 1 ' Kann Teilmatrix vollständig eingefügt werden? If Start1 < lb1 Or Start1 + ZuSchreiben1 - 1 > ub1 Or _ Start2 < lb2 Or Start2 + ZuSchreiben2 - 1 > ub2 Then Exit Function End If ' Position des ersten zu kopierenden Elements in Zielmatrix ' (Feld-Reihung) pos = (GetPosition(lb1, ub1, lb2, ub2, Start1, Start2) - 1) If pos < 0 Then Exit Function ' Zeiger auf erstes einzufügendes Element ' in Quell- und Zielarray quell_ptr = pos * ai_m.Bytes_Pro_Feld + ai_m.Data_Pointer ziel_ptr = ai_tm.Data_Pointer ' Bereich in 2. Dimension durchlaufen z = 0 For i = Start2 To Start2 + ZuSchreiben2 - 1 z = z + 1 ' Byte-Abschnitt kopieren Call CopyMemory(ByVal quell_ptr, ByVal ziel_ptr, ZuSchreiben1 * ai_tm.Bytes_Pro_Feld) ' Zeiger um eine Dimension hochsetzen quell_ptr = quell_ptr + (ub1 - lb1 + 1) * ai_m.Bytes_Pro_Feld ziel_ptr = ziel_ptr + ZuSchreiben1 * ai_tm.Bytes_Pro_Feld Next i TeilMatrix_Schreiben = True fehler: End Function
Private Function CheckDatenTyp(ByRef Matrix As Variant) As Boolean ' Datentyp der Matrix prüfen Dim vt As Long, ok As Boolean vt = VarType(Matrix) - vbArray If vt = vbByte Then ok = True If vt = vbInteger Or vt = vbLong Then ok = True If vt = vbSingle Or vt = vbDouble Then ok = True If vt = vbCurrency Then ok = True If vt = vbBoolean Or vt = vbDate Then ok = True If vt = vbVariant Then ok = True CheckDatenTyp = ok End Function
Private Function GetPosition(ByVal lb1 As Long, ByVal ub1 As Long, _ ByVal lb2 As Long, ByVal ub2 As Long, _ ByVal pos1 As Long, ByVal pos2 As Long) As Long ' absolute Position eines Datenfeldes in einem Array GetPosition = -1 If pos1 < lb1 Or pos1 > ub1 Then Exit Function If pos2 < lb2 Or pos2 > ub2 Then Exit Function GetPosition = ((ub1 - lb1) + 1) * (pos2 - lb2) + (pos1 - lb1 + 1) End Function
Private Function ArrayInfo(ByRef Matrix As Variant, ai As udtArrayInfo) As Boolean ' Arrayinfos abfragen Dim vtp As Long, ptr As Long If Not IsArray(Matrix) Then Exit Function ' (Array ist über einen Variant-Parameter ' ByRef' übergeben worden) Call CopyMemory(vtp, ByVal VarPtr(Matrix) + 8, 4) If vtp = 0 Then Exit Function Call CopyMemory(ptr, ByVal vtp, 4&) If ptr = 0 Then Exit Function Call CopyMemory(ai, ByVal ptr, 16) ArrayInfo = True End Function
Public Function Demo_TeilMatrix() As Boolean ' Demonstration Lesen/Schreiben einer Teilmatrix Dim ug1&, og1&, ug2&, og2& ' Matrix-Dim Dim i&, k&, i1&, k1&, du& ' Loops Dim bug1&, bog1&, bug2&, bog2& ' Bereich Dim Matrix() As Variant, TeilMatrix() As Variant ' Testdurchgänge For du = 1 To 1000 ' zufällige Dimensionen og1 = Rnd * 200 + 1 og2 = Rnd * 200 + 1 ug1 = Rnd * (og1 - 1) + 1 ug2 = Rnd * (og2 - 1) + 1 ' Matrix erstellen ReDim Matrix(ug1 To og1, ug2 To og2) ' Matrix füllen For i = ug1 To og1 For k = ug2 To og2 ' wechselnde Datentypen in ' Variant-Array eintragen If du Mod 5 = 1 Then Matrix(i, k) = CByte(Rnd * 250 + 1) ElseIf du Mod 5 = 2 Then Matrix(i, k) = CDec(Rnd * 1000000) ElseIf du Mod 5 = 3 Then Matrix(i, k) = CCur(Rnd * 1000000) ElseIf du Mod 5 = 4 Then Matrix(i, k) = CDate(Rnd * 10000) Else Matrix(i, k) = CSng(Rnd * 1000000) End If Next k Next i ' zu lesender Bereich per Zufall bog1 = Rnd * (og1 - ug1) + ug1 bug1 = Rnd * (bog1 - ug1) + ug1 bog2 = Rnd * (og2 - ug2) + ug2 bug2 = Rnd * (bog2 - ug2) + ug2 ' Bereich Lesen If Not TeilMatrix_Lesen(Matrix(), TeilMatrix(), bug1, bug2, bog1 - bug1 + 1, _ bog2 - bug2 + 1) Then MsgBox "Lesevorgang scheitert!" Exit Function End If ' Vergleichen: Matrix-Bereich / Teilmatrix i1 = 0 For i = bug1 To bog1 i1 = i1 + 1: k1 = 0 For k = bug2 To bog2 k1 = k1 + 1 If Matrix(i, k) <> TeilMatrix(i1, k1) Then MsgBox "Lesevorgang fehlerhaft" Exit Function End If ' Bereich in Matrix auf 0 setzen Matrix(i, k) = 0 Next k Next i ' Teilmatrix wieder in Matrix eintragen If Not TeilMatrix_Schreiben(Matrix(), TeilMatrix(), bug1, bug2) Then MsgBox "Schreibvorgang scheitert!" Exit Function End If ' Vergleichen: Matrix-Bereich / Teilmatrix i1 = 0 For i = bug1 To bog1 i1 = i1 + 1: k1 = 0 For k = bug2 To bog2 k1 = k1 + 1 If Matrix(i, k) <> TeilMatrix(i1, k1) Then MsgBox "Schreibvorgang fehlerhaft" Exit Function End If Next k Next i Next du ' nächster Durchgang MsgBox "Test beendet" Demo_TeilMatrix = True End Function ' ================================================================ ' Start Quellcode 'modTeilMatrix' ' ================================================================