Konversi Angka

Topik sebelumnya Topik selanjutnya Go down

Konversi Angka

Post by PujanggaBageur on Mon Sep 01, 2008 10:01 pm

Ini contoh cara mengkonversi basis bilangan.


Kode pada module:

Code:
Option Explicit
'
Function DesimalKeBinear$(Nilai&)
    Dim Nilai2 As Long
    Dim Hasil As String
    Dim LHasil As Integer
    Dim i As Integer
    Do Until Nilai = 0
        Nilai2 = Nilai Mod 2
        Nilai = Nilai \ 2
        Hasil = Hasil & CStr(Nilai2)
    Loop
    LHasil = Len(Hasil)
    For i = 0 To LHasil - 1
        DesimalKeBinear$ = DesimalKeBinear$ & _
        Mid(Hasil, LHasil - i, 1)
    Next
End Function
'
Function DesimalKeHexa$(Nilai&)
    Dim Nilai2 As Long
    Dim NilaiHexa As String
    Dim Hasil As String
    Dim LHasil As Integer
    Dim i As Integer
    Do Until Nilai = 0
        Nilai2 = Nilai Mod 16
        Nilai = Nilai \ 16
        Select Case Nilai2
            Case 10: NilaiHexa = "A"
            Case 11: NilaiHexa = "B"
            Case 12: NilaiHexa = "C"
            Case 13: NilaiHexa = "D"
            Case 14: NilaiHexa = "E"
            Case 15: NilaiHexa = "F"
            Case Else: NilaiHexa = CStr(Nilai2)
        End Select
        Hasil = Hasil & NilaiHexa
    Loop
    LHasil = Len(Hasil)
    For i = 0 To LHasil - 1
        DesimalKeHexa$ = DesimalKeHexa$ & Mid(Hasil, LHasil - i, 1)
    Next
    DesimalKeHexa$ = "&H" & DesimalKeHexa$
End Function
'
Function BinearKeDesimal&(Nilai$)
    Dim LNilai As Integer
    Dim i As Integer
    Dim j As Integer
    Dim Hasil As Long
    LNilai = Len(Nilai$)
   
    For i = 1 To LNilai
        Hasil = Hasil + CLng(Mid(Nilai, i, 1)) * _
                (2 ^ (LNilai - i))
        '1--> 1 * 2 ^ 6
        '2--> 1 * 2 ^ 5
        '3--> 0 * 2 ^ 4
        '4--> 0 * 2 ^ 3
        '5--> 1 * 2 ^ 2
        '6--> 0 * 2 ^ 1
        '7--> 0 * 2 ^ 0
    Next
    '
    BinearKeDesimal& = Hasil
End Function
'
Function HexaKeDesimal&(Nilai$)
    Dim Nilai2 As String
    Dim NilaiDes As Integer
    Dim Hasil As Long
    Dim LNilai As Integer
    Dim i As Integer
    LNilai = Len(Nilai)
    For i = 3 To LNilai
        Nilai2 = Mid(Nilai, i, 1)
        Select Case UCase(Nilai2)
            Case "A": NilaiDes = 10
            Case "B": NilaiDes = 11
            Case "C": NilaiDes = 12
            Case "D": NilaiDes = 13
            Case "E": NilaiDes = 14
            Case "F": NilaiDes = 15
            Case Else: NilaiDes = CInt(Nilai2)
        End Select
        Hasil = Hasil + (NilaiDes * (16 ^ (LNilai - i)))
    Next
    HexaKeDesimal& = Hasil
End Function

Kode di form:

Code:
Option Explicit

Private Sub cmdBinearKeDes_Click()
    Me.txtHasil.Text = BinearKeDesimal(Me.txtNilai.Text)
End Sub
'
Private Sub cmdDesKeBinear_Click()
    Me.txtHasil.Text = DesimalKeBinear(Me.txtNilai.Text)
End Sub
'
Private Sub cmdDesKeHexa_Click()
    Me.txtHasil.Text = DesimalKeHexa(Me.txtNilai.Text)
End Sub
'
Private Sub cmdHexaKeDes_Click()
    Me.txtHasil.Text = HexaKeDesimal(Me.txtNilai.Text)
End Sub
'
Private Sub cmdBinearKeHexa_Click()
    Dim nDesimal As Long
    nDesimal = BinearKeDesimal(Me.txtNilai.Text)
    Me.txtHasil.Text = DesimalKeHexa(nDesimal)
