模仿单击按钮，怎么办？？？

Question

我想在按下[F3]键以后，模仿鼠标单击按钮，现在的问题是按钮单击事件可以触发，但视觉上感觉不出按钮被按下。怎样才能做到按钮真的被按下，而不是仅仅触发按钮事件？？？？谢谢！

Answer 1

http://community.csdn.net/Expert/topic/3532/3532159.xml?temp=.9119989

Answer 2

http://community.csdn.net/Expert/topic/3531/3531428.xml?temp=.8643305

Answer 3

用API函数发消息：
Option ExplicitConst WM_LBUTTONDOWN = &H201
Const WM_LBUTTONUP = &H202Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As LongPrivate Sub Command2_Click()
    Call SendMessage(Command1.hwnd, WM_LBUTTONDOWN, 0, 0)
    Call SendMessage(Command1.hwnd, WM_LBUTTONUP, 0, 0)
End Sub

Answer 4

有两个按钮，点击Command2的时候，可以看到Command1被点击的效果

Answer 5

这个是调用mouse_event控制鼠标关闭自己的小程序。你可以参考一下。Option ExplicitPrivate Const MOUSEEVENTF_MOVE = &H1 '  mouse movePrivate Const MOUSEEVENTF_LEFTDOWN = &H2 '  left button downPrivate Const MOUSEEVENTF_LEFTUP = &H4 '  left button up
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End TypePrivate Type POINTAPI
        x As Long
        y As Long
End TypePrivate Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As LongPrivate Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As LongPrivate Sub Form_Load()
End SubPrivate Sub Timer1_Timer()
  Dim dx As Double, dy As Double
  Dim rt As RECT
  Dim pt As POINTAPI
  Dim result As Long
  
  GetCursorPos pt
  result = GetWindowRect(Me.hwnd, rt)
  If result = 0 Then
    Timer1.Enabled = False
    MsgBox "读取窗口坐标出错", vbOKOnly + vbCritical, "错误"
    End
  End If
  
  If rt.Right - 15 - pt.x = 0 Then
    Timer1.Enabled = False
    mouse_event MOUSEEVENTF_LEFTDOWN + MOUSEEVENTF_LEFTUP, pt.x, pt.y, 0, 0
    Exit Sub
  End If
  
  dx = (rt.Right - 15 - pt.x) / Abs(rt.Right - 15 - pt.x)
  dy = (rt.Top + 15 - pt.y) * dx / (rt.Right - 15 - pt.x)
  mouse_event MOUSEEVENTF_MOVE, dx, dy, 0, 0
  
End Sub

Answer 6

viena,你好。
Command1只是获得焦点,而没有被按下？

Answer 7

添加一个checkbox控件和一个commandbutton控件,把checkbox控件的style属性调整为1,然后加入如下代码,在commandbutton控件上按下鼠标左键,checkbox控件就会凹进去了,松开,则弹起!
要是用到热键上,可以考虑KeyDown和KeyUp两个消息那重复以下代码,或用时间控件...
Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton Then
       Check1.Value = Checked
    End If
End SubPrivate Sub Command1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton Then
       Check1.Value = Unchecked
    End If
End Sub

Answer 8

Option ExplicitPrivate Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Const MOUSEEVENTF_LEFTDOWN = &H2 '  left button down
Private Const MOUSEEVENTF_LEFTUP = &H4 '  left button upPrivate Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As LongPrivate Type POINTAPI
    x As Long
    y As Long
End TypePrivate Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)Private Sub Form_Load()
    Me.KeyPreview = True
End SubPrivate Sub Form_KeyPress(KeyAscii As Integer)
    'M 键
    If KeyAscii = Asc("m") Then
        Call EmuMouseDown(Command1)
    End If
End SubPrivate Sub Command1_Click()
    MsgBox "Click!"
End SubPrivate Sub EmuMouseDown(ByVal oTarget As Control, Optional ByVal nPauseTime As Long = 250)
    Dim oldPoint As POINTAPI, newPoint As POINTAPI    '保存当前鼠标位置
    Call GetCursorPos(oldPoint)    '设定按钮位置
    newPoint.x = (oTarget.Left + oTarget.Width / 2) / Screen.TwipsPerPixelX
    newPoint.y = (oTarget.Top + oTarget.Height / 2) / Screen.TwipsPerPixelY
    Call ClientToScreen(Me.hwnd, newPoint)    '设置目的地位置
    Call SetCursorPos(newPoint.x, newPoint.y)    '模拟按下鼠标右键
    Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
    DoEvents
    '暂停0.25秒
    Call Sleep(nPauseTime)
    '模拟放开鼠标右键
    Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)    '恢复鼠标位置
    Call SetCursorPos(oldPoint.x, oldPoint.y)
End Sub

Answer 9

'怎样模仿键盘空格键被按下？
SendKeys ""

Answer 10

我是说象模仿鼠标按下那样，使用api

Answer 11

谢谢orcer，尽管你多年前已不做帅哥。Private Const VK_SPACE = &H20Command1.SetFocus
keybd_event VK_SPACE, 0, 0, 0

Answer 12

orcer，视觉效果达到了，但为什么不触发Command1中的Click事件？？