算法共享：十进制与二进制的转换问题

[BlueBeer]

在FAQ里看到下面这张十进制转二进制的例子
http://expert.csdn.net/Expert/FAQ/FAQ_Index.asp?id=187068
觉得算法上不够科学
其实只要知道二进制写法与十进制数字的关系，你会发现解决这个问题是非常简单的事情

看下面这个函数：
Public Function ToBinary(Num As Long) As String
Do
ToBinary = Num Mod 2 & ToBinary
Num = Num \ 2
Loop While Num
End Function

原理是这样的（以十进制10为例）：
10 整除 2 等于 5 余数 0
5 整除 2 等于 2 余数 1
2 整除 2 等于 1 余数 0
1 整除 2 等于 0 余数 1
余数为零时停止运算 倒过来 ↑
十进制数字10的二进制写法即为1010

VB中同样没有提供二进制到十进制的转换函数
知道了上面的原理，逆向运算就行了
Public Function ToDecimal(BinStr As String) As Long
Dim i As Long
For i = 1 To Len(BinStr)
ToDecimal = ToDecimal * 2 + Val(Mid(BinStr, i, 1))
Next i
End Function

希望对你有帮助

[BitBlt]

什么不够科学，他的方法比你的快多了。

你的方法从看起来代码少，但不是最快的。
要知道电脑跟人的思想是不一样的。
用8进制作为中介也可，算法如下：

Function DectoBin(X As Long) As String
Const Bins = "000001010011100101110111"
Dim i As Integer, s As String, y As String
s = vbNullString
y = Oct(X)
For i = 1 To Len(y)
s = s & Mid(Bins, (Val("&O" + Mid(y, i, 1)) * 3 + 1), 3)
Next
DectoBin = Format(s, "0")
End Function

[BlueBeer]

楼上的，也许吧，反正我不懂行~

感谢赐教~

[BlueBeer]

不好意思，还要多说两句

首先声明，我并没想过与二位一较高下
如果真的要较高下的话，我一定是下，呵呵
对你们来讲，VB可能是种工具，更可能是吃饭的家伙，但对我来说VB只是自己喜欢玩的一种玩具，我不靠它吃饭，也没能力靠它吃饭，如果有幸能用它写出两个程序来给自己用，我已经很开心了，我根本就不是程序员，也根本不是做程序员的料，来CSDN只是因为我喜欢VB，只是因为在这里可以请教别人以及帮助别人

我不知道你“他的方法比你的快多了”这个结论是怎么得来的，总归一定有你的原因
我也想试一下是不是他的更快些，所以用了一个很极端的例子，9个9，即999999999

Debug.Print DectoBin(999999999)
Debug.Print ToBinary(999999999)

倒没试出哪个更快来，当然也没试出哪个更慢
只是很偶然的，通过这个测试发现了一个小问题

运行结果如下：
111011100110101000000000000000
111011100110101100100111111111
然后我用系统的计算机算了一下，我的函数返回的是正确的

再用ToDecimal逆向运算
Debug.Print ToDecimal(DectoBin(999999999))
Debug.Print ToDecimal(ToBinary(999999999))

运行结果如下：
999981056
999999999

还是那句话，我并不想和你们一较高下，请别自乏身价

[BitBlt]

请你不要生气，我这就测试一下。请等。

[BlueBeer]

呵呵，我一点都不生气，我的理解是你听我说他的算法不够科学所以你生气了：）
但愿大家都理解错了：）

[BitBlt]

Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long

Function DectoBin8(X As Long) As String
Const Bins = "000001010011100101110111"
Dim i As Long, s As String, y As String
y = Oct(X)
s = Mid$(Bins, (CLng("&O" & Left$(y, 1)) * 3 + 1), 3)
s = Mid(s, InStr(s, "1"))
For i = 2 To Len(y)
s = s & Mid$(Bins, (CLng("&O" & Mid$(y, i, 1)) * 3 + 1), 3)
Next
DectoBin8 = s
End Function

Function DectoBin(X As Long) As String
Const Bins = "0000000100100011010001010110011110001001101010111100110111101111"
Dim i As Long, s As String, y As String
y = Hex$(X)
s = Mid$(Bins, (CLng("&H" & Left$(y, 1)) * 4 + 1), 4)
s = Mid(s, InStr(s, "1"))
For i = 2 To Len(y)
s = s & Mid$(Bins, (CLng("&H" & Mid$(y, i, 1)) * 4 + 1), 4)
Next
DectoBin = s
End Function

Public Function ToBinary(Num As Long) As String
Do
ToBinary = Num Mod 2 & ToBinary
Num = Num \ 2
Loop While Num
End Function

Private Sub Form_click()
Dim a As String, i As Long, t As Long

t = GetTickCount
For i = 1 To 100000
a = DectoBin(999999999)
Next
t = GetTickCount - t
Debug.Print a
Debug.Print t

