vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#

https://www.vbarchiv.net
Rubrik: Variablen/Strings   |   VB-Versionen: VB.NET12.06.08
Bitmask-Klasse

Mit diesem Klassenmodul lassen sich bis zu 64 "Ja-Nein-Werte" in einem einzigen Long-Wert schreiben und wieder auslesen.

Autor:   Steffen StamprathBewertung:  Views:  11.665 
www.bluedeveloper.deSystem:  Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt auf CD 

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



Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

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.
 
 
Copyright ©2000-2024 vb@rchiv Dieter OtterAlle 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.