Array um 90° drehen Dreht ein Byte-Array um 90°
Autor:   E7	Bewertung:     [ Jetzt bewerten ]	Views:  17.005
ohne Homepage	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 14 Bewertung insgesamt: mittelmäßig Durchschnittliche Bewertung: 2.0 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Hier ein Tipp, entstanden im Forum, mit dem man ein Byte-Array um 90° drehen kann... Der meiste Code ist lediglich zur Darstellung, die Hauptaufgabe erledigt die Funktion RotateArrayByte().

Option Explicit
 
' Unser Array
Dim A(5, 5) As Byte

Private Sub Form_Load()
  Dim e1 As Long
  Dim e2 As Long
 
  ' Einstellungen
  Me.AutoRedraw = True
  Me.ScaleMode = vbPixels
  Me.DrawWidth = 10
 
  ' Array mit zufälligen Werten füllen
  Randomize Timer
  For e1 = LBound(A, 1) To UBound(A, 1)
    For e2 = LBound(A, 2) To UBound(A, 2)
      A(e1, e2) = Rnd * 10
  Next e2, e1
 
  ' Array vorher ausgeben
  DrawArray 10
 
  ' Rotieren
  RotateArrayByte A
 
  ' Nachher ausgeben
  DrawArray 100
End Sub

Sub RotateArrayByte(RArray As Variant)
  Dim e1 As Long
  Dim e2 As Long
  Dim Arr2() As Byte
 
  ' Erst mal SecondHand-Array zulegen
  ReDim Arr2(LBound(RArray, 1) To UBound(RArray, 1), _
    LBound(RArray, 2) To UBound(RArray, 2)) As Byte
 
  ' Drehen um 90°
  For e1 = LBound(RArray, 1) To UBound(RArray, 1)
    For e2 = LBound(RArray, 2) To UBound(RArray, 2)
      Arr2(UBound(RArray, 2) - e2, e1) = RArray(e1, e2)
  Next e2, e1
 
  ' Zurückkopieren in Originalarray
  For e1 = LBound(RArray, 1) To UBound(RArray, 1)
    For e2 = LBound(RArray, 2) To UBound(RArray, 2)
      RArray(e1, e2) = Arr2(e1, e2)
  Next e2, e1
End Sub

Sub DrawArray(PosX As Long)
  ' Nur zur Kontroll!
  Dim e1 As Long
  Dim e2 As Long
  Dim C As Long
 
  For e1 = LBound(A, 1) To UBound(A, 1)
    For e2 = LBound(A, 2) To UBound(A, 2)
      If A(e1, e2) = 3 Then
        C = vbRed
      Else
        C = vbWhite / 10 * A(e1, e2)
      End If
      Me.PSet (PosX + 10 * e1, 10 + 10 * e2), C
  Next e2, e1
End Sub