Bitmask-Klasse Mit diesem Klassenmodul lassen sich bis zu 64 "Ja-Nein-Werte" in einem einzigen Long-Wert schreiben und wieder auslesen.
Autor:   Steffen Stamprath	Bewertung:     [ Jetzt bewerten ]	Views:  12.012
www.bluedeveloper.de	System:  Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 12 Bewertung insgesamt: sehr gut Durchschnittliche Bewertung: 4.5 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Normalerweise braucht man um z.B. die eingebrauten Extras in einem Auto zu beschreiben mehrere Werte. Sprich "Radio = True", "Hintertüren = False", ....

Aber es gibt auch eine Möglichkeit bis zu 64 "Ja-Nein-Werte" in einen einzigen Long Wert zu schreiben. Dazu habe ich die Klasse Bitmask geschrieben. Zum besseren Verständniss befindet sich direkt darunter auch ein Besipiel.

Haupt-Klasse

Public MustInherit Class Bitmask
  Protected m_Value As Long = &H0
 
#Region " Members "
 
  Property Value() As Long
    Get
      Return m_Value
    End Get
    Set(ByVal value As Long)
      m_Value = value
    End Set
  End Property
 
#End Region
 
  Public Sub SetOn(ByVal position As Long)
    m_Value = position Or m_Value
  End Sub
 
  Public Sub SetOff(ByVal position As Long)
    m_Value = m_Value And Not position
  End Sub
 
  Public Function IsOn(ByVal position As Long) As Boolean
    Return (m_Value And position) = position
  End Function
 
  Public Function GetLabel() As String
    Try
      ' Maximal Option herausfinden
      Dim nHighestPosition As Long
      nHighestPosition = GetHighestPosition()
 
      ' Alle String's miteinander verketten
      Dim sTempLabel As String = ""
      For I As Long = 0 To nHighestPosition
        If IsOn(CLng(2 ^ I)) = True Then
          If sTempLabel <> "" Then sTempLabel &= ", "
          sTempLabel &= GetPositionLabel(CLng(2 ^ I))
        End If
      Next
 
      Return sTempLabel
    Catch ex As Exception
      ' ToDo Fehlerbehandlung
      Return ""
    End Try
  End Function
 
  Public Function GetHighestPosition() As Long
    Try
      For I As Long = 32 To 0 Step -1
        If GetPositionLabel(CLng(2 ^ I)) <> "" Then
          Return I
        End If
      Next
    Catch ex As Exception
      ' ToDo Fehlerbehandlung
      Return 0
    End Try
  End Function
 
  Protected MustOverride Function GetPositionLabel(ByVal position As Long) As String
End Class

Beispiel-Klasse

Public Class SampleAutoBitmask
  Inherits Bitmask
 
  Public Const Radio As Long = &H1
  Public Const Navigationsgeraet As Long = &H2
  Public Const Hintertueren As Long = &H4
  Public Const Kofferraum As Long = &H8
  Public Const Sechsgang As Long = &H10
 
  ' weitere... (Werte währen &H20, &H40, &H80, &H100, &H200, ...)
 
  Protected Overrides Function GetPositionLabel(ByVal position As Long) As String
    Try
      Select Case position
        Case Radio : Return "Radio"
        Case Navigationsgeraet : Return "Navigationsgerät"
        Case Hintertueren : Return "Hintertüren"
        Case Kofferraum : Return "Kofferraum"
        Case Sechsgang : Return "Sechsgang"
      End Select
 
      Return ""
    Catch ex As Exception
      ' ToDo Fehlerbehandlung
      Return ""
    End Try
  End Function
End Class

Aufrufbeispiel

Dim oSampleBitmask As SampleAutoBitmask
oSampleBitmask = New SampleAutoBitmask
 
With oSampleBitmask
  ' Einen Wert oder mehrere auf '1' setzen 
  ' (mit dem logischen Operator 'Or' verknüpft)
  .SetOn(SampleAutoBitmask.Radio Or SampleAutoBitmask.Hintertueren Or _
    SampleAutoBitmask.Sechsgang)
 
  ' Einen Wert oder mehrere auf '0' setzen
  ' (mit dem logischen Operator 'Or' verknüpft)
  .SetOff(SampleAutoBitmask.Radio)
 
  ' Abfragen ob ein Wert auf '1' steht
  Dim bWertOn As Boolean
  bWertOn = .IsOn(SampleAutoBitmask.Radio)
 
  ' Alle Label anzeigen die auf '1' stehen
  MsgBox(.GetLabel())
End With