vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Top-Preis! AP-Access-Tools-CD Volume 1  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2019
 
zurück
Rubrik: Variablen/Strings · Arrays   |   VB-Versionen: VB5, VB620.06.05
Teilmatrix lesen und schreiben

Schnelles Lesen und Schreiben von Daten in numerischen Arrays

Autor:   Manfred BohnBewertung:     [ Jetzt bewerten ]Views:  9.282 
ohne HomepageSystem:  Win9x, WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10kein 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'
' ================================================================

Dieser Tipp wurde bereits 9.282 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.

Neue Diskussion eröffnen

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-2019 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