大数进制转换问题!

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

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

不知道有什么办法得到?给代码看看
...全文
143 3 打赏 收藏 转发到动态 举报
写回复
用AI写文章
3 条回复
切换为时间正序
请发表友善的回复…
发表回复
lzlyh 2004-11-01
  • 打赏
  • 举报
回复
试试这样行不行
Dim a As Double
a = 40567893482
msgbox MyHex(a)
private function MyHex(a as double)
dim strNum as string
strNum=""
do while a<>0
n=a mod 16
if a<10 then strnum=strnum & chr(a+asc("0")) else strnum=strnum & chr(a+asc("A"))
a=int(a/16)
loop
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
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

741

社区成员

发帖
与我相关
我的任务
社区描述
VB 版八卦、闲侃,联络感情地盘,禁广告帖、作业帖
社区管理员
  • 非技术类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

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