t = GetTickCount
For i = 1 To 100000
a = DectoBin8(999999999)
Next
t = GetTickCount - t
Debug.Print a
Debug.Print t

t = GetTickCount
For i = 1 To 100000
a = ToBinary(999999999)
Next
t = GetTickCount - t
Debug.Print a
Debug.Print t

End Sub


111011100110101100100111111111
3009
111011100110101100100111111111
3761
111011100110101100100111111111
4536

[BitBlt]

呵呵，你不生气就好。

//我的理解是你听我说他的算法不够科学所以你生气了：）

没有的事。我又不认识他。。。。

速度确实有差别的。以上代码，表明你的代码用的时间用16进制的1.5倍。

[BitBlt]

至于我的算法先前的错误，是format出问题了。

你试试format("111011100110101100100111111111",0)是多少，
我试的是111011100110101000000000000000。奇怪。
我用format是为了去掉最前面的0，我以前测试时数字没这么长，也没见过这种情况。

就你的话，我还想说两句。
//我不知道你“他的方法比你的快多了”这个结论是怎么得来的，总归一定有你的原因
确实有原因的，字符串操作是比较慢的，而你的代码的字符穿操作比他的多。
快多了不至于，快一点还是有的。
//如果真的要较高下的话，我一定是下
为什么，我是刚升两个角的，我刚来几天，我也是"业余"的
//请别自乏身价
这更不沾边了，我门是在讨论技术问题，也都不是高手，犯错误也是难免，何来身价问题？

我从一开始就心平气和的说话，你却总想找碴。何必呢？

[homeland520]

哈哈 ！和气生财！哈哈哈！
来学习一下！继续讨论研究！
严重关注

[BlueBeer]

回复人： BitBlt(Raster Operater)
//你却总想找碴

？？？？？？？
果然是都理解错了：）

没有的事，自己写的代码，当然想看看别人的比自己的高明在什么地方，当然会试试你的代码，至于发现你代码的问题，前面说过了，纯属巧合，我是想弄个大些的数来以便看出我的代码是不是真的会慢一些，巧了，你的代码正好在那个数字上出错：）

关于速度测试的问题，我还要感谢你呢，我都不知道怎么测的，我只是用了一个timer从0加起，看最后得到几，得到数字小的那个就快一些，结果没比出来
回头我会试试你的代码的，顺便学习一下像这种情况怎么测试两段代码的执行速度

总之，我对你没有敌意，好像你也是，SO，大家都是朋友：）

[BlueBeer]

非常感谢！
我还学习了一个函数GetTickCount：）
甚至我在常用的API工具里都没有查到的，好在这个函数用法很简单：）

你的代码显示，我的函数的确比你们的慢一些，谢谢赐教：）

以后还请继续发扬：）

[BitBlt]

好个和气生财！

GetTickCount

VB声明
Declare Function GetTickCount Lib "kernel32" Alias "GetTickCount" () As Long
说明
用于获取自windows启动以来经历的时间长度（毫秒）
返回值
Long，以毫秒为单位的windows运行时间

[BlueBeer]

再次感谢：）

散分中，请来捧场 ^o^

http://expert.csdn.net/Expert/TopicView1.asp?id=3029120

[LGYAN]

哎，这些是计算机最基本的原理啊

[recollectpainer]

好习惯

[mylzw]

你们为什么不把小数的转换考虑在内？

[sssss342072]

ding!
UP TO YOU!!!!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

[dongge2000]

Private Sub Command1_Click()
If IsNumeric(TxtIn.Text) Then
TxtOut(0).Caption = Hex(TxtIn.Text)
TxtOut(1).Caption = Oct(TxtIn.Text)

TxtOut(2).Caption = ""
Dim y(1 To 30) As String
Dim i As Integer
For i = 1 To Len(TxtOut(1).Caption)
y(i) = Mid(TxtOut(1).Caption, i, 1)

Select Case y(i)
Case 0: y(i) = "000"
Case 1: y(i) = "001"
Case 2: y(i) = "010"
Case 3: y(i) = "011"
Case 4: y(i) = "100"
Case 5: y(i) = "101"
Case 6: y(i) = "110"
Case 7: y(i) = "111"
End Select
TxtOut(2).Caption = TxtOut(2).Caption + y(i)
Next i
If Len(TxtOut(2).Caption) > 15 Then
TxtOut(2).Caption = CCur(Left(TxtOut(2).Caption, 14)) & Mid(TxtOut(2).Caption, 15)
Else
TxtOut(2).Caption = CCur(TxtOut(2).Caption)
End If

TxtOut(3).Caption = CDbl(TxtIn.Text)
TxtOut(4).Caption = CSng(TxtIn.Text)
TxtIn.SetFocus
Else
TxtIn.Text = "输入的不是数字"
TxtIn.SetFocus
End If
End Sub

[熊孩子开学喽]

顶吧，大家都写了那么多，俺就不写了，看看热闹拿拿分！