急呀~~~~帮帮忙。关于十进制和十六进制的转换问题

jonahclinton 2004-07-22 12:41:38
现在正做一个东西。按一个按钮可以把输入到文本框的数字(十进制)转换成二进制和十六进制的数显示在另外的文本框里。怎么做呀???我一点头绪也没有。
...全文
448 22 打赏 收藏 转发到动态 举报
写回复
用AI写文章
22 条回复
切换为时间正序
请发表友善的回复…
发表回复
helanshan 2004-07-23
  • 打赏
  • 举报
回复
晕啊。。。我只好不说了,你们多分点。。。
jonahclinton 2004-07-23
  • 打赏
  • 举报
回复
忘了,其他的人也要感谢一下。不过我没那么多的分了。
jonahclinton 2004-07-23
  • 打赏
  • 举报
回复
蓝啤酒,谢谢你了。还有狼哥,还有蔡哥。我有个朋友也姓蔡。
yinweihong 2004-07-22
  • 打赏
  • 举报
回复
模块:
Public Function BinaryToHex(sBinary As String) As String

Dim L As Integer
Dim D As Integer
Dim C As Integer
Dim E As Integer
Dim G As Integer
Dim Tmp As String
Dim I As Integer
Dim Result() As String

On Error Resume Next

If sBinary <> "" Then
L = Len(sBinary)
D = L Mod 4 ' 4个分区
If D = 0 Then '没有余数量
C = L / 4
ReDim Result(C)
For I = 1 To C
E = (C - 1) * 4 '取出4位数
Tmp = Mid(sBinary, E + 1, 4)
If GetHexFromBinary(Tmp) = "" Then Exit For
BinaryToHex = GetHexFromBinary(Tmp) & BinaryToHex
C = C - 1
Next
Else: C = Int(L / 4)
ReDim Result(C)
G = C
G = G + 1
For I = 1 To G 'D为余下位数
If C <> 0 Then
E = (C - 1) * 4
Tmp = Mid(sBinary, E + 1 + D, 4)
If GetHexFromBinary(Tmp) = "" Then Exit For
BinaryToHex = GetHexFromBinary(Tmp) & BinaryToHex
C = C - 1
G = G - 1
ElseIf C = 0 Then
Tmp = Mid(sBinary, 1, D)
BinaryToHex = GetHexFromBinary(Tmp) & BinaryToHex
C = C - 1
G = G - 1
End If
Next
End If
Else: BinaryToHex = ""
End If

End Function

Public Function HexToBinary(sHex As String) As String

On Error Resume Next

If sHex <> "" Then
L = Len(sHex)
For I = 1 To L
A = Mid(sHex, I, 1)
If A <= "9" And A >= "0" Or A <= "f" And A >= "a" Or A <= "F" And A >= "A" Then
Select Case A
Case "0": HexToBinary = HexToBinary + "0000"
Case "1": HexToBinary = HexToBinary + "0001"
Case "2": HexToBinary = HexToBinary + "0010"
Case "3": HexToBinary = HexToBinary + "0011"
Case "4": HexToBinary = HexToBinary + "0100"
Case "5": HexToBinary = HexToBinary + "0101"
Case "6": HexToBinary = HexToBinary + "0110"
Case "7": HexToBinary = HexToBinary + "0111"
Case "8": HexToBinary = HexToBinary + "1000"
Case "9": HexToBinary = HexToBinary + "1001"
Case "a", "A": HexToBinary = HexToBinary + "1010"
Case "b", "B": HexToBinary = HexToBinary + "1011"
Case "c", "C": HexToBinary = HexToBinary + "1100"
Case "d", "D": HexToBinary = HexToBinary + "1101"
Case "e", "E": HexToBinary = HexToBinary + "1110"
Case "f", "F": HexToBinary = HexToBinary + "1111"
Case Else: HexToBinary = ""
End Select
Else: HexToBinary = ""
End If
Next
Else: HexToBinary = ""
End If

End Function

Public Function BinaryToDecimal(sBinary As String) As Long

