Startseite / Tipps / VB 5/6-Tipp 0292: Bytes komfortabel in Bits umwandeln

VB 5/6-Tipp 0292: Bytes komfortabel in Bits umwandeln

 von ActiveVB

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Optionsfeld-Steuerelement "Option1" (Index von 0 bis 3)
' Steuerelement: Kontrollkästchen-Steuerelement "Check1"
' Steuerelement: Textfeld "Text1"
' Steuerelement: Beschriftungsfeld "Label4"
' Steuerelement: Beschriftungsfeld "Label1"
' Steuerelement: Beschriftungsfeld "Label3"
' Steuerelement: Beschriftungsfeld "Label2"

Option Explicit

Dim BTT&

Private Sub Form_Load()
  Label1.Caption = ""
  Option1(0).Value = True
End Sub

Private Sub Text1_Change()
  Dim NoNull As Boolean
  
    NoNull = IIf((Check1.Value = vbChecked), True, False)
    Label1.Caption = GetBits(Val(Text1.Text), NoNull, 31, BTT)
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
  Dim OkStr$
    
    OkStr = "0123456789" & Chr$(8)
    If InStr(1, OkStr, Chr$(KeyAscii)) = 0 Then KeyAscii = 0
End Sub

Private Sub Option1_Click(Index As Integer)
  Select Case Index
    Case 0: BTT = 4
    Case 1: BTT = 8
    Case 2: BTT = 16
    Case 3: BTT = 31
  End Select
End Sub

Private Function GetBits(Bt As Double, Optional NoNull As Boolean _
                         = False, Optional ByVal Bits = 8, _
                         Optional BSplit = 8) As String
                         
  Dim x%, y&, aa$, bb$, First As Boolean, Cnt As Byte
    
    If Bt < 2 ^ 31 Then
      y = CLng(Bt)
      Bits = Bits - 1
      For x = Bits To 0 Step -1
        If y And 2 ^ x Then
          aa = aa & "1"
          First = True
        Else
          If Not NoNull Or First Then
          aa = aa & "0"
          End If
        End If
      Next x
      
      If Len(aa) > 1 And Len(aa) > BSplit Then
        For x = Len(aa) To 1 Step -1
          bb = Mid$(aa, x, 1) & bb
          If (Len(aa) - (x - 1)) Mod BSplit = 0 Then bb = "-" & bb
        Next x
        If Left$(bb, 1) = "-" Then bb = Mid$(bb, 2)
        aa = bb
      End If
    Else
      aa = "Überlauf"
    End If
    
    GetBits = aa
End Function
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-Version	Win32s	Win95	Win98	WinME	WinNT4	Win2000	WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version: VB6 VB5 VB4

Windows-Version: Windows XP Windows 2000 Windows NT4 Windows Me Windows 98 Windows 95 Win32s

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 5 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Private Sub Bit_aus_Byte()
Dim byte1,byte2,Ergebnis As Integer
Dim bit As Boolean
 
Ergebnis = byte1 And byte2

If Ergebnis = 32 Then
  bit = True
 Else
  bit 0 False
End If

End Sub

Public Function getbits(ByVal inByte As Byte) As String
    Dim Testbyte As Byte = &H80
    Dim bits As String
    Dim i As Integer

    For i = 1 To 8
        If (inByte And Testbyte) = Testbyte Then
            bits += "1"
        Else
            bits += "0"
        End If
        Testbyte = Testbyte >> 1
    Next i

    Return bits
End Function