Minggu, 20 Maret 2016

Konversi Bilangan

Baiklah kali ini kita akan membuat program aplikasi konversi bilangan dengan visual basic, yg pertama kali ialah kita harus membuat flow chart input outputnya seperti di bawah ini:



setelah itu buka alpikasi visual basic dan buat form aplikasi konversi bilangan seperti dibawah ini:


kemudian buatlah statement program seperti ini:

Option Explicit On

Public Class Form1
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        If ComboBox1.SelectedItem = "Bin" And ComboBox2.SelectedItem = "Dec" Then Output.Text = BinToDes(Input.Text)
        If ComboBox1.SelectedItem = "Bin" And ComboBox2.SelectedItem = "Bin" Then Output.Text = Input.Text
        If ComboBox1.SelectedItem = "Bin" And ComboBox2.SelectedItem = "Oct" Then Output.Text = BinToOk(Input.Text)
        If ComboBox1.SelectedItem = "Bin" And ComboBox2.SelectedItem = "Hex" Then Output.Text = BinToHex(Input.Text)
        If ComboBox1.SelectedItem = "Dec" And ComboBox2.SelectedItem = "Bin" Then Output.Text = DesToBin(Input.Text)
        If ComboBox1.SelectedItem = "Dec" And ComboBox2.SelectedItem = "Dec" Then Output.Text = Input.Text
        If ComboBox1.SelectedItem = "Dec" And ComboBox2.SelectedItem = "Oct" Then Output.Text = DesToOk(Input.Text)
        If ComboBox1.SelectedItem = "Dec" And ComboBox2.SelectedItem = "Hex" Then Output.Text = DesToHex(Input.Text)
        If ComboBox1.SelectedItem = "Oct" And ComboBox2.SelectedItem = "Bin" Then Output.Text = OkToBin(Input.Text)
        If ComboBox1.SelectedItem = "Oct" And ComboBox2.SelectedItem = "Hex" Then Output.Text = OkToHex(Input.Text)
        If ComboBox1.SelectedItem = "Oct" And ComboBox2.SelectedItem = "Dec" Then Output.Text = OkToDes(Input.Text)
        If ComboBox1.SelectedItem = "Oct" And ComboBox2.SelectedItem = "Oct" Then Output.Text = Input.Text
        If ComboBox1.SelectedItem = "Hex" And ComboBox2.SelectedItem = "Bin" Then Output.Text = HexToBin(Input.Text)
        If ComboBox1.SelectedItem = "Hex" And ComboBox2.SelectedItem = "Dec" Then Output.Text = HexToDes(Input.Text)
        If ComboBox1.SelectedItem = "Hex" And ComboBox2.SelectedItem = "Oct" Then Output.Text = HexToOk(Input.Text)
        If ComboBox1.SelectedItem = "Hex" And ComboBox2.SelectedItem = "Hex" Then Output.Text = Input.Text


        With Input.SelectionStart = (0)
            Input.SelectionLength = Len(Input.Text)
        End With
    End Sub

Private Sub Input_TextChanged(sender As Object, e As EventArgs) Handles Input.TextChanged
        Dim UpperCase As String
        UpperCase = UCase(Input.Text)
        Input.Text = UpperCase
    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
            Select Case Mid(NBiner, A, 1)
                Case 0 To 1
                    If Mid(NBiner, A, 1) = "1" Then Nilai = Nilai + B
                    B = B * 2
                Case Else
                    MsgBox("Please input binary", vbCritical)
            End Select
        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 Long
        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
        End While
        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
                    If (Mid(NHexa, E, 1) = "A" Or Mid(NHexa, E, 1) = "B" Or Mid(NHexa, E, 1) = "C" Or Mid(NHexa, E, 1) = "D" Or Mid(NHexa, E, 1) = "E" Or Mid(NHexa, E, 1) = "F") Then
                        CharNilai = Asc(Mid(NHexa, E, 1)) - 55
                    Else
                        MsgBox("Please input 0 to 9, A to F", vbCritical, vbOKOnly)
                    End If
            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
            Select Case Mid(NOktal, G, 1)
                Case "0" To "7"
                    Nilai = Nilai + (8 ^ H) * CInt(Mid(NOktal, G, 1))
                    H = H + 1
                Case Else
                    MsgBox("Please input 0 to 7", vbCritical, vbOKOnly)
            End Select
        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 Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
        Input.Text = ""
        Output.Text = ""
    End Sub

Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
        End
    End Sub
End Class


selamat mencoba....