VB中有没有十六进制到二进制的转换命令???是什么?

dtaps 2003-03-26 12:06:22
VB中有没有十六进制到二进制的转换命令???是什么?
...全文
568 8 打赏 收藏 转发到动态 举报
写回复
用AI写文章
8 条回复
切换为时间正序
请发表友善的回复…
发表回复
northwolves 2003-03-26
  • 打赏
  • 举报
回复 1
Function hextoBin(ByVal X As String) As String
Const Bins = "0000000100100011010001010110011110001001101010111100110111101111"
Dim i As Integer, s As String
hextoBin = ""
For i = 1 To Len(X)
hextoBin = hextoBin & Mid(Bins, (Val("&h" + Mid(X, i, 1)) * 4 + 1), 4)
Next
hextoBin = Format(hextoBin, "0")
End Function
cngxylyh 2003-03-26
  • 打赏
  • 举报
回复
按位转换就可以了。
cngxylyh 2003-03-26
  • 打赏
  • 举报
回复
dim a as byte
十六进制可以直接化成二进制啊。
0---0
1---1
2---10
3---11
....
A---1010
B---1011
C---1100
D---1101
E---1110
F---1111
scyangd 2003-03-26
  • 打赏
  • 举报
回复
好像没有,这需要你自己实现或者调用API。

关注!
pcwak 2003-03-26
  • 打赏
  • 举报
回复
上面那个是十六转二
这个是二转十六


Function Hex2Bin(InputData As String) As String


''
''
'' PLEASE NOTE THAT THIS FUNCTION DOES
''
'' NOT
''
'' STRIP THE EXTRA ZEROS OFF THE FRONT OF THE
'' BINARY ANSWER.
''


''
'' Converts Hexadecimal to Binary
''
Dim I As Integer
Dim BinOut As String
Dim Lenhex As Integer



'' The length of the input
''
InputData = UCase(InputData)
Lenhex = Len(InputData)


For I = 1 To Lenhex

If IsNumeric(Mid(InputData, I, 1)) Then
''
GoTo NumOk
ElseIf Mid(InputData, I, 1) = "A" Then
GoTo NumOk
ElseIf Mid(InputData, I, 1) = "B" Then
GoTo NumOk
ElseIf Mid(InputData, I, 1) = "C" Then
GoTo NumOk
ElseIf Mid(InputData, I, 1) = "D" Then
GoTo NumOk
ElseIf Mid(InputData, I, 1) = "E" Then
GoTo NumOk
ElseIf Mid(InputData, I, 1) = "F" Then
GoTo NumOk
Else
MsgBox "Number given is not in Hex format", vbCritical
Exit Function
End If

NumOk:
Next I

BinOut = ""


''
'' Convert the Number to Binary
''
For I = 1 To Lenhex

If Mid(InputData, I, 1) = "0" Then
BinOut = BinOut + "0000"
ElseIf Mid(InputData, I, 1) = "1" Then
BinOut = BinOut + "0001"
ElseIf Mid(InputData, I, 1) = "2" Then
BinOut = BinOut + "0010"
ElseIf Mid(InputData, I, 1) = "3" Then
BinOut = BinOut + "0011"
ElseIf Mid(InputData, I, 1) = "4" Then
BinOut = BinOut + "0100"
ElseIf Mid(InputData, I, 1) = "5" Then
BinOut = BinOut + "0101"
ElseIf Mid(InputData, I, 1) = "6" Then
BinOut = BinOut + "0110"
ElseIf Mid(InputData, I, 1) = "7" Then
BinOut = BinOut + "0111"
ElseIf Mid(InputData, I, 1) = "8" Then
BinOut = BinOut + "1000"
ElseIf Mid(InputData, I, 1) = "9" Then
BinOut = BinOut + "1001"
ElseIf Mid(InputData, I, 1) = "A" Then
BinOut = BinOut + "1010"
ElseIf Mid(InputData, I, 1) = "B" Then
BinOut = BinOut + "1011"
ElseIf Mid(InputData, I, 1) = "C" Then
BinOut = BinOut + "1100"
ElseIf Mid(InputData, I, 1) = "D" Then
BinOut = BinOut + "1101"
ElseIf Mid(InputData, I, 1) = "E" Then
BinOut = BinOut + "1110"
ElseIf Mid(InputData, I, 1) = "F" Then
BinOut = BinOut + "1111"
Else
MsgBox "Something is Screwed up, Wahhhhhhhhhhh", vbCritical
End If


Next I



Hex2Bin = BinOut

eds:
End Function

Private Sub cmdhex2bin_Click()
txtbinary2.Text = Hex2Bin(txthex2.Text)
End Sub

pcwak 2003-03-26
  • 打赏
  • 举报
回复
Function Bin2Hex(InputData As String) As String
''
'' Converts Binary to hex
''
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)

''
'' Make sure that it is a Binary Number
''
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

'' Set the Variable to the Binary
''
FullBin = InputData

''
'' If the value is less than 4 in length, build it up.
''
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)

''
'' Works by seeing whats after the deciomal place
''
Pos = InStr(1, CStr(TempDiv), ".")

If Pos = 0 Then
'' Divided by 4 perfectly
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


''
'' The rest will process the now built up number
''
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
lxcc 2003-03-26
  • 打赏
  • 举报
回复
up
Cooly 2003-03-26
  • 打赏
  • 举报
回复
二进制转十六进制4位转1位: 1101001=69h(从右起4位为单位断位,不够四位时,补零)
十六进制转二进制1位转4位: 69h=1101001(拆分字符串6=0110,9=1001,则69h=0110 & 1001=1101001)

7,759

社区成员

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

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