VB程序设计:将十进制整数转换为其他进制

Question

如题所述

Answer 1

您好，这样的：
VB编程序实现十进制数转换成2、8、16进制数 十进制转二进制
Public Function DECtoBIN(Dec As Long) As String
DECtoBIN = ""
Do While Dec > 0
DECtoBIN = Dec Mod 2 & DECtoBIN
Dec = Dec \ 2
Loop
End Function

十进制转八进制：
VB自带函数：Oct(num)

十进制转十六进制：
VB自带函数：hex(num)

转换成十六进制 Hex()
如：10（十进制）:Hex(10)=A
转换成8进制Oct()
如：10（十进制）:Oct(10)=12
转换成2进制，使用下面的方法
'采用连除2取余数，将一个十进制数转换为二进制数
Dim Dec As Integer '输入一个十进制数
Dim Bin As String '转换为二进制表示
Dim res As Integer
Dim i As Integer
Dec = Val(InputBox("x="))
Form1.Print "十进制数："; Dec
Do
res = Dec Mod 2 '求出除以2的余数
Bin = res & Bin
Dec = Dec \ 2
Loop While Dec <> 0
Form1.Print "转换为二进制数为："; Bin

Private Sub Command1_Click()
Print bin(Text1.Text)
End Sub

Function bin(n As Long) As String
Do Until n = 0
bin = (n Mod 2) & bin
n = n \ 2
Loop
End Function

十六进制：Hex(number)或使用&H前缀
八进制：Oct(number)或使用&O前缀

二、八、十六进制转为十进制：
参数sdate为要进行转换的数，stype为此数的类型。
如要将十六进制的"7b"转为十进制: msgbox OtherToShi("7b",16)

Private Function OtherToShi(ByVal Sdate As String, ByVal Stype As Long) As String
Dim A As String, K As Long, P As Long

If trim(sdate)="" then msgbox "请输入要转换的数！" :Exit function
On Error GoTo Exitsub
P = Len(Sdate)
Select Case Stype
Case 2
For K = 1 To P
If Mid(Sdate, K, 1) > 1 Then GoTo Exitsub
Next
Case 8
If IsNumeric(Sdate) = False Then GoTo Exitsub
Sdate = Round(Sdate)
p=len(sdate)
Case 16
For K = 1 To P
A = Asc(LCase(Mid(Sdate, K, 1)))
If A < 48 Or (A > 49 And A < 97) Or A > 102 Then GoTo Exitsub Next
Case Else '按你说的操作,此句好象可免
MsgBox "指定转换的类型不正确，请重新输入！": Exit Function End Select

K = 0
Do While K < P
K = K + 1
A = Mid(Sdate, K, 1)
If Stype = 16 Then
Select Case LCase(A)
Case "a"
A = "10"
Case "b"
A = "11"
Case "c"
A = "12"
Case "d"
A = "13"
Case "e"
A = "14"
Case "f"
A = "15"
End Select
End If
OtherToShi = LTrim(Str(Val(OtherToShi) + Val(A) * Stype ^ (P - K)))
Loop

Exit Function
Exitsub:
MsgBox "要转化为" & Stype & "进制的数据不合法,请重新输入！"
End Function

'十进制转为二、八、十六进制:
'用法与上类似

Private Function ShiToOther(ByVal Sdate As String, ByVal Stype As Long) As String
Dim S As String

If trim(sdate)="" then msgbox "请输入要转换的数！" :Exit function
If IsNumeric(Sdate) = False Then GoTo Exitsub'要转换的对象非数值型,跳出不执行 On Error GoTo Exitsub
Sdate = Round(Val(Sdate)) '进行四舍五入
Do While Sdate > 0
S = LTrim(Str(Sdate Mod Stype))
If Stype = 16 Then
Select Case S
Case "10"
S = "A"
Case "11"
S = "B"
Case "12"
S = "C"
Case "13"
S = "D"
Case "14"
S = "E"
Case "15"
S = "F"
End Select
End If

ShiToOther = S & ShiToOther
Sdate = Sdate \ Stype
Loop

Exit Function
Exitsub:
MsgBox "要转换的数据非十进制数据,请重新输入" End Function。

Answer 2

将十进制转化为十六进制
' 输入：Dec(十进制数)
' 输入数据类型：Long
' 输出：DEC_to_HEX(十六进制数)
' 输出数据类型：String
' 输入的最大数为2147483647,输出最大数为7FFFFFFF
Public Function DEC_to_HEX(Dec As Long) As String
Dim a As String
DEC_to_HEX = ""
Do While Dec > 0
a = CStr(Dec Mod 16)
Select Case a
Case "10": a = "A"
Case "11": a = "B"
Case "12": a = "C"
Case "13": a = "D"
Case "14": a = "E"
Case "15": a = "F"
End Select
DEC_to_HEX = a & DEC_to_HEX
Dec = Dec \ 16
Loop
End Function

将十进制转化为八进制
' 输入：Dec(十进制数)
' 输入数据类型：Long
' 输出：DEC_to_OCT(八进制数)
' 输出数据类型：String
' 输入的最大数为2147483647,输出最大数为17777777777
Public Function DEC_to_OCT(Dec As Long) As String
DEC_to_OCT = ""
Do While Dec > 0
DEC_to_OCT = Dec Mod 8 & DEC_to_OCT
Dec = Dec \ 8
Loop
End Function

将十进制转化为二进制
' 输入：Dec(十进制数)
' 输入数据类型：Long
' 输出：DEC_to_BIN(二进制数)
' 输出数据类型：String
' 输入的最大数为2147483647,输出最大数为1111111111111111111111111111111(31个1)
Public Function DEC_to_BIN(Dec As Long) As String
DEC_to_BIN = ""
Do While Dec > 0
DEC_to_BIN = Dec Mod 2 & DEC_to_BIN
Dec = Dec \ 2
Loop
End Function
望采纳。。。。