我写了一个按钮控件功能完全可以实现，就是当鼠标单击过快时没有响应

Question

我写了一个按钮控件功能完全可以实现，就是当鼠标单击过快时没有响应，我找了很久都没有找出问题，请各位高手帮我找一下多谢了!!!共用了三个控件ImgMainPic是用来显示要显示的图标 ImgBackPic是显示控件的背景
LblCaption显示控件的标签
下面是代码请帮我看一下：
Option Explicit
'事件声明:
Event Click() 'MappingInfo=LblCaption,LblCaption,-1,Click
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=LblCaption,LblCaption,-1,MouseDown
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=LblCaption,LblCaption,-1,MouseMove
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=LblCaption,LblCaption,-1,MouseUpPrivate Sub ImgBackPic_Click()
    RaiseEvent Click
End SubPrivate Sub ImgBackPic_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseDown(Button, Shift, X, Y)
    CmdMouseDown
End SubPrivate Sub ImgBackPic_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseUp(Button, Shift, X, Y)
    CmdMouseUp
End SubPrivate Sub ImgMainPic_Click()
    RaiseEvent Click
End SubPrivate Sub ImgMainPic_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseDown(Button, Shift, X, Y)
    CmdMouseDown
End SubPrivate Sub ImgMainPic_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseUp(Button, Shift, X, Y)
    CmdMouseUp
End SubPrivate Sub UserControl_Resize()
On Error GoTo Err_UserControl_Resize    With ImgMainPic
        .Left = UserControl.Width * 0.2
        .Top = 6 * Screen.TwipsPerPixelX
        If UserControl.Width > 0 Then
            .Width = UserControl.Width * 0.6
            .Height = UserControl.Width * 0.6
        End If
    End With
    With LblCaption
        .Top = ImgMainPic.Height + 8 * Screen.TwipsPerPixelX
        .Left = 0
        If UserControl.Width > 0 Then
            .Width = UserControl.Width
            .Height = LblCaption.Font.Size * 0.036 * 567
        End If
    End With
    UserControl.Height = LblCaption.Top + LblCaption.Height + 6 * Screen.TwipsPerPixelX
    With ImgBackPic
        .Top = 0
        .Left = 0
        .Width = UserControl.Width
        .Height = UserControl.Height
    End With
    
Exit_UserControl_Resize:
    Exit Sub
Err_UserControl_Resize:
    MsgBox Err.Description
    Resume Exit_UserControl_Resize
End Sub
'注意！不要删除或修改下列被注释的行！
'MappingInfo=UserControl,UserControl,-1,BackColor
Public Property Get BackColor() As OLE_COLOR
    BackColor = UserControl.BackColor
End PropertyPublic Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
    UserControl.BackColor() = New_BackColor
    PropertyChanged "BackColor"
End Property'注意！不要删除或修改下列被注释的行！
'MappingInfo=LblCaption,LblCaption,-1,Enabled
Public Property Get Enabled() As Boolean
    Enabled = LblCaption.Enabled
End PropertyPublic Property Let Enabled(ByVal New_Enabled As Boolean)
    LblCaption.Enabled() = New_Enabled
    PropertyChanged "Enabled"
End Property'注意！不要删除或修改下列被注释的行！
'MappingInfo=LblCaption,LblCaption,-1,Font
Public Property Get Font() As Font
    Set Font = LblCaption.Font
End PropertyPublic Property Set Font(ByVal New_Font As Font)
    Set LblCaption.Font = New_Font
    PropertyChanged "Font"
End PropertyPrivate Sub LblCaption_Click()
    RaiseEvent Click
End SubPrivate Sub LblCaption_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseDown(Button, Shift, X, Y)
    CmdMouseDown
End SubPrivate Sub LblCaption_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseMove(Button, Shift, X, Y)
End SubPrivate Sub LblCaption_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseUp(Button, Shift, X, Y)
    CmdMouseUp
