How do you create a mouseover in VB6 4

[kamamoo]

I found out creating a mouseover in VB6 is not as simple as VBnet. If anyone can help me with me out with how to do it in VB6 I would be oh so greatful.

Thanks

 

[zemp]

Use the controls mousemove event.
Thanks and Good Luck!

zemp

 

[zemp]

Use the controls mousemove event.
Thanks and Good Luck!

zemp

 

[merlinx]

Mousemove has the draw back of not responding when the cursor has left the event area. There are a few different approachs in dealing with this, most using the api. It really depends on what you are working on. One approach is to monitor the mouse position on the screen, which means that you need to know where your event area is in relasionship to the screen. The best way is in the first move event put the x/y event area and the x/y screen area in a variable then compute a new x1/y1 x2/y2 area relative to the screen, in this way you know exactly when your mouse leaves the area. Also you need a timer for this.

The following code will retrieve the screen position of X/Y, The functions also have an optional input value which you do not need to use.


Private Declare Function GetCursorPos& Lib "user32" (lpPoint As POINTAPI)

Private Type POINTAPI
X As Long
Y As Long
End Type

Function PosX(Optional ByVal hwnd As Long) As Long
Dim lpPoint As POINTAPI
GetCursorPos lpPoint
PosX = lpPoint.X
End Function

Function PosY(Optional ByVal hwnd As Long) As Long
Dim lpPoint As POINTAPI
GetCursorPos lpPoint
PosY = lpPoint.Y
End Function


The next step is to build a mouse_over function, it is important that you had a boolean to block repeated calls during the same move event.

On your form ;

Dim MyMoveIsActive As Boolean
Dim RealX, RealY, vX1, vX2, vY1, vY2 As Long

Function MyMouseOver(ByVal X1 As Long, X2 As Long, Y1 As Long, Y2 As Long)As Boolean

Dim qX, qY As Boolean

If(MyMoveIsActive = True)Then
GoTo QuestionMouse
End If

MyMoveIsActive = True
Timer1.Enabled = True

RealX = PosX
RealY = PosY
vX1 = RealX - X1
vX2 = RealX + X2
vY1 = RealY - Y1
vY2 = RealY + Y2

QuestionMouse:
if((PosX => vX1)And(PosX =< vX2))Then
qX = True
Else
qX = False
End If

if((PosY => vY1)And(PosY =< vY2))Then
qY = True
Else
qY = False
End If

if((qX = True)And(qY = True))Then
MyMouseOver = True
Else
MyMouseOver = False
Timer1.Enabled = False
MyMoveIsActive = False
End If

End Function

Private Sub Timer1_Timer()
Dim Ret As Boolean
Ret = MyMouseOver(0,0,0,0)
If(Ret = True)Then
Exit Sub
Else
DoWhatever
End If
End Sub


Now You need to put it to use :


Private Sub Obj_MouseMove(....)
If(MyMouseOver(X,Y,Obj.Width,Obj.Height)=True)Then
Do Whatever
End if
End Sub


This may look like it works only the first time, though the timer1 takes over the mouse move work.

 

[kamamoo]

Thanks for your help I will give it a shot

 

[kamamoo]

ok, Im sorry to have to ask this, but how do I get it to load the image I want it to switch to?

 

[merlinx]

In the previous mentioned there are two places where Do Whatever is written, In the mousemove turn your image on and in the timer turn it off. The if statement in mousemove will only be true on entering the event object, the timer event will remain true until the mouse exits the area and so in the else statment mouseover will be turned off.

 

[strongm]

And if you are willing to consider an API solution, here's a variant. Note that the WindowFromPoint call basically does all the work that merlinx's mymouseover function provides:
[tt]
Option Explicit

