两种方法 位运算 和 纯粹字符串处理
Private Sub Command1_Click()
'EnCode1 位运算实现加密
Dim arr() As Byte
Dim i As Integer
arr = StrConv(Text1.Text, vbFromUnicode)
For i = 0 To UBound(arr)
EnCode1 arr(i)
Next
Text2.Text = StrConv(arr, vbUnicode)
End Sub
Sub EnCode1(x As Byte) 'vb 默认byref 传地址
Dim h As Byte
Dim l As Byte
h = x And &HF0 'x字节高四渗敬胡位放入变量h, h低四位置零
x = Not x 'x按位取反
x = x And &HF '高四位置零,保留取反后的低四位
x = x * &H2 '乘2左移1位 (第0~第6位移到第1~第7位丛拦,最高位丢弃)
l = x And &H10 '取出第4位
x = x And &HF 'x高四位置零
l = l / &HF '第4位移到第0位
x = x Or l '第四位拼到x上完成低4位的移位
x = x Or h '高低4位拼在一起稿答,byref形参返回
End Sub
'----------------------------------------------------------
Private Sub Command2_Click()
'EnCode2 纯字符串处理实现
Dim s As String
Dim n As Integer
Dim i As Integer
s = ""
n = Len(Text1.Text)
For i = 1 To n
s = s &EnCode2(Mid(Text1.Text, i, 1))
Next
Text3.Text = s
End Sub
Function EnCode2(x As String) As String
Dim a As Integer
Dim s As String
a = Asc(x)
s = dec2binstr(a)
Dim sarr(1 To 9) As String
Dim i As Integer
For i = 1 To 8
sarr(i) = Mid(s, i, 1)
Next
For i = 5 To 8
If sarr(i) = "1" Then
sarr(i) = "0"
Else
sarr(i) = "1"
End If
Next
sarr(9) = sarr(4)
For i = 5 To 8
sarr(i - 1) = sarr(i)
Next
sarr(8) = sarr(4)
sarr(4) = sarr(9)
s = ""
For i = 1 To 8
s = s &sarr(i)
Next
a = binstr2dec(s)
EnCode2 = Chr(a)
End Function
Function dec2binstr(d As Integer) As String
Dim s As String
Dim a As Integer
Dim b As Integer
a = d
s = ""
Do
b = a Mod 2
a = a \ 2
If b >0 Then
s = "1" &s
Else
s = "0" &s
End If
Loop While a >= 1
a = Len(s)
If a <8 Then
s = String(8 - a, "0") &s
End If
dec2binstr = s
End Function
Function binstr2dec(s As String) As Integer
Dim x As Integer
x = &H0
For i = 1 To 8
x = x * &H2 + AscB(Mid(s, i, 1)) - AscB("0")
Next
binstr2dec = x
End Function
我想你先的做点音频文件,以供vb调用,(可以用“方正畅听”,它可以将文本转化为音频)桥中辩,然后用控件数组的方法来编程,并调用音频文件(可以将音频文件放在资源文件里)。一个简单的例子:
添加26个按扭,name属性均为“zimu”,index为0~25
添加1个按扭,
name属性为caps
,caption为caps
lock
添加1个计时器,name属性为timer1,interval=10
代码如下(在这就不写其他按键和声音的代码了!只写了caps和a~z这27个键敏缺的)
'-----------------------------------api
private
declare
sub
keybd_event
lib
"user32"
(byval
bvk
as
byte,
byval
bscan
as
byte,
byval
dwflags
as
long,
byval
dwextrainfo
as
long)
private
declare
function
getwindowlong
lib
"user32"
alias
"getwindowlonga"
(byval
hwnd
as
long,
byval
nindex
as
long)
as
long
private
declare
function
setwindowlong
lib
"user32"
alias
"setwindowlonga"
(byval
hwnd
as
long,
byval
nindex
as
long,
byval
dwnewlong
as
long)
as
long
private
declare
function
getkeystate
lib
"user32"
(byval
nvirtkey
as
long)
as
integer
dim
capslock
as
boolean
private
sub
form_activate()
'-------------------禁止窗体有培带焦点
setwindowlong
me.hwnd,
-20,
getwindowlong(me.hwnd,
-20)
or
&h8000000
end
sub
private
sub
caps_click()
'caps键
keybd_event
20,
0,
0,
0
keybd_event
20,
0,
2,
0
if
capslock
=
true
then
for
i
=
0
to
25
zimu(i).caption
=
chr(i
+
65)
next
else
for
i
=
0
to
25
zimu(i).caption
=
chr(i
+
97)
next
end
if
end
sub
private
sub
timer1_timer()
'检测caps的状态
if
getkeystate(20)
then
for
i
=
0
to
25
zimu(i).caption
=
chr(i
+
65)
next
else
for
i
=
0
to
25
zimu(i).caption
=
chr(i
+
97)
next
end
if
end
sub
private
sub
zimu_click(index
as
integer)
'a~z
keybd_event
index
+
65,
0,
0,
0
keybd_event
index
+
65,
0,
2,
0
end
sub
欢迎分享,转载请注明来源:内存溢出
评论列表(0条)