Konversi Bilangan

Option Explicit

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 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 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 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

  With Text1

    .SelStart = 0

    .SelLength = Len(Text1.Text)

  End With

End Sub

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

End Function

Private Sub Command2_Click()

Text1.Text = ""

Text2.Text = ""

Text1.SetFocus

End Sub

Private Sub Command3_Click()

Unload Me

End Sub