|
|
Postada em 31/10/2005 12:30 hs
Pessoal estou precisando de um código que tenha a seguinte função: quando eu clicar em qualque lugar de um form, um text1 = receba o valor de top
e o text2 receba o valor de left da posição do clique...
.... quem tiver um código assim me envie por favor ...
... grato.
dim KL , JI , MA , BG KL = Homem JI = Morre MA = Lutar BG = Objetivos == * O KL só JI quando deixa de MA Pelos Seus BG *==
|
|
|
|
|
|
Geronimo
|
JOINVILLE
SC - BRASIL
|
|
ENUNCIADA !
|
|
|
Postada em 31/10/2005 16:11 hs
Para saber se o mouse está sobre um objeto ou não, podemos usar de duas formas:
USANDO AS APIs GetCursorPos E WindowFromPoint:
'Use um Timer e proceda da seguinte forma:
'No Declarations
Private Declare Function GetCursorPos Lib "user32" _
(lpPoint As POINTAPI) As Long
Private Declare Function WindowFromPoint Lib _
"user32" (ByVal xPoint As Long, ByVal _
yPoint As Long) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Controle_MouseMove(...)
Timer1.Enabled = True
'O mouse está sobre o controle
End Sub
Private Sub Timer1_Timer()
Dim P as POINT
If GetCursorPos(P) Then
If WindowFromPoint(P.X, P.Y) <> Controle.hWnd then
Timer1.Enabled = False
'O mouse NÃO está mais sobre o controle
End If
End If
End Sub
USANDO AS APIs SetCapture E ReleaseCapture:
Verificando se o cursor do mouse está ou não sobre o Form:
'Coloque num form um CommandButton e dois Labels.
'No Declarations
Private Declare Function SetCapture Lib "user32" _
Alias "SetCapture" (ByVal hwnd As Long) _
As Long
Private Declare Function ReleaseCapture Lib _
"user32" Alias "ReleaseCapture" () As Long
Private Sub Form_Load()
SetCapture Me.Hwnd
End Sub
Private Sub Command1_Click()
ReleaseCapture
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift _
As Integer, X As Single, Y As Single)
Label1.Caption = X
Label2.Caption = Y
End Sub
Quando você executar, perceberá que, mesmo que o mouse não esteja sobre o Form, os Labels serão atualizados com as posições X e Y do mouse quando você o mover.
Quando você clicar no CommandButton ele irá parar de detectar o mouse quando ele estiver fora do Form (o ReleaseCapture "desliga" o SetCapture).
Verificando se o cursor do mouse está ou não sobre um controle:
'Coloque num form um CommandButton, dois Labels e
'um PictureBox.
'No Declarations
Private Declare Function SetCapture Lib "user32" _
Alias "SetCapture" (ByVal hwnd As Long) _
As Long
Private Declare Function ReleaseCapture Lib _
"user32" Alias "ReleaseCapture" () As Long
Private Sub Form_Load()
SetCapture Picture1.Hwnd
End Sub
Private Sub Command1_Click()
'Para de detectar o mouse no form todo.
ReleaseCapture
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift _
As Integer, X As Single, Y As Single)
If X > -1 And X < Picture1.Width And Y > -1 And Y < _
Picture1.Height Then
Picture1.BackColor = vbRed
Else
Picture1.BackColor = vbBlack
EndIf
End Sub
Quando você executar, perceberá que, quando o mouse estiver sobre o PictureBox ele ficará vermelho e quando não estiver ficará preto.
Quando você clicar no CommandButton ele irá parar de detectar o mouse quando ele estiver fora do PictureBox (o ReleaseCapture "desliga" o SetCapture). Então, ele não ficará mais preto, pois o VB não detectará mais quando o mouse "sair" do PictureBox...
"O pior inimigo que você poderá encontrar será sempre você mesmo."
|
|
|
|
Geronimo
|
JOINVILLE
SC - BRASIL
|
|
|
ENUNCIADA !
|
|
|
Postada em 31/10/2005 16:12 hs
ou: Private Declare Function GetCursorPos Lib "user32" (ipPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Private vstop As Boolean
***********************Gravar as Coordenadas****************
Private Sub CommandButton1_Click()
CommandButton1.Enabled = False
CommandButton3.Enabled = False
CommandButton2.Enabled = True
Dim x As Integer
x = 1
Dim mouse As POINTAPI
Open "C:mouse.mov" For Output As #1
Do Until vstop = True
GetCursorPos mouse
Write #1, mouse.x
Write #1, mouse.y
Label1.Caption = mouse.x
Label2.Caption = mouse.y
DoEvents
Loop
Close #1
End Sub
************************************************************
Private Sub CommandButton2_Click()
CommandButton1.Enabled = True
CommandButton2.Enabled = False
CommandButton3.Enabled = True
vstop = True
End Sub
****************************Abre as Coordenadas Antigas********
Private Sub CommandButton3_Click()
CommandButton1.Enabled = False
CommandButton2.Enabled = False
CommandButton3.Enabled = False
Dim mouse As POINTAPI
Dim corde As POINTAPI
corde.x = Label1.Caption
corde.y = Label2.Caption
vstop = False
Open "C:mouse.mov" For Input As #1
Do Until vstop = True
If EOF(1) Then Exit Do
Input #1, mousex
Input #1, mousey
GetCursorPos mouse
Label1.Caption = mouse.x
Label3.Caption = mouse.y
SetCursorPos mousex, mousey
DoEvents
Loop
Close #1
CommandButton2_Click
MsgBox "Fim de apresentação", vbExclamation, "Mouse MOve"
SetCursorPos corde.x, corde.y
End Sub
********************************Pega as Coordenadas************
Private Sub UserForm_Activate()
Dim mouse As POINTAPI
Do
GetCursorPos mouse
Label1.Caption = mouse.x
Label2.Caption = mouse.y
DoEvents
Loop
End Sub
"O pior inimigo que você poderá encontrar será sempre você mesmo."
|
|
|
|
Geronimo
|
JOINVILLE
SC - BRASIL
|
|
|
ENUNCIADA !
|
|
|
Postada em 31/10/2005 16:14 hs
Provavelmente você precisara destas informações : Esta dica é muito boa. Com o código a seguir, você vai poder prender o cursor do mouse dentro de um formulário qualquer.
Primeiro você cria um módulo contendo o seguinte código:
#If Win16 Then Type Retang esquerda As Integer topo As Integer direita As Integer baixo As Integer End Type Declare Sub ClipCursor Lib "User" (lpRetang As Retang) Declare Sub GetWindowRect Lib "User" (ByVal hWnd _ As Integer, lpRetang As Retang) Declare Function GetDesktopWindow Lib "User" () As Integer#Else Type Retang esquerda As Long topo As Long direita As Long baixo As Long End Type Declare Sub ClipCursor Lib "User32" (lpRetang As Retang) Declare Sub GetWindowRect Lib "User32" (ByVal hWnd _ As Integer, lpRetang As Retang) Declare Function GetDesktopWindow Lib "User32" () As Long#End If/pre>Depois você usa os códigos abaixo em um botão ou como quiser para travar e destravar:'restringe o movimento do mouseDim EstaJanela As RetangGetWindowRect Me.hWnd, EstaJanelaClipCursor EstaJanela'Libera no desktopDim DesktopWindow As RetangGetWindowRect GetDesktopWindow(), DesktopWindowClipCursor
"O pior inimigo que você poderá encontrar será sempre você mesmo."
|
|
|
|
|
