[RESOLVED] Binary Number Program

Hi ,

I would like to make a small program that generates a list of 8 bit binary numbers that have an equal amount of 1s and 0s in the number.

I want to just press a button and then a list will be displayed in a text box or something .

Example : 11110000 is a number with an equal amount
00000001 is NOT a number with an equal amount


Thanks

EDIT: Also I would prefer the list be displayed in ascending order

you could put into a list box with sorted set to true

But how would I generate the list of binary numbers that meet my requirements ( equal amount of 1s and 0s) ?

I think I must be missing something because I can only come up with six combinations. Which isn't much of a list. Did I misunderstand or am I missing more combinations?
11110000
00001111
11001100
00110011
01010101
10101010

Smallest number: 15 = "00001111"
Largest number: 240 = "11110000"

Code:

---

For n = 15 to 240
  Convert n to binary string sBin
  Remove "0" from sBin by using Replace(sBin, "0", "")
  If remain string is "1111" then pick that sBin
Next

---

Quote:

---

I think I must be missing something because I can only come up with six combinations. Which isn't much of a list. Did I misunderstand or am I missing more combinations?
11110000
00001111
11001100
00110011
01010101
10101010

---

There are 70. Add a listbox and a command button to a form:

Code:

---

Option Explicit

Private Function DecToBin(DecNum As String) As String
  Dim BinNum As String
  Dim lDecNum As Long
  Dim i As Integer
 
  On Error GoTo ErrorHandler
 
'  Check the string for invalid characters
  For i = 1 To Len(DecNum)
      If Asc(Mid(DecNum, i, 1)) < 48 Or _
        Asc(Mid(DecNum, i, 1)) > 57 Then
        BinNum = ""
        Err.Raise 1010, "DecToBin", "Invalid Input"
      End If
  Next i
 
  i = 0
  lDecNum = Val(DecNum)
 
  Do
      If lDecNum And 2 ^ i Then
        BinNum = "1" & BinNum
      Else
        BinNum = "0" & BinNum
      End If
      i = i + 1
  Loop Until 2 ^ i > lDecNum
'  Return BinNum as a String
    DecToBin = BinNum
   
    If Len(DecToBin) < 8 Then
        Do Until Len(DecToBin) = 8
            DecToBin = "0" & DecToBin ' & "0"
        Loop
    End If
 
ErrorHandler:
End Function

Private Sub Command1_Click()
    Dim i As Integer
    Dim j As Integer
    Dim Flag1 As Integer
    Dim Flag0 As Integer
    Dim DoConvert
    For i = 1 To 256
        Flag1 = 0
        Flag0 = 0
        DoConvert = DecToBin(CStr(i))
        For j = 1 To 8
            If Mid(DoConvert, j, 1) = "1" Then
                Flag1 = Flag1 + 1
            End If
            If Mid(DoConvert, j, 1) = "0" Then
                Flag0 = Flag0 + 1
            End If
            If Flag1 = 4 And Flag0 = 4 Then
                List1.AddItem i & " " & DoConvert
            End If
        Next
    Next
    MsgBox List1.ListCount
End Sub

---

This would be simpler:

Code:

---

Option Explicit

Function Byte2Bin(ByVal Num As Byte) As String
    Dim i As Integer
   
    Byte2Bin = "00000000"
    For i = 0 To 7
        If (Num And 2 ^ i) Then Mid$(Byte2Bin, 8 - i, 1) = "1"
    Next
End Function

Sub GetBinList()
    Dim n As Integer
    Dim sBin As String
   
    'List1.Clear
    For n = 0 To 255
        sBin = Byte2Bin(n)
        If Replace(sBin, "0", "") = "1111" Then
            'List1.AddItem sBin
            Debug.Print sBin
        End If
    Next
End Sub

---

00001111
00010111
00011011
00011101
00011110
00100111
00101011
00101101
00101110
00110011
00110101
00110110
00111001
00111010
00111100
01000111
01001011
01001101
01001110
01010011
01010101
01010110
01011001
01011010
01011100
01100011
01100101
01100110
01101001
01101010
01101100
01110001
01110010
01110100
01111000
10000111
10001011
10001101
10001110
10010011
10010101
10010110
10011001
10011010
10011100
10100011
10100101
10100110
10101001
10101010
10101100
10110001
10110010
10110100
10111000
11000011
11000101
11000110
11001001
11001010
11001100
11010001
11010010
11010100
11011000
11100001
11100010
11100100
11101000
11110000

Wow! Like I said I just knew I had to be missing something. As it turns out, I'm missing a lot of binary numbers!:eek2:

Very trick! I like that!

You can also count active bits by math instead of string operations, this kind of does the opposite in comparison to anhn's code:

Code:

---

Option Explicit

Public Function BinByte(ByVal Number As Byte) As String
    Static lngA As Long, strByte As String * 8
    For lngA = 8 To 1 Step -1
        Mid$(strByte, lngA, 1) = Mid$("01", 1 + (Number And 1), 1)
        Number = Number \ 2
    Next lngA
    BinByte = strByte
End Function

Public Function CountBits(ByVal Number As Long) As Long
    CountBits = -(Number < 0)
    Number = Number And &H7FFFFFFF
    Do While Number
        CountBits = CountBits + (Number And 1)
        Number = Number \ 2
    Loop
End Function

Private Sub Form_Load()
    Dim lngA As Long
    For lngA = 0 To 255
        If CountBits(lngA) = 4 Then
            Debug.Print BinByte(lngA)
        End If
    Next lngA
End Sub

---

Needs more functions if you really want to display it as a binary string. If you don't need, then calling CountBits is much faster than creating a string and the function is short :)