求帮忙写一个VB程序

求帮忙写一个VB程序,第1张

两种方法  位运算  和 纯粹字符串处理

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


欢迎分享,转载请注明来源:内存溢出

原文地址: http://outofmemory.cn/yw/12359132.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-05-24
下一篇 2023-05-24

发表评论

登录后才能评论

评论列表(0条)

保存