Option Explicit&?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /&
'2进制转换为10制数
Public Function BinToDec(bin As String) As Long
Dim i As Long
For i = 1 To Len(bin)
BinToDec = BinToDec * 2 + Val(Mid(bin, i, 1))
End Function
'10进制转换为2制数
Public Function DecToBin(dec As Long) As String
DecToBin = ""
Do While dec & 0
DecToBin = (dec Mod 2) & DecToBin
dec = dec / 2
&?xml:namespace prefix = st1 ns = "urn:schemas-microsoft-com:office:smarttags" /&&place w:st="on"&Loop&/place&
End Function
'16进制数转换为10进制数
Public Function HexToDec(str2 As String) As Long
Dim i As Long, a As Variant, k As Long
For i = Len(str2) - 1 To 0 Step -1
a = Asc(LCase(Mid(str2, Len(str2) - i, 1))) '统一求得各个字符的小写状态下的字符所对应的ASCII值
a = IIf(a &= 48 And a &= 57, a - 48, a - 87)
'0的ASCII码为48，字母a的ASCII码为97,而16进制下的A对应为10进制下的10
'如果a在16进制下为 0 至 9 的数，则-------
'如果a在16进制下为 a 至 f 的数，则-------
k = k + (16 ^ i) * a '累加,就像 ^4+2*10^3+3*10^2+4*10^1+5*1^0
HexToDec = k '得到的这个返回值 K 就是转换后的10进制数
End Function
'10进制转换成16进制数
Public Function DecToHex(X As Long) As String
Dim a As String
Dim r As String
Do While X & 0
r = X Mod 16
X = X / 16
r = IIf(r & 9, Chr(Asc(r - 9) + 16), r)
'如果这里不减9，一旦r为11,12,13,14,15时，就只得到 1 的ASCII码值，得到了一个错误的结果。
&place w:st="on"&&b style="mso-bidi-font-weight: normal"&&span lang="EN-US" style="FONT-SIZE: 14 COLOR: mso-bidi-font-size: 12.0pt"&Loop&/span&&/b&&/place&
DecToHex = a
End Function
'10进制转换为8进制
Public Function DecToOct(dec As Long) As String
DecToOct = ""
Do While dec & 0
DecToOct = (dec Mod 8) & DecToOct
dec = dec / 8
&place w:st="on"&Loop&/place&
End Function
'8进制转换为10进制
Public Function OctToDec(str2 As String) As Long
Dim i As Long, a As Variant, k As Long
For i = Len(str2) - 1 To 0 Step -1
a = Asc(Mid(str2, Len(str2) - i, 1)) '统一求得各个字符的小写状态下的字符所对应的ASCII值
a = a - 48
k = k + (8 ^ i) * a '累加,就像 ^4+2*10^3+3*10^2+4*10^1+5*1^0
OctToDec = k '得到的这个返回值 K 就是转换后的10进制数
End Function
'8进制转换为16进制
Public Function OctToHex(Oct As String) As String
Dim dec As Long
dec = OctToDec(Oct) '8进制转10进制
OctToHex = DecToHex(dec) ' 10进制转16进制
End Function
'8进制转为2进制
Public Function OctToBin(Oct As String) As String
Dim dec As Long
dec = OctToDec(Oct) '8进制转10进制
OctToBin = DecToBin(dec) ' 10进制转2进制
End Function
'16进制转为8进制
Public Function HexToOct(Hex As String) As String
Dim dec As Long
dec = HexToDec(Hex) '16进制转10进制
HexToOct = DecToOct(dec) '10进制转8进制
End Function
'16进制转为2进制
Public Function HexToBin(Hex As String) As String
Dim dec As Long
dec = HexToDec(Hex) '16进制转10进制
HexToBin = DecToBin(dec) '10进制转2进制
End Function
'2进制转化为16进制
Public Function BinToHex(bin As String) As String
Dim dec As Long
dec = BinToDec(bin) '2进制转为10进制
BinToHex = DecToHex(dec) '10进制转为16进制
End Function
'2进制转化为8进制
Public Function BinToOct(bin As String) As String
Dim dec As Long
dec = BinToDec(bin) '2进制转化为10进制
BinToOct = DecToOct(dec) '10进制转化为8进制
End Function
yuanlanxiaup
浏览: 392697 次
不错CAD控件知识，感谢分享[deyi]
楼主，我试着照着你的方法做。开始，除了最后一个在状态栏显示坐标 ...
发我一份 谢谢啊
xglla_ ...
架构不错，多谢群主分享
case只需要4种情况就行了，怎么还搞出8种？
(window.slotbydup=window.slotbydup || []).push({
id: '4773203',
container: s,
size: '200,200',
display: 'inlay-fix'Access俱乐部
?&&&&?&&&&?&&&&?&&&&
您的位置：　 > >
【access源码】字符串递增――二十六进制和十进制的转换
来源:&&点击数:4964&&评论数:2　&|&&|&
时　间: 00:00:00
作　者:&&&ID：10768&&城市：上海
摘　要:网友“胡永炽”提的一个问题，如何实现字符串递增&/bbs/showtopic.asp?id=11526实际上就是类似于Excel中的列序号，从A开始，A、B、C……AA、AB、AC……AAA、AAB、AAC……
网友&胡永炽&提的一个问题，如何实现字符串递增
实际上就是类似于Excel中的列序号，从A开始，A、B、C&&AA、AB、AC&&AAA、AAB、AAC&&
由于字母有26个，因此我们可以将其它视为一个二十六进制的数来处理，由于计算机本身并没有提供二十六进制的计算功能，所以需要先转换为十进制，然后通过十进制进行计算，再将计算结果转换为二十六进制即可。
'将表示二十六进制字符串转换为十进制数值
'红尘如烟&&
Function Hex26To10(Number As String) As Double
&&& Dim intI As Integer
&&& Dim strChar As String
&&& Dim intPos As Integer
&&& Const conStrList = &ABCDEFGHIJKLMNOPQRSTUVWXYZ&
&&& For intI = Len(Number) To 1 Step -1
&&&&&&& strChar = Mid(Number, intI, 1)
&&&&&&& intPos = InStr(1, conStrList, strChar) - 1
&&&&&&& Hex26To10 = Hex26To10 + intPos * 26 ^ (Len(Number) - intI)
End Function
'将十进制数值转换为表示二十六进制的字符串
'红尘如烟&&
Function Hex10To26(Number As Double) As String
&&& Dim dblNum As Double
&&& Const conStrList = &ABCDEFGHIJKLMNOPQRSTUVWXYZ&
&&& dblNum = Number
&&& Do Until dblNum = 0
&&&&&&& Hex10To26 = Hex10To26 & Mid(conStrList, (dblNum Mod 26) + 1, 1)
&&&&&&& dblNum = dblNum \ 26
&&& Hex10To26 = StrReverse(Hex10To26)
End Function
示例： =Hex10To26(Hex26To10(&ZZ&)+1)& '返回 BAA
Access软件网官方交流QQ群 (群号:)
　　　　　　
&&&&【&&】&&&&【&&】&&&&【&&】&&&&【&&】&&&&【&&】
Access网店
价格：￥400 元
价格：￥50 元
价格：￥100 元
(11-11 08:26)
(11-10 15:36)
(11-10 15:10)
(11-09 17:27)
(11-09 17:00)
(11-09 14:06)
(11-09 10:46)
(11-09 02:36)
(11-08 22:28)
(11-08 20:29)
Access软件网 版权所有 CopyRight
提供支持 本站特聘法律顾问: 李慧 律师在VB6中新建一个工程,当前窗体默认为form1,添加一个框架控件frame、几个文本框控件text、几个标签控件label、两个timer计时器、三个按钮控件、添加一个窗体form2、一个模块module1、几个菜单项。然后将form1上的各个控件调至适当位置，并且更改它们的标题属性。注意：那四个文本框为文本框控件数组，分别为text1(0)，text1(1)，text1(2)，text1(3)。
【程 序 设 计】&?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /&
1、实现2、8、10、16进制数之间的相互转换，一共有种&?xml:namespace prefix = v ns = "urn:schemas-microsoft-com:vml" /&&shapetype id="_x0000_t75" stroked="f" filled="f" path="m@4@5l@4@11@9@11@9@5xe" o:preferrelative="t" o:spt="75" coordsize=""&&stroke joinstyle="miter"&&/stroke&&formulas&&f eqn="if lineDrawn pixelLineWidth 0"&&/f&&f eqn="sum @0 1 0"&&/f&&f eqn="sum 0 0 @1"&&/f&&f eqn="prod @2 1 2"&&/f&&f eqn="prod @3 21600 pixelWidth"&&/f&&f eqn="prod @3 21600 pixelHeight"&&/f&&f eqn="sum @0 0 1"&&/f&&f eqn="prod @6 1 2"&&/f&&f eqn="prod @7 21600 pixelWidth"&&/f&&f eqn="sum @8 21600 0"&&/f&&f eqn="prod @7 21600 pixelHeight"&&/f&&f eqn="sum @10 21600 0"&&/f&&/formulas&&path o:connecttype="rect" gradientshapeok="t" o:extrusionok="f"&&/path&&lock aspectratio="t" v:ext="edit"&&/lock&&/shapetype&&shape id="_x" style="WIDTH: 60 HEIGHT: 30.75pt" o:ole="" type="#_x0000_t75"&&imagedata o:title="" src="file:///C:/DOCUME~1/ADMINI~1/LOCALS~1/Temp/msohtml1/03/clip_image001.wmz"&&/imagedata&&/shape&转换方式，即：2---&8，2---&10，2---&16，8---&2，8---&10，8---&16，10---&2，10---&8，10---&16，16---&2，16---&8，16---&10，这样12种转换方式
2、双击模块moduel1，进入代码编辑模式，开始编写这12种转换方式的模块函数。核心代码如下（以逗号开始的为注释内容）：
Option Explicit
'2进制转换为10制数
Public Function BinToDec(bin As String) As Long
Dim i As Long
For i = 1 To Len(bin)
BinToDec = BinToDec * 2 + Val(Mid(bin, i, 1))
End Function
'10进制转换为2制数
Public Function DecToBin(dec As Long) As String
DecToBin = ""
Do While dec & 0
DecToBin = (dec Mod 2) & DecToBin
dec = dec / 2
&?xml:namespace prefix = st1 ns = "urn:schemas-microsoft-com:office:smarttags" /&&place w:st="on"&Loop&/place&
End Function
'16进制数转换为10进制数
Public Function HexToDec(str2 As String) As Long
Dim i As Long, a As Variant, k As Long
For i = Len(str2) - 1 To 0 Step -1
a = Asc(LCase(Mid(str2, Len(str2) - i, 1))) '统一求得各个字符的小写状态下的字符所对应的ASCII值
a = IIf(a &= 48 And a &= 57, a - 48, a - 87)
'0的ASCII码为48，字母a的ASCII码为97,而16进制下的A对应为10进制下的10
'如果a在16进制下为 0 至 9 的数，则-------
'如果a在16进制下为 a 至 f 的数，则-------
k = k + (16 ^ i) * a '累加,就像 ^4+2*10^3+3*10^2+4*10^1+5*1^0
HexToDec = k '得到的这个返回值 K 就是转换后的10进制数
End Function
'10进制转换成16进制数
Public Function DecToHex(X As Long) As String
Dim a As String
Dim r As String
Do While X & 0
r = X Mod 16
X = X / 16
r = IIf(r & 9, Chr(Asc(r - 9) + 16), r)
'如果这里不减9，一旦r为11,12,13,14,15时，就只得到 1 的ASCII码值，得到了一个错误的结果。
&place w:st="on"&&b style="mso-bidi-font-weight: normal"&&span lang="EN-US" style="FONT-SIZE: 14 COLOR: mso-bidi-font-size: 12.0pt"&Loop&/span&&/b&&/place&
DecToHex = a
End Function
'10进制转换为8进制
Public Function DecToOct(dec As Long) As String
DecToOct = ""
Do While dec & 0
DecToOct = (dec Mod 8) & DecToOct
dec = dec / 8
&place w:st="on"&Loop&/place&
End Function
'8进制转换为10进制
Public Function OctToDec(str2 As String) As Long
Dim i As Long, a As Variant, k As Long
For i = Len(str2) - 1 To 0 Step -1
a = Asc(Mid(str2, Len(str2) - i, 1)) '统一求得各个字符的小写状态下的字符所对应的ASCII值
a = a - 48
k = k + (8 ^ i) * a '累加,就像 ^4+2*10^3+3*10^2+4*10^1+5*1^0
OctToDec = k '得到的这个返回值 K 就是转换后的10进制数
End Function
'8进制转换为16进制
Public Function OctToHex(Oct As String) As String
Dim dec As Long
dec = OctToDec(Oct) '8进制转10进制
OctToHex = DecToHex(dec) ' 10进制转16进制
End Function
'8进制转为2进制
Public Function OctToBin(Oct As String) As String
Dim dec As Long
dec = OctToDec(Oct) '8进制转10进制
OctToBin = DecToBin(dec) ' 10进制转2进制
End Function
'16进制转为8进制
Public Function HexToOct(Hex As String) As String
Dim dec As Long
dec = HexToDec(Hex) '16进制转10进制
HexToOct = DecToOct(dec) '10进制转8进制
End Function
'16进制转为2进制
Public Function HexToBin(Hex As String) As String
Dim dec As Long
dec = HexToDec(Hex) '16进制转10进制
HexToBin = DecToBin(dec) '10进制转2进制
End Function
'2进制转化为16进制
Public Function BinToHex(bin As String) As String
Dim dec As Long
dec = BinToDec(bin) '2进制转为10进制
BinToHex = DecToHex(dec) '10进制转为16进制
End Function
'2进制转化为8进制
Public Function BinToOct(bin As String) As String
Dim dec As Long
dec = BinToDec(bin) '2进制转化为10进制
BinToOct = DecToOct(dec) '10进制转化为8进制
End Function
3、如何判断文本框中是否输入了无效的数据，以及如何防止这种行为？
比如：2进制数只能由0和1构成，8制数只能由0、1----7构成，10进制数只能由0、1-------9构成，16进制数只能由0、1------9，a、b-----f、A、B------F构成。
所以我们需要一个keypress事件来控件这种形为，让各自对应的文本框只能按受对应的按键值。text1的keypress事件代码：
Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
Select Case Index '这个文本框为一个控件数组,即依次为text1(0),text1(1),text1(2),text1(3)
Case 0 '第一个文本框,这个文本框只能输入2进进制的数,仅由0,1组成 退格键的ASCII码为8
If Not (KeyAscii &= 48 And KeyAscii &= 49 Or KeyAscii = 8) Then
KeyAscii = 0 ' 取消键的ASCII码为0,即此次输入的无效内容被屏蔽
Case 1 '第二个文本框,这个文本框只能输入8进进制的数,仅由0,1,----7组成
If Not (KeyAscii &= 48 And KeyAscii &= 55 Or KeyAscii = 8) Then
KeyAscii = 0
Case 2 '这个文本框只能输入8进进制的数,仅由0,1,----9组成
If Not (KeyAscii &= 48 And KeyAscii &= 57 Or KeyAscii = 8) Then
KeyAscii = 0
Case 3 '这个文本框只能输入8进进制的数,仅由0,1,----9,a-----f,A-----F组成
If Not (KeyAscii &= 48 And KeyAscii &= 57 Or KeyAscii &= 97 And KeyAscii &= 102 Or KeyAscii &= 65 And KeyAscii &= 70 Or KeyAscii = 8) Then
KeyAscii = 0
End Select
4、当用户点击“开始转换”按钮时，大致会有4种情况：
（1），如果这四个文本框都为空值，则应该能够给出相应的提示信息：不能全部为空值------
（2），如果用户只是在其中一个文本框中输入数据，程序必须自己判断是哪一个文本框，然后调用相应的转换函数来完成转换。
（3），如果用户在这四个文本框中都输入数据，程序应该给出一个对话框，让用户选择到底从哪一种数据开始，转换为其它的三种类型数据。
（4），在转换过程中，如果用户输入的数据过大，或其它某种未知的原因，而造成程序出现错误，程序应该能够给出相应的错误处理机制来响应用户的操作。
Command1的click事件：
Private Sub Command1_Click()
Dim X As Integer, i As Integer, Y As Integer
Dim result '定义后面弹出对话框的处理结果为变体类型
On Error Resume Next '如果出现错误,后面有专门的程序来处理
For i = 0 To 3
If Text1(i) && "" Then
X = i '如果是哪一个文本框中有内容,那么文本框的下标值就给后面的x,并且退出这里的循环
X = 4 '这时所有的文本框都为空
'如果至少有两个文本框有数据,那么下面11行程序就开始工作;否则,程序会路过下面的这11行
For i = 0 To 3
If Text1(i) && "" Then Y = Y + 1
If Y &= 1 Then
CheckValue: X = Val(InputBox("至少两个文本框有数据,你希望从第几个文本框的内容转换为其它数据? 输入:1,2,3,4(你选一个数)", "巍威提示你!", "1", Screen.Width / 2, Screen.Height / 2)) - 1
If Not (X &= 0 And X &= 4) Then
MsgBox "您这次操作不正确,请按照提示来", vbOKOnly, "巍威提示你!"
GoTo CheckValue '程序转至上面的CheckValue标记处 ,把x的值限定在0至4之间
Select Case X
Case 0 ' 这时,第一个文本框不为空,从第一个文本框的内容开始向其它进制数开始转换
Text1(1) = BinToOct(Text1(0)) '2进制转为8进制,并显示出来
Text1(2) = BinToDec(Text1(0)) '2进制转为10进制
Text1(3) = BinToHex(Text1(0)) '2进制转为16进制
Case 1 ' 这时,第一个文本框为空,第二个文本框不为空,从第二个文本框的内容开始向其它进制数开始转换
Text1(0) = OctToBin(Text1(1)) '8进制转为2进制
Text1(2) = OctToDec(Text1(1)) '8进制转为10进制
Text1(3) = OctToHex(Text1(1)) '8进制转为16进制
Case 2 ' 这时,第一/二个文本框都为空,第三个文本框不为空,从第三个文本框的内容开始向其它进制数开始转换
Text1(0) = DecToBin(Text1(2)) '10进制转为2进制
Text1(1) = DecToOct(Text1(2)) '10进制转为8进制
Text1(3) = DecToHex(Text1(2)) '10进制转为16进制
Case 3 '这时,第一/二/三个文本框都为空,第四个文本框不为空,从第四个文本框的内容开始向其它进制数转换
Text1(0) = HexToBin(Text1(3)) '16进制转为2进制
Text1(1) = HexToOct(Text1(3)) '16进制转为8进制
Text1(2) = HexToDec(Text1(3)) '16进制转为10进制
Text1(3) = UCase(Text1(3)) '将本身全部转化为大写状态
MsgBox "不能让所有的文本框为空,请你在任一个文本框中输入相应数据,然后回车", vbOKOnly, "巍威提示你!"
Text1(0).SetFocus '让第一个文本框获取焦点
End Select
Text1(0).SetFocus '让第一个文本框获取焦点
Timer1.Enabled = False '关闭记时器
Label5.Visible = False '隐藏警告标语
'如果出现了错误,
If Err.Number & 0 Then
'弹出一个对话框,告诉用户当前的错误所在
result = MsgBox("很抱歉,你的操作造成了 '" + Err.Description + "'" + vbCrLf + "要清空所有的文本框,重新输入吗?", vbYesNo, "巍威提示你!")
If result = 6 Then ' 如果用户回答"是",则点击清空按钮
Command2.Value = True
Else ' 如果用户回答"否",则启动记时器,显示警告标语,并且转换功能的按钮不可用
Timer1.Enabled = True
Command1.Enabled = False
Exit Sub '退出这个过程
5、至此这个“进制数转换器”大致成型。但是还有很多的细节，也值得你关注，因为作为一个软件，人机交互界面就显得非常重要。例如：把“开始转换”按钮的Default属性为true，当用户直接按Enter键时，就相当于已用鼠标点击了这个按钮；把“退出”按钮的Cancel属性设为true，当用户直接按Esc键时,就相当于已用鼠标点击了这个按钮；在timer2的timer事件中设置 form1.caption=“进制数转换器”+str(now)，并且把timer2的interval设置为1000毫秒，即每秒触发一次，这样,当你运行这个程序时,你就会看到窗体的标题栏显示一个动态的电子时钟
yuanlanxiaup
浏览: 392699 次
不错CAD控件知识，感谢分享[deyi]
楼主，我试着照着你的方法做。开始，除了最后一个在状态栏显示坐标 ...
发我一份 谢谢啊
xglla_ ...
架构不错，多谢群主分享
case只需要4种情况就行了，怎么还搞出8种？
(window.slotbydup=window.slotbydup || []).push({
id: '4773203',
container: s,
size: '200,200',
display: 'inlay-fix'扫二维码下载作业帮
拍照搜题，秒出答案，一键查看所有搜题记录
下载作业帮安装包
扫二维码下载作业帮
拍照搜题，秒出答案，一键查看所有搜题记录
2+4+6+8+10+12+14+16+18+20+22+24+26+28+30+32+34+36+38+40+42+44+46+48+50这道数学题怎么计?
扫二维码下载作业帮
拍照搜题，秒出答案，一键查看所有搜题记录
等差数列求和(首项+尾项）*项数/2=(2+50)*25/2=52*25/2=650完毕 不懂 可CALL ME!
为您推荐：
其他类似问题
把末尾是2和末尾是8的放在一起，把末尾是4和末尾是6的放在一起，把末尾是0放在一起，最后把这些所得的和一起加起来，就ok了。
(首项+末项)*项数/2=(2+50)*25/2=650
原式=2+48+4+46+8+42+.。。。。+50=50+50+.。。。。+50=50*13=650
首项加末项乘以项数除以二，也就是（2+50）*25/2=650
该数列首相a是2，公差d是2，共有25项。带等差数列前n项和公式Sn=na+(n-1）d
2+4+6+8+10+12+14+16+18+20+22+24+26+28+30+32+34+36+38+40+42+44+46+48+50=（2+50）x12+26=624+26=650
来这里是问结果还是问过程呢？要问结果你可以用excel直接就计算出来了首先，要知道这组数总共是（50÷2）=25个，其中[（2+50）+（4+48）+（6+46）+…+（24+28）]总共有24÷2=12个，则2+4+6+8+10+12+14+16+18+20+22+24+26+28+30+32+34+36+38+40+42+44+46+48+50=（2+50）+（4+48）+...
很简单。首先你可以发现一共有50/2=25个数字相加，其中2+48=50,4+46=50,6+44=50.。。。找到这个规律你会发现，除了最后那个50，其他都能找到两项相加等于50的，所有一共就是24/2+1=13个50，所有结果等于13*50=650了。我说的应该详细了吧
计算顺序是这样的：
(2+4+6+8+10+12+14+16+18+20+22+24+26+28+30+32+34+36+38+40+42+44+46+48)+50=[2+48）+（4+46）+.......+(22+28)+(24+26)]+50=[50+50+......+50+50]+50=13×50=650还有一种通用方法就是首末项相加...
每个数字相差2 ，共25项（2+50）*25/2=650
高斯定理学过吗？楼上几位用的都是这个定理，如果没学过，可以直接百度这个定理的推理过程
扫描下载二维码}