[教学]VB编程序实现十进制数转换成2、8、16进制数

[教学]VB编程序实现十进制数转换成2、8、16进制数 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