Program konversi bilangan ASCII

Ingin berbagi program konversi lainnya setelah sebelumnya memposting program konversi. Program ini tetap menggunakan VB 6.0 dalam membuatnya.

Program ini terdiri dari 10 optionbutton, 2 textbox, 3 buah commandbutton, 2 buah frame.
Kemudian rancanglah formnya seperti contoh di atas. Masukkan source codenya :

Option Explicit

Public Function BinToDes(ByVal NBiner As String) As Long
Dim a         As Integer
Dim b         As Long
Dim Nilai    As Long
On Error GoTo ErrorHandler
b = 1
For a = Len(NBiner) To 1 Step -1
If Mid(NBiner, a, 1) = “1” Then Nilai = Nilai + b
b = b * 2
Next
BinToDes = Nilai
Exit Function
ErrorHandler:
BinToDes = 0
End Function

Public Function DesToBin(ByVal NDesimal As Long) As String
Dim c        As Byte
Dim d        As Long
Dim Nilai    As String
On Error GoTo ErrorHandler
d = (2 ^ 31) – 1
While d > 0
If NDesimal – d >= 0 Then
NDesimal = NDesimal – d
Nilai = Nilai & “1”
Else
If Val(Nilai) > 0 Then Nilai = Nilai & “0”
End If
d = d / 2
Wend
DesToBin = Nilai
Exit Function
ErrorHandler:
DesToBin = 0
End Function

Public Function DesToHex(ByVal NDesimal As Long) As String
DesToHex = Hex(NDesimal)
End Function

Public Function HexToDes(ByVal NHexa As String) As Long
Dim e         As Integer
Dim Nilai     As Long
Dim F         As Long
Dim CharNilai As Byte
On Error GoTo ErrorHandler
For e = Len(NHexa) To 1 Step -1
Select Case Mid(NHexa, e, 1)
Case “0” To “9”: CharNilai = CInt(Mid(NHexa, e, 1))
Case Else: CharNilai = Asc(Mid(NHexa, e, 1)) – 55
End Select
Nilai = Nilai + ((16 ^ F) * CharNilai)
F = F + 1
Next e
HexToDes = Nilai
Exit Function
ErrorHandler:
HexToDes = 0
End Function
Public Function DesToOk(ByVal NDesimal As Long) As String
DesToOk = Oct(NDesimal)
End Function

Public Function OkToDes(ByVal Noktal As String) As Long
Dim G          As Integer
Dim H          As Long
Dim Nilai      As Long
On Error GoTo ErrorHandler
For G = Len(Noktal) To 1 Step -1
Nilai = Nilai + (8 ^ H) * CInt(Mid(Noktal, G, 1))
H = H + 1
Next G
OkToDes = Nilai
Exit Function
ErrorHandler:
OkToDes = 0
End Function

Public Function BinToOk(ByVal bin As Long) As String
BinToOk = DesToOk(BinToDes(bin))
End Function

Public Function BinToHex(ByVal NBiner As Long) As String
BinToHex = DesToHex(BinToDes(NBiner))
End Function

Public Function OkToBin(ByVal Noktal As Double) As String
OkToBin = DesToBin(OkToDes(Noktal))
End Function
Public Function OkToHex(ByVal Noktal As Double) As String
OkToHex = DesToHex(OkToDes(Noktal))
End Function

Public Function HexToBin(ByVal NHexa As String) As String
HexToBin = DesToBin(HexToDes(NHexa))
End Function

Public Function HexToOk(ByVal NHexa As String) As Double
HexToOk = DesToOk(HexToDes(NHexa))
End Function

