对于一般的整型数字,16进制与10进制 间的转化可以用CLNG(),HEX()函数解决,但遇上天文数字,这些函数就无能为力了。下面是笔者写的几个函数,演示了天文数字计算中的一些技巧。
Dim largehex As String, largedec As String, start As Long, Y(20) As String
''''预备函数 Function sums(ByVal X As String, ByVal Y As String) As String '''' sum of two hugehexnum(两个大数之和) Dim max As Long, temp As Long, I As Long, result As Variant max = IIf(Len(X) >= Len(Y), Len(X), Len(Y)) X = Right(String(max, "0") & X, max) Y = Right(String(max, "0") & Y, max) ReDim result(0 To max) For I = max To 1 Step -1 result(I) = Val(Mid(X, I, 1)) + Val(Mid(Y, I, 1)) Next For I = max To 1 Step -1 temp = result(I) \ 10 result(I) = result(I) Mod 10 result(I - 1) = result(I - 1) + temp Next If result(0) = 0 Then result(0) = "" sums = Join(result, "") Erase result
End Function
Function multi(ByVal X As String, ByVal Y As String) As String ''''multi of two huge hexnum(两个大数之积) Dim result As Variant Dim xl As Long, yl As Long, temp As Long, I As Long xl = Len(Trim(X)) yl = Len(Trim(Y)) ReDim result(1 To xl + yl) For I = 1 To xl For temp = 1 To yl result(I + temp) = result(I + temp) + Val(Mid(X, I, 1)) * Val(Mid(Y, temp, 1)) Next Next
For I = xl + yl To 2 Step -1 temp = result(I) \ 10 result(I) = result(I) Mod 10 result(I - 1) = result(I - 1) + temp Next
If result(1) = "0" Then result(1) = "" multi = Join(result, "") Erase result
End Function Function POWERS(ByVal X As Integer) As String '''' GET 16777216^X,ie 16^(6*x)(16777216的X 次方) POWERS = 1 Dim I As Integer For I = 1 To X POWERS = multi(POWERS, CLng(&H1000000)) Next End Function Function half(ByVal X As String) As String ''''get half of x(取半) X = 0 & X Dim I As Long ReDim result(2 To Len(X)) As String For I = 2 To Len(X) result(I) = CStr(Val(Mid(X, I, 1)) \ 2 + IIf(Val(Mid(X, I - 1, 1)) Mod 2 = 1, 5, 0)) Next half = Join(result, "") If Left(half, 1) = "0" Then half = Right(half, Len(half) - 1) '''' no zero ahead End Function
''''另一个有用的函数: Function POWERXY(ByVal X As Integer, ByVal Y As Integer) As String ''''GET X^Y(X 的 Y 次方) Dim I As Integer POWERXY = X For I = 2 To Y POWERXY = multi(POWERXY, X) Next End Function
''''进制转换函数:
''''16 to 10 Function HEXTODEC(ByVal X As String) As String Dim A() As String, I As Long, UNIT As Integer For I = 1 To Len(X) If Not IsNumeric("&h" & Mid(X, I, 1)) Then MsgBox "NOT A HEX FORMAT!", 64, "INFO": Exit Function Next X = String((6 - Len(X) Mod 6) Mod 6, "0") & X
UNIT = Len(X) \ 6 - 1 ReDim A(UNIT) For I = 0 To UNIT A(I) = CLng("&h" & Mid(X, I * 6 + 1, 6)) Next For I = 0 To UNIT A(I) = multi(A(I), POWERS(UNIT - I)) HEXTODEC = sums(HEXTODEC, A(I)) Next End Function
'''' 10 to 16 Function dectohex(ByVal hugenum As String) As String '''' trans hugenum to hex Do While Len(hugenum) > 2 dectohex = Hex(Val(Right(hugenum, 4)) Mod 16) & dectohex For I = 1 To 4 ''''devide hugenum by 16 hugenum = half(hugenum) Next Loop dectohex = Hex(Val(hugenum)) & dectohex End Function
Private Sub Form_Load() For I = 0 To 20 Y(I) = "1234567890ABCDEF" Next
largehex = Join(Y, "") End Sub
''''hextodec Private Sub Command1_Click() start = Timer largedec = HEXTODEC(largehex) Debug.Print largedec MsgBox "hex(" & Len(largehex) & " 位): " & largehex & vbCrLf & vbCrLf & "dec(" & Len(largedec) & " 位): " & largedec, 64, "用时" & Format((Timer - start), "0.0000") & " 秒!" End Sub
''''dectohex Private Sub Command2_Click() largedec = "27305594525408320787401222904174795936368587913861811995606068514338921239280447480038845811151419865392100570221250636783105942723266982313358992551204806603060637911792055430458953651997903849585424629638958641829173494438455892966522070157613386886352421847833413821003678138295449221439062614172249927946884678471687751616589458280098503446100701588657220466765694306218356144887228155732857434394095"
start = Timer largehex = dectohex(largedec) MsgBox "dec(" & Len(largedec) & " 位): " & largedec & vbCrLf & vbCrLf & "hex(" & Len(largehex) & " 位): " & largehex, 64, "用时" & Format((Timer - start), "0.0000") & " 秒!" End Sub
''''get x^y Private Sub Command3_Click() start = Timer MsgBox "2^3000=" & POWERXY(2, 3000), 64, "用时" & Format((Timer - start), "0.0000") & " 秒!" End Sub
没有相关教程
|