Advertisement
2_2002-2004 VB function enhancement #119900

[A] Convert decimal value to binary

This code can be used to convert values to binary format (bits: zeros and ones).

AI

AI Summary: This codebase represents a historical implementation of the logic described in the metadata. Our preservation engine analyzes the structure to provide context for modern developers.

Source Code
original-source
Add 2 Text Boxes (Text1 and Text2) and
1 Button (Command1) to a Form!
' --- Form Code Starts Here ---
' =======================================
' Convert decimal value to binary
' =======================================
'
' This code can be used to convert
' values to binary format (bits:
' zeros and ones).
'
' Use toBIN_WORD() function to convert
' integers (16 bits), and
' toBIN_BYTE() to convert bytes (8 bits).
'
' Visit my Homepage:
' http://www.geocities.com/emu8086/vb/
'
'
' Last Update: Thursday, July 11, 2002
'
'
' Copyright 2002 Alexander Popov Emulation Soft.
'  All rights reserved.
' http://www.geocities.com/emu8086/
Option Explicit
Private Sub Command1_Click()
 Text2.Text = toBIN_WORD(Val(Text1.Text))
End Sub
' returns BINARY presentation of a number,
' return value has 16 bits (zeros & ones)
Function toBIN_WORD(ByRef iNum As Integer) As String
 Dim sHEX As String
 Dim sResult As String
 Dim i As Integer
 Dim Size As Integer
 
 sHEX = Hex(iNum)
 Size = Len(sHEX)
 
 sResult = ""
 
 For i = Size To 1 Step -1
 sResult = HEX_2_BIN(Mid(sHEX, i, 1)) & sResult
 Next i
 
 toBIN_WORD = make_min_len(sResult, 16, "0")
 
End Function
' returns BINARY presentation of a number,
' return value has 8 bits (zeros & ones)
Function toBIN_BYTE(ByRef bNum As Byte) As String
 Dim sHEX As String
 Dim sResult As String
 Dim i As Integer
 Dim Size As Integer
 
 sHEX = Hex(bNum)
 Size = Len(sHEX)
 
 sResult = ""
 
 For i = Size To 1 Step -1
 sResult = HEX_2_BIN(Mid(sHEX, i, 1)) & sResult
 Next i
 
 toBIN_BYTE = make_min_len(sResult, 8, "0")
 
End Function
' converts single HEX digit to BINARY:
Function HEX_2_BIN(ByRef sHEX_DIGIT As String) As String
 Select Case UCase(sHEX_DIGIT)
 
 Case "0"
 HEX_2_BIN = "0000"
 Case "1"
 HEX_2_BIN = "0001"
 
 Case "2"
 HEX_2_BIN = "0010"
 Case "3"
 HEX_2_BIN = "0011"
 Case "4"
 HEX_2_BIN = "0100"
 Case "5"
 HEX_2_BIN = "0101"
 Case "6"
 HEX_2_BIN = "0110"
 Case "7"
 HEX_2_BIN = "0111"
 Case "8"
 HEX_2_BIN = "1000"
 Case "9"
 HEX_2_BIN = "1001"
 Case "A"
 HEX_2_BIN = "1010"
 Case "B"
 HEX_2_BIN = "1011"
 Case "C"
 HEX_2_BIN = "1100"
 Case "D"
 HEX_2_BIN = "1101"
 Case "E"
 HEX_2_BIN = "1110"
 Case "F"
 HEX_2_BIN = "1111"
 
 Case "h", "H" ' ignore (suffix).
 HEX_2_BIN = ""
 
 Case Else
 Debug.Print "wrong argument in HEX_2_BIN(" & sHEX_DIGIT & ")"
 End Select
End Function
Function make_min_len(s As String, minLen As Integer, sAddWhat As String) As String
 Dim i As Integer
 Dim sRes As String
 
 i = 0
 sRes = s
 
 While Len(sRes) < minLen
 sRes = sAddWhat & sRes
 Wend
 
 make_min_len = sRes
 
End Function
Original Comments (3)
Recovered from Wayback Machine