我要用一个带有check的DTPicker,可是后来发现在该控件上敲回车的话,系统会有提示音出现。后来发现如果这个控件check属性为false时,就不会有那声音。现在我该怎么让该控件有check框又能把这声音给关掉呢?这个声音到底是什么意思?实在不明白

解决方案 »

  1.   

    署我 苯   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运行程序,是不是看到一个漂亮的彩色按钮?把鼠标移动到它上面,按下,释放,是不是有美妙的音效?
      

  2.   

    请问你按那个回车有什么用吗?要实现什么功能吗?因为窗体载入时,焦点默认在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
    这样就不会发出声音了。
      

  3.   

    //zcm123(!还在聊天,我给你的程序作了吗?-_-~) 
    太麻烦了,又用api,我的方法比较简单
      

  4.   

    不过我实在搞不懂楼主为什么非要按回车键,加与不加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
      

  5.   

    我是将回车的代码里面写sendkeys “{Tab}” ,想把控件焦点移到下一个控件中。
    To : starsoulxp(星魂) 
       你的方法好象只能针对这个控件处于选中状态,如果数据库中这个字段的值是 Null,那么绑定的DTPicker的check属性就不会选中,那么sendkeys "{Right}" 就没什么效果了,回车还会发出那个声音。
      

  6.   

    Private Sub DTPicker1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
       KeyAscii = 0
    End If
    End Sub
    这样就不会发出声音了。