Private Declare Function SetCapture Lib &quot;user32&quot; (ByVal hWnd As Long) As Long
Private Declare Function WindowFromPoint Lib &quot;user32&quot; (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib &quot;user32&quot; (lpPoint As POINTAPI) As Long
Private Declare Function ReleaseCapture Lib &quot;user32&quot; () As Long

Private Type POINTAPI
X As Long
Y As Long
End Type

Private Enum RollType
RollIn = 1
RollOut = 2
End Enum

Private Function RollOver(ctlControl As Control) As RollType
Dim myPoint As POINTAPI
Dim OverWindow As Boolean

GetCursorPos myPoint
On Error Resume Next ' Bit of a cheat to handle case where control does not have an hWnd
OverWindow = (ctlControl.hWnd = WindowFromPoint(myPoint.X, myPoint.Y))
On Error GoTo 0

If OverWindow Then
SetCapture ctlControl.hWnd
RollOver = RollIn
Else
ReleaseCapture
RollOver = RollOut
End If

End Function
[/tt]
And here's an example of how it might be used. In this case I just change the Backcolor of the button, which requires the button's style to be set to Graphical.
[tt]
Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If RollOver(Command1) = RollIn Then
'Do rollin event, eg:
Command1.BackColor = &H80000010 ' Assumes button style is Graphical
Else ' Ok, we've got a rollout
' Do rollout event, eg:
Command1.BackColor = &H8000000F ' Assumes button style is Graphical
End If
End Sub

 

[kamamoo]

ok, but what if im using images for example image1.jpg and image2.jpg

Thanks

 

[strongm]

Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If RollOver(Command1) = RollIn Then
'Do rollin event, eg:
Command1.Picture=LoadPicture(&quot;image1.jpg&quot ' Assumes button style is Graphical
Else ' Ok, we've got a rollout
' Do rollout event, eg:
Command1.Picture=LoadPicture(&quot;image2.jpg&quot ' Assumes button style is Graphical
End If
End Sub

 

[kamamoo]

Thanks, worked wonderfully

 

[bahakh]

strongm, I was trying to use your code, but I didn't know how to seperate it(just a begginer), meaning, where to put the:

Option Explicit

Private Declare Function SetCapture Lib &quot;user32&quot; (ByVal hWnd As Long) As Long
Private Declare Function WindowFromPoint Lib &quot;user32&quot; (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib &quot;user32&quot; (lpPoint As POINTAPI) As Long
Private Declare Function ReleaseCapture Lib &quot;user32&quot; () As Long

and the :

Private Function RollOver(ctlControl As Control) As RollType
Dim myPoint As POINTAPI
Dim OverWindow As Boolean

GetCursorPos myPoint
On Error Resume Next ' Bit of a cheat to handle case where control does not have an hWnd
OverWindow = (ctlControl.hWnd = WindowFromPoint(myPoint.X, myPoint.Y))
On Error GoTo 0

If OverWindow Then
SetCapture ctlControl.hWnd
RollOver = RollIn
Else
ReleaseCapture
RollOver = RollOut
End If

End Function

as for the sub, I know where to use it.

Do I have to put them in different places, because it didn't work when I just paste it and do the changes I need..

Thanks

 

[bahakh]

strongm. Don't worry about my question above, I figured out the solution, thanks for the code

 

[strongm]

Excellent

 

[bahakh]

strongm, as I mentioned before, the code u wrote work fine, except for one thing that I need to ask about, its not only with your code but with most mousemove functions that I tired... The problem is that the buttons usually don't run from the first click, what happens is that I see the focus on the button after the first click, and then the second click make it run (sometimes even the third, and sometimes the first)... Is there any reason for that ? And do u have the same problem ?

Thanks A lot

 

[trangtv]

Strongm, if I use one command box and one image box, it works. However when I try to use one image box and one label it does not work properly, when I move the mouse into the image, the label's caption changes(what I want) but when I move the mouse out the image, nothing happens(label's caption should be change to another text), Please help me. Thanks.

 

[CubeE101]

strongm,
You should make this into a FAQ...

In the mean time, have a star... ;-)

Have Fun, Be Young... Code BASIC
-Josh

http://cubee.topcities.com

PROGRAMMER: Red-eyed, mumbling mammal capable of conversing with inanimate objects.

 

[HughLerwill]

strongm,

That's a beauty, another star.

regards Hugh