[A] Convert decimal value to binary
This code can be used to convert
values to binary format (bits:
zeros and ones).
Original Author: coder86
Code
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
Loading Comments ...
Comments
No comments have been added for this post.
You must be logged in to make a comment.