End Sub
'
Private Sub cmdHexaKeBinear_Click()
    Dim nDesimal As Long
    nDesimal = HexaKeDesimal(Me.txtNilai.Text)
    Me.txtHasil.Text = DesimalKeBinear(nDesimal)
End Sub
'


Form nya seperti ini:

Code:
VERSION 5.00
Begin VB.Form Form1
  BackColor      =  &H00C0C0C0&
  BorderStyle    =  3  'Fixed Dialog
  Caption        =  "INOCHI - KONVERTER"
  ClientHeight    =  3045
  ClientLeft      =  45
  ClientTop      =  435
  ClientWidth    =  6960
  BeginProperty Font
      Name            =  "Times New Roman"
      Size            =  12
      Charset        =  0
      Weight          =  700
      Underline      =  0  'False
      Italic          =  0  'False
      Strikethrough  =  0  'False
  EndProperty
  Icon            =  "Form1.frx":0000
  LinkTopic      =  "Form1"
  MaxButton      =  0  'False
  MinButton      =  0  'False
  ScaleHeight    =  3045
  ScaleWidth      =  6960
  StartUpPosition =  2  'CenterScreen
  Begin VB.CommandButton cmdHexaKeBinear
      Caption        =  "&HEXA KE BINEAR"
      Height          =  495
      Left            =  3990
      TabIndex        =  9
      Top            =  2460
      Width          =  2865
  End
  Begin VB.CommandButton cmdBinearKeHexa
      Caption        =  "B&INEAR KE HEXA"
      Height          =  495
      Left            =  3990
      TabIndex        =  8
      Top            =  1980
      Width          =  2865
  End
  Begin VB.CommandButton cmdHexaKeDes
      Caption        =  "H&EXA KE DESIMAL"
      Height          =  495
      Left            =  3990
      TabIndex        =  7
      Top            =  1500
      Width          =  2865
  End
  Begin VB.CommandButton cmdBinearKeDes
      Caption        =  "&BINEAR KE DESIMAL"
      Height          =  495
      Left            =  3990
      TabIndex        =  6
      Top            =  1020
      Width          =  2865
  End
  Begin VB.CommandButton cmdDesKeHexa
      Caption        =  "D&ESIMAL KE HEXA"
      Height          =  495
      Left            =  3990
      TabIndex        =  5
      Top            =  540
      Width          =  2865
  End
  Begin VB.CommandButton cmdDesKeBinear
      Caption        =  "&DESIMAL KE BINEAR"
      Height          =  495
      Left            =  3990
      TabIndex        =  4
      Top            =  60
      Width          =  2865
  End
  Begin VB.TextBox txtHasil
      Alignment      =  1  'Right Justify
      BorderStyle    =  0  'None
      Height          =  285
      Left            =  180
      Locked          =  -1  'True
      TabIndex        =  3
      Top            =  1800
      Width          =  3555
  End
  Begin VB.TextBox txtNilai
      Alignment      =  1  'Right Justify
      BorderStyle    =  0  'None
      Height          =  285
      Left            =  180
      TabIndex        =  1
      Text            =  "240982"
      Top            =  990
      Width          =  3555
  End
  Begin VB.Label Label1
      AutoSize        =  -1  'True
      BackStyle      =  0  'Transparent
      Caption        =  "NILAI HASIL"
      Height          =  285
      Index          =  1
      Left            =  180
      TabIndex        =  2
      Top            =  1470
      Width          =  1455
  End
  Begin VB.Label Label1
      AutoSize        =  -1  'True
      BackStyle      =  0  'Transparent
      Caption        =  "NILAI &MASUKAN"
      Height          =  285
      Index          =  0
      Left            =  180
      TabIndex        =  0
      Top            =  660
      Width          =  1965
  End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Tempelkan baris kode di atas pada Notepad, Save-As jadi "Form1.frm" (Save As Type = All Files)


_________________
Tidak ada yang menarik, datang kemudian hilang, pergi tak kembali.

PujanggaBageur
Admin
Admin

Jumlah posting : 148
Join date : 07.08.08
Age : 34
Lokasi : Cirebon

Lihat profil user http://inochi.forumotion.net

Kembali Ke Atas Go down

Topik sebelumnya Topik selanjutnya Kembali Ke Atas

- Similar topics

 
Permissions in this forum:
Anda tidak dapat menjawab topik