大数进制转换问题!

一如当初 2004-10-31 10:52:21
Dim a As Double
a = 40567893482
msgbox Hex(a)

这样执行hex函数时会溢出,因为编程需要,我要得到它的16进制

不知道有什么办法得到?给代码看看
...全文
143 6 打赏 收藏 转发到动态 举报
写回复
用AI写文章
6 条回复
切换为时间正序
请发表友善的回复…
发表回复
51365133 2004-11-01
  • 打赏
  • 举报
回复
Dim s As String
Dim n, f As Double
Private Sub Command1_Click()
n = Val(Text1.Text)
While n > 15
f = n \ 16
n = (n - f * 16)
Nfa (f)
Wend
Nfa (n)
Text2.Text = s
End Sub

Public Function Nfa(m As Double)
Select Case Int(m)
Case 10:
s = s + "a"
Case 11:
s = s + "b"
Case 12:
s = s + "c"
Case 13:
s = s + "d"
Case 14:
s = s + "e"
Case 15:
s = s + "f"
Case Else
s = s + Trim(Str(m))
End Select
End Function
aijie099 2004-10-31
  • 打赏
  • 举报
回复
我觉得,把一个大数分开成二部分然后,变成字符串,拼就行了。
如何分开,只要知道这个数用十六进制表示是如何算的。
northwolves 2004-10-31
  • 打赏
  • 举报
回复
Private Sub Command2_Click()
Dim a As Double, X As String
a = 40567893482#
X = Hex(Int(a / 16 ^ 6)) & Right("000000" & Hex(a - Int(a / 16 ^ 6) * 16 ^ 6), 6)
MsgBox X
End Sub
northwolves 2004-10-31
  • 打赏
  • 举报
回复
Private Sub Command1_Click()
Dim a As Double, x As String
a = 40567893482#
Do While a > 10000
x = Hex(Val(Right(a, 4)) Mod 16) & x
a = Int(a / 16)
Loop
x = Hex(a) & x
MsgBox x
End Sub
CityhunterID 2004-10-31
  • 打赏
  • 举报
回复
算法是对的。只是个人觉得过于复杂。
aohan 2004-10-31
  • 打赏
  • 举报
回复
转发
Function Bin2Hex(InputData As String) As String
Dim I As Integer
Dim LenBin As Integer
Dim JOne As String
Dim NumBlocks As Integer
Dim FullBin As String
Dim HexOut As String
Dim TempBinBlock As String
Dim TempHex As String

LenBin = Len(InputData)

For I = 1 To LenBin
JOne = Mid(InputData, I, 1)
If JOne <> "0" And JOne <> "1" Then
MsgBox "NOT A BINARY NUMBER", vbCritical
Exit Function
End If
Next I

FullBin = InputData

If LenBin < 4 Then
If LenBin = 3 Then
FullBin = "0" + FullBin
ElseIf LenBin = 2 Then
FullBin = "00" + FullBin
ElseIf LenBin = 1 Then
FullBin = "000" + FullBin
ElseIf LenBin = 0 Then
MsgBox "Nothing Given..", vbCritical
Exit Function
End If
NumBlocks = 1
GoTo DoBlocks
End If


If LenBin = 4 Then
NumBlocks = 1
GoTo DoBlocks
End If



If LenBin > 4 Then

Dim TempHold As Currency
Dim TempDiv As Currency
Dim AfterDot As Integer
Dim Pos As Integer

TempHold = Len(InputData)
TempDiv = (TempHold / 4)

Pos = InStr(1, CStr(TempDiv), ".")

If Pos = 0 Then

NumBlocks = TempDiv
GoTo DoBlocks
End If

AfterDot = Mid(CStr(TempDiv), (Pos + 1))

If AfterDot = 25 Then
FullBin = "000" + FullBin
NumBlocks = (Len(FullBin) / 4)
ElseIf AfterDot = 5 Then
FullBin = "00" + FullBin
NumBlocks = (Len(FullBin) / 4)
ElseIf AfterDot = 75 Then
FullBin = "0" + FullBin
NumBlocks = (Len(FullBin) / 4)
Else
MsgBox "Big Time Screw up happened, WAHHHHHHHHHHH", vbInformation
Exit Function
End If


GoTo DoBlocks
End If


DoBlocks:

HexOut = ""


For I = 1 To Len(FullBin) Step 4
TempBinBlock = Mid(FullBin, I, 4)

If TempBinBlock = "0000" Then
HexOut = HexOut + "0"
ElseIf TempBinBlock = "0001" Then
HexOut = HexOut + "1"
ElseIf TempBinBlock = "0010" Then
HexOut = HexOut + "2"
ElseIf TempBinBlock = "0011" Then
HexOut = HexOut + "3"
ElseIf TempBinBlock = "0100" Then
HexOut = HexOut + "4"
ElseIf TempBinBlock = "0101" Then
HexOut = HexOut + "5"
ElseIf TempBinBlock = "0110" Then
HexOut = HexOut + "6"
ElseIf TempBinBlock = "0111" Then
HexOut = HexOut + "7"
ElseIf TempBinBlock = "1000" Then
HexOut = HexOut + "8"
ElseIf TempBinBlock = "1001" Then
HexOut = HexOut + "9"
ElseIf TempBinBlock = "1010" Then
HexOut = HexOut + "A"
ElseIf TempBinBlock = "1011" Then
HexOut = HexOut + "B"
ElseIf TempBinBlock = "1100" Then
HexOut = HexOut + "C"
ElseIf TempBinBlock = "1101" Then
HexOut = HexOut + "D"
ElseIf TempBinBlock = "1110" Then
HexOut = HexOut + "E"
ElseIf TempBinBlock = "1111" Then
HexOut = HexOut + "F"
End If

Next I


Bin2Hex = HexOut

eds:
End Function

调用
Private Sub cmdbin2hex_Click()
txthex.Text = Bin2Hex(txtbinary.Text)
End Sub

7,759

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