分享
 
 
 

关于天文数字十进制与十六进制间的转换

王朝vb·作者佚名  2006-01-09
窄屏简体版  字體: |||超大  

对于一般的整型数字,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

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有