vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
SEPA-Dateien erstellen inkl. IBAN-, BLZ-/Kontonummernprüfung  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2018
 
zurück
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:     [ Jetzt bewerten ]Views:  9.052 
www.bluedeveloper.deSystem:  Win2k, WinXP, Vista, Win7, Win8, Win10 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

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

Druckansicht Druckansicht Copyright ©2000-2018 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