Rui C. Silva
não registrado
|
|
ENUNCIADA !
|
|
|
Postada em 04/04/2006 14:49 hs
'No Form
'Coloque um Command Button
Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
LeftClick
End Sub
'No módulo
'**************************************
'Windows API/Global Declarations for :A
' mouse module, FINALLY!!! Move,click, +mo
' re
'**************************************
Public 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)
Public Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_MIDDLEDOWN = &H20
Public Const MOUSEEVENTF_MIDDLEUP = &H40
Public Const MOUSEEVENTF_RIGHTDOWN = &H8
Public Const MOUSEEVENTF_RIGHTUP = &H10
Public Const MOUSEEVENTF_MOVE = &H1
Public Type POINTAPI
X As Long
Y As Long
End Type
'**************************************
' Name: A mouse module, FINALLY!!! Move,
' click, +more
' Description:This module has the follow
' ing functions (pretty self explanitory):
' GetX, GetY, LeftClick, LeftDown, LeftUp,
' RightClick, RightUp, RightDown, MiddleCl
' ick, MiddleDown, MiddleUp, MoveMouse, Se
' tMousePos
' By: Arthur Chaparyan3
'
'
' Inputs:None
'
' Returns:None
'
'Assumes:You should know how to create a
' nd use a module. If you have any questio
' ns, please submit a comment, thanX
'
'Side Effects:None
'This code is copyrighted and has limite
' d warranties.
'Please see http://www.Planet-Source-Cod
' e.com/xq/ASP/txtCodeId.2795/lngWId.1/qx/
' vb/scripts/ShowCode.htm
'for details.
'**************************************
Public Function GetX() As Long
Dim n As POINTAPI
GetCursorPos n
GetX = n.X
End Function
Public Function GetY() As Long
Dim n As POINTAPI
GetCursorPos n
GetY = n.Y
End Function
Public Sub LeftClick()
LeftDown
LeftUp
End Sub
Public Sub RightClick()
RightDown
RightUp
End Sub
Public Sub LeftDown()
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
End Sub
Public Sub LeftUp()
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub
Public Sub MiddleClick()
MiddleDown
MiddleUp
End Sub
Public Sub MiddleDown()
mouse_event MOUSEEVENTF_MIDDLEDOWN, 0, 0, 0, 0
End Sub
Public Sub MiddleUp()
mouse_event MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0
End Sub
Public Sub MoveMouse(xMove As Long, yMove As Long)
mouse_event MOUSEEVENTF_MOVE, xMove, yMove, 0, 0
End Sub
Public Sub RightDown()
mouse_event MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0
End Sub
Public Sub RightUp()
mouse_event MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
End Sub
Public Sub SetMousePos(xPos As Long, yPos As Long)
SetCursorPos xPos, yPos
End Sub
|
|
|
|
|
|
vilmarbr
|
SAO PAULO
SP - BRASIL
|
|
|
ENUNCIADA !
|
|
|
Postada em 04/04/2006 17:44 hs
Eu quase consegui solucionar meu problema com isto: Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Const WM_LBUTTONDOWN = &H201
O problema agora é que a linha só é
selecionada após já ter exibido o menu de contexto, sendo que eu preciso que
a linha seja selecionada antes, p/ que quando o menu de contexto abra alguns
menus já estejam habilitados ou desabilitados conforme os valores das
propriedades:
Grid.SelectedRow, Grid.SelectedCol
Sendo que eu só consigo fazer estas 2 propriedades serem alimentadas qdo
clico com botão esquerdo.
Tem como resolver isto???
Rotina:
Private Sub Grid_MouseDown(Button As Integer, Shift As Integer, x As Single,
y As Single, bDoDefault As Boolean)
If Button = vbRightButton Then
SendMessage Grid.hwnd, WM_LBUTTONUP, 0&, 0&
End If
Call TrataSelecaoOferta(Grid.SelectedRow, Grid.SelectedCol)
Call Form_MouseDown(Button, Shift, x, y)
End Sub
Até conseguimos algo sem API, mas eu acho que é mais lento, veja:
Private Sub Grid_MouseDown(Button As Integer, Shift As Integer, x As Single,
y As Single, bDoDefault As Boolean)
Dim lLeft As Long, lTop As Long, lWidth As Long, lHeight As Long
Dim lRow As Long
lRow = Grid.SelectedRow
Do While (True)
Call Grid.CellBoundary(lRow, Grid.SelectedCol, lLeft, lTop, lWidth,
lHeight)
If y >= lTop And y <= (lTop + lHeight) Then
Grid.SelectedRow = lRow
Exit Do
ElseIf y > lTop Then
lRow = lRow + 1
ElseIf y < lTop Then
lRow = lRow - 1
End If
Loop
Call TrataSelecaoOferta(Grid.SelectedRow, Grid.SelectedCol)
Call Form_MouseDown(Button, Shift, x, y)
End Sub
Obrigado.
http://www.vilmarbro.com.br
|
|
|
|
vilmarbr
|
SAO PAULO
SP - BRASIL
|
|
|
ENUNCIADA !
|
|
|
Postada em 05/04/2006 17:51 hs
Oi pessoal! No meu caso, usando as APIs conforme dica posta neste tópico, funcionou assim: Private Sub Grid_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single, bDoDefault As Boolean)
'Alterado procedimento p/ que qdo. usuário clique com botão direito do mouse seja selecionada a linha e logo
'em seguida seja mostrado o menu mnuPopup com opções do menu já habilitadas ou desabilitadas conforme os valores de
'Grid.SelectedRow e Grid.SelectedCol.
If Button = vbRightButton Then
Call LeftClick 'Chama procedimento que simula clique com botão esquerdo do mouse.
End If
End Sub Private Sub Grid_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
'Adicionado este procedimento p/ que qdo. usuário clique com botão direito do mouse seja selecionada a linha e logo
'em seguida seja mostrado o menu mnuPopup com opções do menu já habilitadas ou desabilitadas conforme os valores de
'Grid.SelectedRow e Grid.SelectedCol.
Call TrataSelecaoOferta(Grid.SelectedRow, Grid.SelectedCol)
Call Form_MouseDown(Button, Shift, x, Y)
End Sub
http://www.vilmarbro.com.br
|
|
|
|
josa
não registrado
|
|
|
ENUNCIADA !
|
|
|
Postada em 21/04/2012 22:41 hs
passe o codigo do botao direito clicado via codigo por favor!!!!!!
|
|
|
|
|