Private Sub Command1_Click()
If Option2.Value And Option5.Value Then Text2.Text = BinToDes(Text1.Text)
If Option2.Value And Option6.Value Then Text2.Text = Text1.Text
If Option2.Value And Option7.Value Then Text2.Text = BinToOk(Text1.Text)
If Option2.Value And Option8.Value Then Text2.Text = BinToHex(Text1.Text)
If Option2.Value And Option10.Value Then Text2.Text = BinTochar(Text1.Text)
If Option1.Value And Option6.Value Then Text2.Text = DesToBin(Text1.Text)
If Option1.Value And Option5.Value Then Text2.Text = Text1.Text
If Option1.Value And Option7.Value Then Text2.Text = DesToOk(Text1.Text)
If Option1.Value And Option8.Value Then Text2.Text = DesToHex(Text1.Text)
If Option1.Value And Option10.Value Then Text2.Text = DesToChar(Text1.Text)
If Option3.Value And Option6.Value Then Text2.Text = OkToBin(Text1.Text)
If Option3.Value And Option8.Value Then Text2.Text = OkToHex(Text1.Text)
If Option3.Value And Option5.Value Then Text2.Text = OkToDes(Text1.Text)
If Option3.Value And Option7.Value Then Text2.Text = Text1.Text
If Option3.Value And Option10.Value Then Text2.Text = OkTochar(Text1.Text)
If Option4.Value And Option6.Value Then Text2.Text = HexToBin(Text1.Text)
If Option4.Value And Option5.Value Then Text2.Text = HexToDes(Text1.Text)
If Option4.Value And Option7.Value Then Text2.Text = HexToOk(Text1.Text)
If Option4.Value And Option8.Value Then Text2.Text = Text1.Text
If Option4.Value And Option10.Value Then Text2.Text = hextochar(Text1.Text)
If Option9.Value And Option10.Value Then Text2.Text = Text1.Text
If Option9.Value And Option5.Value Then Text2.Text = CharToDes(Text1.Text)
If Option9.Value And Option6.Value Then Text2.Text = CharToBin(Text1.Text)
If Option9.Value And Option7.Value Then Text2.Text = CharToOk(Text1.Text)
If Option9.Value And Option8.Value Then Text2.Text = Chartohex(Text1.Text)

With Text1
.SelStart = 0
.SelLength = Len(Text1.Text)
End With
End Sub

Private Sub Command2_Click()
Text1.Text = “”
Text2.Text = “”
Text1.SetFocus
End Sub

Private Sub Command3_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 Form_Load()
Move (Screen.Width – Me.Width) / 2, (Screen.Height – Me.Height) / 2
Text1.Text = “”
Text2.Text = “”
End Sub

Private Function Chartohex(kata As String) As String
Chartohex = “”
Dim a As String
Dim b As String
Dim I         As Integer
For I = 1 To Len(kata)
a = Mid(kata, I, 1)
b = Hex(Asc(a))
Chartohex = Chartohex & b
Next I
End Function

Public Function CharToBin(ByVal NHexa As String) As String
CharToBin = HexToBin(Chartohex(NHexa))
End Function

Public Function CharToOk(ByVal NHexa As String) As String
CharToOk = HexToOk(Chartohex(NHexa))
End Function

Public Function CharToDes(ByVal NHexa As String) As String
CharToDes = HexToDes(Chartohex(NHexa))
End Function

Public Function hextochar(ab As String)
hextochar = “”
Dim c As String
Dim d As Integer
Dim e As String
Dim I As Integer
For I = 1 To Len(ab) Step 2
c = Mid(ab, I, 2)
d = (hextodec(Left(c, 1)) * 16) + (hextodec(Right(c, 1)))
e = Chr(d)
hextochar = hextochar & e
Next I
End Function

Public Function hextodec(hx As String) As Integer
If hx = “0” Then hextodec = 0
If hx = “1” Then hextodec = 1
If hx = “2” Then hextodec = 2
If hx = “3” Then hextodec = 3
If hx = “4” Then hextodec = 4
If hx = “5” Then hextodec = 5
If hx = “6” Then hextodec = 6
If hx = “7” Then hextodec = 7
If hx = “8” Then hextodec = 8
If hx = “9” Then hextodec = 9
If hx = “A” Then hextodec = 10
If hx = “B” Then hextodec = 11
If hx = “C” Then hextodec = 12
If hx = “D” Then hextodec = 13
If hx = “E” Then hextodec = 14
If hx = “F” Then hextodec = 15
If hx = “a” Then hextodec = 10
If hx = “b” Then hextodec = 11
If hx = “c” Then hextodec = 12
If hx = “d” Then hextodec = 13
If hx = “e” Then hextodec = 14
If hx = “f” Then hextodec = 15
End Function

Public Function BinTochar(ByVal NBiner As Long) As String
BinTochar = hextochar(BinToHex(NBiner))
End Function
Public Function OkTochar(ByVal Noktal As Double) As String
OkTochar = hextochar(OkToHex(Noktal))
End Function
Public Function DesToChar(ByVal NDesimal As Long) As String
DesToChar = BinTochar(DesToBin(NDesimal))
End Function