Dim L As Long
Dim C As Long
Dim Tmp1 As Long
Dim A As Long
Dim J As Integer

On Error Resume Next

If sBinary <> "" Then
BinaryToDecimal = "0"
L = Len(sBinary)
For I = 1 To L
Tmp1 = 1
A = 0
C = Mid(sBinary, I, 1)
If C = "1" Or C = "0" Then
If Int(C) <> 0 Then
For J = 1 To L - I
Tmp1 = Tmp1 * 2
Next
A = A + Tmp1
End If
Else: BinaryToDecimal = ""
Exit For
End If
BinaryToDecimal = BinaryToDecimal + A
Next
Else: BinaryToDecimal = ""
End If

End Function

Public Function DecimalToBinary(sDecimal As String) As String

Dim A As Long
Dim C As Long
Dim I As Integer
Dim R As Long

On Error Resume Next

If sDecimal <> "" Then
A = sDecimal
L = Len(sDecimal)
If A <> 0 Then
For I = 1 To L
C = Mid(sDecimal, I, 1)
If C >= "0" And C <= "9" Then
Do While A '直至除净
R = A Mod 2
A = A \ 2
DecimalToBinary = R & DecimalToBinary
Loop
Else: DecimalToBinary = ""
Exit Function
End If
Next
Else: DecimalToBinary = A
End If
Else: DecimalToBinary = ""
End If

End Function

Public Function DecimalToHex(sDecimal As String) As String

Dim A As Long
Dim I As Long
Dim R As String
Dim L As Long

On Error Resume Next

If sDecimal <> "" Then
A = sDecimal
L = Len(sDecimal)
If A <> 0 Then
For I = 1 To L
C = Mid(sDecimal, I, 1)
If C >= "0" And C <= "9" Then
Do While A
R = A Mod 16
A = A \ 16
Select Case R '求余数
Case 0: R = "0"
Case 1: R = "1"
Case 2: R = "2"
Case 3: R = "3"
Case 4: R = "4"
Case 5: R = "5"
Case 6: R = "6"
Case 7: R = "7"
Case 8: R = "8"
Case 9: R = "9"
Case 10: R = "A"
Case 11: R = "B"
Case 12: R = "C"
Case 13: R = "D"
Case 14: R = "E"
Case 15: R = "F"
End Select
DecimalToHex = R & DecimalToHex
Loop
Else: DecimalToHex = ""
Exit Function
End If
Next
Else: DecimalToHex = A
End If
Else: DecimalToHex = ""
End If

End Function

Public Function HexToDecimal(sHex As String) As Long

Dim L As Long
Dim Tmp1 As String
Dim C As Variant
Dim A As Variant
On Error Resume Next

If sHex <> "" Then
L = Len(sHex)
For I = 1 To L
Tmp1 = 1
A = 0
C = Mid(sHex, I, 1)
Select Case C
Case "0": Tmp1 = 0
Case "1": Tmp1 = 1
Case "2": Tmp1 = 2
Case "3": Tmp1 = 3
Case "4": Tmp1 = 4
Case "5": Tmp1 = 5
Case "6": Tmp1 = 6
Case "7": Tmp1 = 7
Case "8": Tmp1 = 8
Case "9": Tmp1 = 9
Case "a", "A": Tmp1 = 10
Case "b", "B": Tmp1 = 11
Case "c", "C": Tmp1 = 12
Case "d", "D": Tmp1 = 13
Case "e", "E": Tmp1 = 14
Case "f", "F": Tmp1 = 15
End Select
If C <= "9" And C >= "0" Or C <= "f" And C >= "a" Or C <= "F" And C >= "A" Then
If C <> 0 Then
For J = 1 To L - I
Tmp1 = Tmp1 * 16
Next
A = A + Tmp1
End If
Else: HexToDecimal = ""
Exit For
End If
HexToDecimal = HexToDecimal + A
Next
Else: HexToDecimal = ""
End If

End Function

'给出二进制对应的16进制
Private Function GetHexFromBinary(Tmp) As String

