署我 苯 dtoicker 是什么东东阿?我的观点 当程序运行次槽作时 禁止系统发声 结束时恢复发声 用 Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long 控制发声 参照实例如下: Option Explicit Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long Private Declare Function mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, ByVal uLength As Long) As Long Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long '监视鼠标的状态 Dim MouseOver Dim MousePress Dim NewIndex '表示不同的声音 Dim MouseOverSound As String Dim MousePressSound As String Dim MouseUpSound As String Const MouseOverMCI As String = "WAVEOVER" Const MousePressMCI As String = "WAVEPRESS" Const MouseUpMCI As String = "WAVEUP11"'鼠标按下时 Private Sub image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If MousePress Then Exit Sub StopSounds Image1.Picture = DownImage.Picture PlayWav MousePressMCI MousePress = True End Sub'鼠标移到按钮上时 Private Sub image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If MouseOver Then Exit Sub StopSounds Image1.Picture = OverImage.Picture '改变图片并且播放相应的声音 PlayWav MouseOverMCI MouseOver = True End Sub'鼠标释放时 Private Sub image1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) If Not MousePress Then Exit Sub StopSounds PlayWav MouseUpMCI Image1.Picture = UpImage.Picture MousePress = False End SubPrivate Sub Form_Load() MouseOverSound = "boink.wav" MousePressSound = "bleeb.wav" MouseUpSound = "type.wav" LoadSound MouseOverSound, MouseOverMCI '调用过程装载音乐 LoadSound MousePressSound, MousePressMCI LoadSound MouseUpSound, MouseUpMCI Image1.Picture = UpImage.Picture End SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If Not MouseOver Then Exit Sub StopSounds MouseOver = False MousePress = False Image1.Picture = UpImage.Picture '设置相应的图片 End SubPrivate Sub Form_Unload(Cancel As Integer) StopSounds '关闭声音 End SubPublic Function PlayWav(Alias As String) Dim rt As Long, ErrorString As String '播放声音 rt = mciSendString("PLAY " & Alias & " FROM 0", 0&, 0, 0) If rt <> 0 Then '出现错误时,显示出错对话框 ErrorString = Space(255) mciGetErrorString rt, ErrorString, Len(ErrorString) MsgBox "错误: " & ErrorString End If End FunctionPrivate Sub LoadSound(Filename As String, Alias As String) Dim CommandString As String, ErrorString As String Dim ShortPathName As String Dim AppPath As String Dim rt As Long AppPath = App.Path If Right(AppPath, 1) <> "\" Then AppPath = AppPath & "\" End If ShortPathName = Space(255) '生成空长度为255的空字符串 '得到短文件名字,因为MCI只接受短文件名 GetShortPathName AppPath, ShortPathName, Len(ShortPathName) ShortPathName = Left(ShortPathName, Len(Trim(ShortPathName)) - 1) CommandString = "OPEN " & ShortPathName & Filename & " TYPE WAVEAUDIO ALIAS " & Alias rt = mciSendString(CommandString, 0&, 0, 0) '打开声音 If rt <> 0 Then '非0则出现错误 ErrorString = Space(255) mciGetErrorString rt, ErrorString, Len(ErrorString) MsgBox "错误: " & ErrorString End If End SubPrivate Sub StopSounds() '该过程停止播放声音 mciSendString "STOP " & MouseOverMCI, 0&, 0, 0 mciSendString "STOP " & MouseUpMCI, 0&, 0, 0 mciSendString "STOP " & MousePressMCI, 0&, 0, 0 End Sub带上耳机,按F5运行程序,是不是看到一个漂亮的彩色按钮?把鼠标移动到它上面,按下,释放,是不是有美妙的音效?
请问你按那个回车有什么用吗?要实现什么功能吗?因为窗体载入时,焦点默认在checkbox上,这样按回车不起任何作用,因此会发出那种声音,把它去掉后焦点在日期身上了,按回车不会出声音。 窗体载入后,你如果按空格键,可以切换check是否选中。如果你非要按那个回车的话,就写下面的代码 Private Sub Form_Load() SendKeys "{right}" End Sub这句化的意思是窗体一载入就发送一个右方向键的命令,这样焦点就跑到 右边去了,不过你要在把焦点切到checkbox上还是会发出那种声音。这样来解决 前面的代码不用加了,只要加下面的就行了,如果你回车没什么特殊功能的话。Private Sub DTPicker1_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then KeyAscii = 0 End If End Sub 这样就不会发出声音了。
不过我实在搞不懂楼主为什么非要按回车键,加与不加checkbox按回车都没什么时间发生啊,除非你要以回车来模拟点击下拉箭头的功能,那样代码就要改了。Private Sub DTPicker1_Click() MsgBox "fadsf" End SubPrivate Sub DTPicker1_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Call DTPicker1_Click KeyAscii = 0 ’还得加上,否则点完msgbox的确定后还会发出那种声音 End If End Sub
我是将回车的代码里面写sendkeys “{Tab}” ,想把控件焦点移到下一个控件中。 To : starsoulxp(星魂) 你的方法好象只能针对这个控件处于选中状态,如果数据库中这个字段的值是 Null,那么绑定的DTPicker的check属性就不会选中,那么sendkeys "{Right}" 就没什么效果了,回车还会发出那个声音。
Private Sub DTPicker1_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then KeyAscii = 0 End If End Sub 这样就不会发出声音了。
用
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
控制发声
参照实例如下:
Option Explicit
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Declare Function mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, ByVal uLength As Long) As Long
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
'监视鼠标的状态
Dim MouseOver
Dim MousePress
Dim NewIndex
'表示不同的声音
Dim MouseOverSound As String
Dim MousePressSound As String
Dim MouseUpSound As String
Const MouseOverMCI As String = "WAVEOVER"
Const MousePressMCI As String = "WAVEPRESS"
Const MouseUpMCI As String = "WAVEUP11"'鼠标按下时
Private Sub image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If MousePress Then Exit Sub
StopSounds
Image1.Picture = DownImage.Picture
PlayWav MousePressMCI
MousePress = True
End Sub'鼠标移到按钮上时
Private Sub image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If MouseOver Then Exit Sub
StopSounds
Image1.Picture = OverImage.Picture '改变图片并且播放相应的声音
PlayWav MouseOverMCI
MouseOver = True
End Sub'鼠标释放时
Private Sub image1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Not MousePress Then Exit Sub
StopSounds
PlayWav MouseUpMCI
Image1.Picture = UpImage.Picture
MousePress = False
End SubPrivate Sub Form_Load()
MouseOverSound = "boink.wav"
MousePressSound = "bleeb.wav"
MouseUpSound = "type.wav"
LoadSound MouseOverSound, MouseOverMCI '调用过程装载音乐
LoadSound MousePressSound, MousePressMCI
LoadSound MouseUpSound, MouseUpMCI
Image1.Picture = UpImage.Picture
End SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Not MouseOver Then Exit Sub
StopSounds
MouseOver = False
MousePress = False
Image1.Picture = UpImage.Picture '设置相应的图片
End SubPrivate Sub Form_Unload(Cancel As Integer)
StopSounds '关闭声音
End SubPublic Function PlayWav(Alias As String)
Dim rt As Long, ErrorString As String
'播放声音
rt = mciSendString("PLAY " & Alias & " FROM 0", 0&, 0, 0)
If rt <> 0 Then '出现错误时,显示出错对话框
ErrorString = Space(255)
mciGetErrorString rt, ErrorString, Len(ErrorString)
MsgBox "错误: " & ErrorString
End If
End FunctionPrivate Sub LoadSound(Filename As String, Alias As String)
Dim CommandString As String, ErrorString As String
Dim ShortPathName As String
Dim AppPath As String
Dim rt As Long
AppPath = App.Path
If Right(AppPath, 1) <> "\" Then
AppPath = AppPath & "\"
End If
ShortPathName = Space(255) '生成空长度为255的空字符串
'得到短文件名字,因为MCI只接受短文件名
GetShortPathName AppPath, ShortPathName, Len(ShortPathName)
ShortPathName = Left(ShortPathName, Len(Trim(ShortPathName)) - 1)
CommandString = "OPEN " & ShortPathName & Filename & " TYPE WAVEAUDIO ALIAS " & Alias
rt = mciSendString(CommandString, 0&, 0, 0) '打开声音
If rt <> 0 Then '非0则出现错误
ErrorString = Space(255)
mciGetErrorString rt, ErrorString, Len(ErrorString)
MsgBox "错误: " & ErrorString
End If
End SubPrivate Sub StopSounds() '该过程停止播放声音
mciSendString "STOP " & MouseOverMCI, 0&, 0, 0
mciSendString "STOP " & MouseUpMCI, 0&, 0, 0
mciSendString "STOP " & MousePressMCI, 0&, 0, 0
End Sub带上耳机,按F5运行程序,是不是看到一个漂亮的彩色按钮?把鼠标移动到它上面,按下,释放,是不是有美妙的音效?
窗体载入后,你如果按空格键,可以切换check是否选中。如果你非要按那个回车的话,就写下面的代码
Private Sub Form_Load()
SendKeys "{right}"
End Sub这句化的意思是窗体一载入就发送一个右方向键的命令,这样焦点就跑到 右边去了,不过你要在把焦点切到checkbox上还是会发出那种声音。这样来解决
前面的代码不用加了,只要加下面的就行了,如果你回车没什么特殊功能的话。Private Sub DTPicker1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
End If
End Sub
这样就不会发出声音了。
太麻烦了,又用api,我的方法比较简单
MsgBox "fadsf"
End SubPrivate Sub DTPicker1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call DTPicker1_Click
KeyAscii = 0 ’还得加上,否则点完msgbox的确定后还会发出那种声音
End If
End Sub
To : starsoulxp(星魂)
你的方法好象只能针对这个控件处于选中状态,如果数据库中这个字段的值是 Null,那么绑定的DTPicker的check属性就不会选中,那么sendkeys "{Right}" 就没什么效果了,回车还会发出那个声音。
If KeyAscii = 13 Then
KeyAscii = 0
End If
End Sub
这样就不会发出声音了。