Program conversi bilangan ASCII ini dibuat menggunakan VB 6.0

Masukkan 4 buah textbox, 5 buah label, 1 buah frame, 1 buah commandbutton

kemudian ketikkan source code berikut :

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

binary_value = UCase$(Trim$(binary_value))
If Left$(binary_value, 2) = “&B” Then binary_value = Mid$(binary_value, 3)

binary_value = Replace(binary_value, ” “, “”)

binary_value = Right$(String(32, “0”) & binary_value, 32)
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 Command1_Click()
Dim s As Integer
s = MsgBox(“Ingin keluar?”, vbQuestion + vbYesNo, “Copyright by Rofiq Harun”)
If s = vbYes Then
Unload Me
End If
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

About these ads