On Error Resume Next
Select Case Tmp
Case "0000", "000", "00", "0": GetHexFromBinary = "0"
Case "0001", "001", "01", "1": GetHexFromBinary = "1"
Case "0010", "010", "10": GetHexFromBinary = "2"
Case "0011", "011", "11": GetHexFromBinary = "3"
Case "0100", "100": GetHexFromBinary = "4"
Case "0101", "101": GetHexFromBinary = "5"
Case "0110", "110": GetHexFromBinary = "6"
Case "0111", "111": GetHexFromBinary = "7"
Case "1000": GetHexFromBinary = "8"
Case "1001": GetHexFromBinary = "9"
Case "1010": GetHexFromBinary = "A"
Case "1011": GetHexFromBinary = "B"
Case "1100": GetHexFromBinary = "C"
Case "1101": GetHexFromBinary = "D"
Case "1110": GetHexFromBinary = "E"
Case "1111": GetHexFromBinary = "F"
Case Else: GetHexFromBinary = ""
End Select

End Function

BlueBeer 2004-07-22
  • 打赏
  • 举报
回复
Function ToBin(Num As Long) As String
Do
ToBin = Num Mod 2 & ToBin
Num = Num \ 2
Loop While Num
End Function

Private Sub Command1_Click()
Text2 = ToBin(Val(Text1))
End Sub
jonahclinton 2004-07-22
  • 打赏
  • 举报
回复
我晕了
jonahclinton 2004-07-22
  • 打赏
  • 举报
回复
要是把十进制的转换成二进制的怎么弄呀?狼哥,谢谢你了。
Pandona 2004-07-22
  • 打赏
  • 举报
回复
不好意思,没看清楚,贴错了地方
Pandona 2004-07-22
  • 打赏
  • 举报
回复
char *instring;//为你的字符串
char *outstring; //另外的文本框里想显示的字符串



int iTran=0;
iTran=atoi(instring );
out=_itoa( iTran, outstring,radix );//二进制用radix=2十六进制用radix=2;
具体解释查下msdn
jonahclinton 2004-07-22
  • 打赏
  • 举报
回复
那二进制的怎么弄呀?
northwolves 2004-07-22
  • 打赏
  • 举报
回复
text2.text=hex(val(text1.text))
熊孩子开学喽 2004-07-22
  • 打赏
  • 举报
回复
唉,还好我说话给自己留了点余地,楼主,现在我很荣幸地告诉你,那10%的可能性来了,
我把上面的程序改成:
Function OutD(TxT As String) As String
Dim I As Long
Dim L As Long
L = Val(TxT)
Do While L > 0
OutD = (L Mod 2) & OutD
L = L \ 2
Loop
End Function
这回一定行了。



楼主,结贴吧,分少狼多啊。
熊孩子开学喽 2004-07-22
  • 打赏
  • 举报
回复

这个简单


十六进制就是:hex(val(text1.text))

二进制,偶写个函数给你吧,直接用就是了:
Function OutD(TxT as String)As String
Dim I as Long
Dim L as Long
L=Val(TXT)
For I=1 to len(Txt)-1
OutD=(L mod 2) & OutD
L=L\2
Next
End Function
没有调试过,不过应该是没有问题的。我有90%的把握。



楼主,结贴吧,抢分的人好多。
BlueBeer 2004-07-22
  • 打赏
  • 举报
回复
10 to 16:
hex(123)
=7B

16 to 10:
val(&H7B)
=123

10 to 2:
Function ToBin(Num As Long) As String
Do
ToBin = Num Mod 2 & ToBin
Num = Num \ 2
Loop While Num
End Function

ToBin(123)
=1111011


2 to 10:
Function ToDec(BinStr As String) As Long
Dim i As Long
For i = 1 To Len(BinStr)
ToDec = ToDec * 2 + CLng(Mid(BinStr, i, 1))
Next i
End Function

ToDec(1111011)
=123


