Vucko, mozda ti ovo pomogne. Nisam siguran od kuda mi je ovaj kod (bilo je davno)
ali radi. Na formu postavi četiri TextBox-a: txtDecimal, txtHexadecimal, txtOctal, txtBinary
Javi ako je pomoglo. Pozdrav
Code:
Option Explicit
Private m_IgnoreEvents As Boolean
' Convert this binary value into a Long.
Private Function BinaryToLong(ByVal binary_value As String) As Long
Dim hex_result As String
Dim nibble_num As Integer
Dim nibble_value As Integer
Dim factor As Integer
Dim bit As Integer
' Remove any leading &B if present.
' (Note: &B is not a standard prefix, it just
' makes some sense.)
binary_value = UCase$(Trim$(binary_value))
If Left$(binary_value, 2) = "&B" Then binary_value = Mid$(binary_value, 3)
' Strip out spaces in case the bytes are separated
' by spaces.
binary_value = Replace(binary_value, " ", "")
' Left pad with zeros so we have a full 32 bits.
binary_value = Right$(String(32, "0") & binary_value, 32)
' Read the bits in nibbles from right to left.
' (A nibble is half a byte. No kidding!)
For nibble_num = 7 To 0 Step -1
' Convert this nibble into a hexadecimal string.
factor = 1
nibble_value = 0
' Read the nibble's bits from right to left.
For bit = 3 To 0 Step -1
If Mid$(binary_value, 1 + nibble_num * 4 + bit, 1) = "1" Then
nibble_value = nibble_value + factor
End If
factor = factor * 2
Next bit
' Add the nibble's value to the left of the
' result hex string.
hex_result = Hex$(nibble_value) & hex_result
Next nibble_num
' Convert the result string into a long.
BinaryToLong = CLng("&H" & hex_result)
End Function
' Convert this Long value into a binary string.
Private Function LongToBinary(ByVal long_value As Long, Optional ByVal separate_bytes As Boolean = True) As String
Dim hex_string As String
Dim digit_num As Integer
Dim digit_value As Integer
Dim nibble_string As String
Dim result_string As String
Dim factor As Integer
Dim bit As Integer
' Convert into hex.
hex_string = Hex$(long_value)
' Zero-pad to a full 8 characters.
hex_string = Right$(String$(8, "0") & hex_string, 8)
' Read the hexadecimal digits
' one at a time from right to left.
For digit_num = 8 To 1 Step -1
' Convert this hexadecimal digit into a
' binary nibble.
digit_value = CLng("&H" & Mid$(hex_string, digit_num, 1))
' Convert the value into bits.
factor = 1
nibble_string = ""
For bit = 3 To 0 Step -1
If digit_value And factor Then
nibble_string = "1" & nibble_string
Else
nibble_string = "0" & nibble_string
End If
factor = factor * 2
Next bit
' Add the nibble's string to the left of the
' result string.
result_string = nibble_string & result_string
Next digit_num
' Add spaces between bytes if desired.
If separate_bytes Then
result_string = _
Mid$(result_string, 1, 8) & " " & _
Mid$(result_string, 9, 8) & " " & _
Mid$(result_string, 17, 8) & " " & _
Mid$(result_string, 25, 8)
End If
' Return the result.
LongToBinary = result_string
End Function
' Display the value in the indicated control in
' the other controls.
Private Sub DisplayValue(ByVal source As TextBox)
Dim txt As String
Dim value As Long
' Don't recurse.
If m_IgnoreEvents Then Exit Sub
m_IgnoreEvents = True
' Get the value.
On Error Resume Next
Select Case source.Name
Case "txtDecimal"
value = CLng(source.Text)
Case "txtHexadecimal"
txt = UCase$(Trim$(source.Text))
If Left$(txt, 2) <> "&H" Then txt = "&H" & txt
value = CLng(txt)
Case "txtOctal"
txt = UCase$(Trim$(source.Text))
If Left$(txt, 2) <> "&O" Then txt = "&O" & txt
value = CLng(txt)
Case "txtBinary"
value = BinaryToLong(source.Text)
End Select
On Error GoTo 0
' Display the value in different formats.
If source.Name <> "txtDecimal" Then
txtDecimal.Text = Format$(value)
End If
If source.Name <> "txtHexadecimal" Then
txtHexadecimal.Text = "&H" & Hex$(value)
End If
If source.Name <> "txtOctal" Then
txtOctal.Text = "&O" & Oct$(value)
End If
If source.Name <> "txtBinary" Then
txtBinary.Text = LongToBinary(value)
End If
m_IgnoreEvents = False
End Sub
Private Sub txtBinary_Change()
DisplayValue txtBinary
End Sub
Private Sub txtDecimal_Change()
DisplayValue txtDecimal
End Sub
Private Sub txtHexadecimal_Change()
DisplayValue txtHexadecimal
End Sub
Private Sub txtOctal_Change()
DisplayValue txtOctal
End Sub