End Sub'注意！不要删除或修改下列被注释的行！
'MappingInfo=ImgMainPic,ImgMainPic,-1,Picture
Public Property Get Picture() As Picture
    Set Picture = ImgMainPic.Picture
End PropertyPublic Property Set Picture(ByVal New_Picture As Picture)
    Set ImgMainPic.Picture = New_Picture
    PropertyChanged "Picture"
End Property'注意！不要删除或修改下列被注释的行！
'MappingInfo=LblCaption,LblCaption,-1,Caption
Public Property Get Caption() As String
    Caption = LblCaption.Caption
End PropertyPublic Property Let Caption(ByVal New_Caption As String)
    LblCaption.Caption() = New_Caption
    PropertyChanged "Caption"
End Property'从存贮器中加载属性值
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)    UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
    LblCaption.Enabled = PropBag.ReadProperty("Enabled", True)
    Set LblCaption.Font = PropBag.ReadProperty("Font", Ambient.Font)
    Set Picture = PropBag.ReadProperty("Picture", Nothing)
    LblCaption.Caption = PropBag.ReadProperty("Caption", "")
End Sub'将属性值写到存储器
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)    Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F)
    Call PropBag.WriteProperty("Enabled", LblCaption.Enabled, True)
    Call PropBag.WriteProperty("Font", LblCaption.Font, Ambient.Font)
    Call PropBag.WriteProperty("Picture", Picture, Nothing)
    Call PropBag.WriteProperty("Caption", LblCaption.Caption, "")
End SubPrivate Sub CmdMouseDown()
On Error GoTo Err_CmdMouseDown    With ImgMainPic
        .Left = .Left + 2 * Screen.TwipsPerPixelX
        .Top = .Top + 2 * Screen.TwipsPerPixelX
    End With
    With LblCaption
        .Left = .Left + 2 * Screen.TwipsPerPixelX
        .Top = .Top + 2 * Screen.TwipsPerPixelX
    End With
    ImgMainPic.Refresh
    UserControl.AutoRedraw = TrueExit_CmdMouseDown:
    Exit Sub
Err_CmdMouseDown:
    MsgBox Err.Description
    Resume Exit_CmdMouseDown
End Sub
Private Sub CmdMouseUp()
On Error GoTo Err_CmdMouseUp    UserControl_Resize
    
Exit_CmdMouseUp:
    Exit Sub
Err_CmdMouseUp:
    MsgBox Err.Description
    Resume Exit_CmdMouseUp
End Sub

Answer 1

处理ImgBackPic和ImgMainPic的双击事件，在这两个控件的双击事件中也加入
RaiseEvent Click你应该可以知道，标准的命令按钮是没有双击事件的, 在这里将双击事件转成单击事件就行了。

Answer 2

TO songyaowu，您说的问题是存在的，但我需要处理的是点击过快时控件没有响应这个问题还是存在的。请帮帮我呀，我等着救命，先谢过了。

Answer 3

windows  每隔一秒才发出一个鼠标消息,而不是对鼠标移过的每个像素点都产生消息

Answer 4

如果我没理解错楼主的意思，那么添加下面的代码：Private Sub LblCaption_DblClick()
    CmdMouseDown
    RaiseEvent Click
End SubPrivate Sub UserControl_DblClick()
    CmdMouseDown
    RaiseEvent Click
End Sub
Private Sub ImgMainPic_DblClick()
    CmdMouseDown
    RaiseEvent Click
End Sub
Private Sub ImgBackPic_DblClick()
    CmdMouseDown
    RaiseEvent Click
End Sub

Answer 5

这样可能不行，重绘CommandButton控件或许可以。

Answer 6

要如何才可以重绘CommandButton控件

Answer 7

其它的没有看完，不过，应该要处理双击，每个单击的地方应该防止两次事件同时触发还有一个
UserControl.AutoRedraw = True    只要写一次