'16 to 2
Function HexToBin(HexStr As String) As String
Dim i As Long
Const tmp As String = "0000000100100011010001010110011110001001101010111100110111101111"
For i = 1 To Len(HexStr)
HexToBin = HexToBin & Mid$(tmp, Val("&H" & Mid$(HexStr, i, 1)) * 4 + 1, 4)
Next i
Dim P1 As Long: P1 = InStr(HexToBin, "1")
If P1 Then HexToBin = Right$(HexToBin, Len(HexToBin) - P1 + 1) Else HexToBin = "0"
End Function


'2 to 16
Function ToHex(BinStr As String) As String
Dim i As Long
BinStr = String$((4 - Len(BinStr) Mod 4) Mod 4, "0") & BinStr
For i = 0 To Len(BinStr) \ 4 - 1
Select Case Mid$(BinStr, i * 4 + 1, 4)
Case "0000": ToHex = ToHex & "0"
Case "0001": ToHex = ToHex & "1"
Case "0010": ToHex = ToHex & "2"
Case "0011": ToHex = ToHex & "3"
Case "0100": ToHex = ToHex & "4"
Case "0101": ToHex = ToHex & "5"
Case "0110": ToHex = ToHex & "6"
Case "0111": ToHex = ToHex & "7"
Case "1000": ToHex = ToHex & "8"
Case "1001": ToHex = ToHex & "9"
Case "1010": ToHex = ToHex & "A"
Case "1011": ToHex = ToHex & "B"
Case "1100": ToHex = ToHex & "C"
Case "1101": ToHex = ToHex & "D"
Case "1110": ToHex = ToHex & "E"
Case "1111": ToHex = ToHex & "F"
End Select
Next i
End Function

Private Sub Command1_Click()
MsgBox HexToBin("7B")
MsgBox ToHex("1111011")
End Sub
jonahclinton 2004-07-22
  • 打赏
  • 举报
回复
那个也太长了,有简单的吗?就像你说的那个十转二的那个函数那样的。
BlueBeer 2004-07-22
  • 打赏
  • 举报
回复
看上面给你的FAQ,二进制十进制十六进制之间你爱怎么转就怎么转
northwolves 2004-07-22
  • 打赏
  • 举报
回复
Private Sub Command1_Click()
MsgBox dectobin(32767)
MsgBox bintodec("11111111")
End Sub
Function dectobin(ByVal dec As Long) As String '十进制到二进制
Dim i As Integer
dectobin = Oct(dec)
For i = 0 To 7
dectobin = Replace(dectobin, i, Choose(i + 1, "000", "001", "010", "011", "100", "101", "110", "111"))
Next
Mid(dectobin, 1, 2) = Val(Mid(dectobin, 1, 2))
End Function

Function bintodec(ByVal bin As String) As String '二进制到十进制
Dim i As Long, temp As New Collection
For i = 0 To 7
temp.Add i, Choose(i + 1, "000", "001", "010", "011", "100", "101", "110", "111")
Next
bin = Choose(Len(bin) Mod 3 + 1, "", "00", "0") & bin
For i = 1 To Len(bin) Step 3
bintodec = bintodec & temp(Mid(bin, i, 3))
Next
bintodec = CDec("&O" & bintodec)
End Function
落伍者 2004-07-22
  • 打赏
  • 举报
回复
哈哈,
十进制转二进制很多书上都有。
给个思路,先转十六,再将十六转二进制。

如:
strHex=hex(val(text1.text))
text2.text=""
for i=1 to len(strHex)
select case mid(strhex,i,1)
case "1"
Text2.text =Text2.text & "0001"
case "2"
Text2.text=Text2.text & "0010"
.....
case "F"
Text2.text=Text2.text & "1111"
end select
next i


jonahclinton 2004-07-22
  • 打赏
  • 举报
回复
收到,有十六进制的吗?还有,二进制和十六进制怎么转回去呀?
BlueBeer 2004-07-22
  • 打赏
  • 举报
回复
如果要转换的数字超出long的范围,请看FAQ
http://community.csdn.net/Expert/FAQ/FAQ_Index.asp?id=195169
加载更多回复(2)

7,762

社区成员

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

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