回 帖 发 新 帖 刷新版面

主题:[原创]正负整数和小数任意进制转换以及求补码的函数源代码

本函数可转换2-36进制的正负整数和小数,也可用于求补码。函数返回的是相应的字符串,且每4位之间以逗号分隔(10进制除外)。函数有4个输入参数:

Num:字符型,输入的数据
No1:整形,输入数据的进制
No2:整形,输出数据的进制
retain:整形,可选,当输出数据为小数时,要保留的小数位数。默认为8。

例1:把10进制的-31转换为2进制:A$ = BaseChange("-31", 10, 2) = 1110,0001
例2:把36进制的164.4MJR,G9ZZ转换为10进制:A& = BaseChange("164.4MJR,G9ZZ", 36, 10) = 1516.12851
例3:把10进制的0.22转换为2进制:A$ = BaseChange("0.22", 10, 2, 5) = 0.0011,1
例4:把10进制的-0.22转换为2进制:A$ = BaseChange("-0.22", 10, 2) = 1111,1111.1100,0111
例5:把2进制的有符号数10011111转换为10进制:A$ = BaseChange("-11111", 2, 10) = -97
例6:把8进制100转换为16进制:A$ = BaseChange("100", 8, 16) = 40
例7:求10进制-31的10进制补码:A$ = BaseChange("-31", 10, 10) = -97

  说明:
1.负数转换前要先求出其补码,再转换补码,所以转换后得到的是有符号数,如例4的结果的整数部分1111,1111,它表示-127,而不是255。
2.例5的输入数据最高位=1表示这是个负数,在调用本函数时,请将最高位的1去掉,改为-。
3.本函数根据数值的大小而不是根据变量类型来确定机器字长。比如255,它可以是字节型的(8位),也可以是整形的(16位),还可以是长整形的(32位),这样转换以后的结果也是不相同的,为了简单起见,本函数作为8位字节型处理。

  代码如下:

Private Function BaseChange(Num As String, No1 As Integer, No2 As Integer, Optional ByVal retain As Integer = 8) As String
On Error GoTo Err1
Dim A As Double, B As Double, Dat1 As Double, Dat2 As Double
Dim t1 As String, t2 As String, t3 As String
Dim k As Integer, i As Integer, L As Integer
Dim bj1 As Boolean '小数标记
Dim bj2 As Boolean '负数标记

If No1 < 2 Or No1 > 36 Or No2 < 2 Or No2 > 36 Then Exit Function
t1 = Num: If Left(t1, 1) = "-" Then bj2 = True: t1 = Mid(t1, 2) '如果是负数
t1 = UCase(Replace(t1, ",", ""))

'检查输入数据
t2 = "."
For i = 48 To 57: t2 = t2 & Chr(i): Next
For i = 65 To 90: t2 = t2 & Chr(i): Next
t2 = Left(t2, No1 + 1)
For i = 1 To Len(t1)
  If InStr(t2, Mid(t1, i, 1)) = 0 Then MsgBox "输入数据错误": Exit Function
Next
t2 = "": k = InStr(t1, ".")

Select Case k
  Case 0
  Case 1: t2 = Mid(t1, 2): t1 = "": bj1 = True '纯小数
  Case Len(t1): t1 = Left(t1, k - 1)           '纯整数
  Case Else: t2 = Mid(t1, k + 1): t1 = Left(t1, k - 1): bj1 = True '小数
End Select

If No1 = 10 Then                      '如果输入的是10进制
  If Len(t1) Then Dat1 = Val(t1)
  If Len(t2) Then Dat2 = Val("." & t2)
Else                                  '其它进制转换为10进制
  If Len(t1) Then GoSub 100: Dat1 = B
  If Len(t2) Then GoSub 200: Dat2 = Round(B, retain)
End If

If No2 = 10 Then                      '如果输出的是10进制
  If bj2 Then                         '如果输入的是负数,求补码
    If Dat1 < 129 Then
      Dat1 = Dat1 - 128
    ElseIf Dat1 < 32769 Then
      Dat1 = Dat1 - 32768
    ElseIf Dat1 < 2147483649# Then
      Dat1 = Dat1 - 2147483649#
    End If
  End If
  BaseChange = Dat1 + Dat2
Else
  If bj2 Then                         '如果输入的是负数,求补码
    If bj1 Then Dat1 = Dat1 + 1: Dat2 = 1 - Dat2 '求小数部分的补码
    If Dat1 < 129 Then                           '求整数部分的补码
      Dat1 = IIf(Dat1 = 0, 128, 256 - Dat1)
    ElseIf Dat1 < 32769 Then
      Dat1 = 65536 - Dat1
    ElseIf Dat1 < 2147483649# Then
      Dat1 = 4294967296# - Dat1
    End If
  End If
  GoSub 300
  If Dat2 Then GoSub 400
  BaseChange = t1 & t2
End If

Err1:
Exit Function

100 '整数部分转换为10进制
L = Len(t1)
For i = 0 To L - 1
  t3 = Mid(t1, L - i, 1)
  A = Asc(t3) - 48: If A > 9 Then A = A - 7
  B = B + A * No1 ^ i
Next
Return

200 '小数部分转换为10进制
L = Len(t2): B = 0
For i = 1 To L
  t3 = Mid(t2, i, 1)
  A = Asc(t3) - 48: If A > 9 Then A = A - 7
  B = B + A / No1 ^ i
Next
Return

300 '整数部分转换为其它进制
k = 0: t1 = ""
Do
  B = Int(Dat1 / No2): A = Dat1 - B * No2: Dat1 = B
  t1 = Chr(A + IIf(A > 9, 55, 48)) & t1
  k = k + 1: If Dat1 > 0 And (k Mod 4 = 0) Then t1 = "," & t1
Loop While Dat1 > 0
Return

400 '小数部分转换为其它进制
k = 0: t2 = IIf(t1 = "", "0.", ".")
Do
  A = Fix(No2 * Dat2): Dat2 = No2 * Dat2 - A
  If k > 0 And (k Mod 4 = 0) Then t2 = t2 & ","
  t2 = t2 & Chr(A + IIf(A > 9, 55, 48))
  k = k + 1
Loop Until Dat2 = 0 Or k = retain '保留小数位
Return
End Function

回复列表 (共1个回复)

沙发

非常感谢!

我来回复

您尚未登录,请登录后再回复。点此登录或注册