ballon toltip..

In this project are present many circle-shape colored yellow (are the province of region).
When the mouse go on one of that the shape change color in red. and appear in REGIONE and in FILIALE CAPOFILA the name of region and name of province.
Now with mouse move effect on all shape is possible to show also the ballon toltip with the name of region in first line and name of province in second line...
In the zip file i have found example of toltip ballon very simple but it work only on textbox, label and i cannot use in mouse event.
Hope my qst is clear.

Since Shape control doesn't respond to MouseMove you may use Timer and few APIs.
Here is a sample that's written for ComboBox but it's basically the same:

Code:

---

Option Explicit

Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

Private Sub Form_Load()
    Timer1.Enabled = True
    Timer1.Interval = 100 '1/10 of a second
End Sub

Private Sub Timer1_Timer()
'==================================
Dim Rec As RECT, Point As POINTAPI
Dim cbOpen As Boolean

    DoEvents
    GetWindowRect Combo1.hwnd, Rec
    GetCursorPos Point
    'check if cursor is over combobox
    If Point.X >= Rec.Left And Point.X <= Rec.Right And Point.Y >= Rec.Top And Point.Y <= Rec.Bottom Then
        Text1.Text = "MousePointer is over Combobox"
    Else
        Text1.Text = "MousePointer is outside Combobox"
    End If

End Sub

---

Another option is to not use the shape control. Use a graphics program (PhotoEditor or others that support transparency), create a circle with transparent background and save as gif. Use that gif in an Image control. Image controls support MouseMove events.

Quote:

---

Originally Posted by RhinoBull

Since Shape control doesn't respond to MouseMove you may use Timer and few APIs.
Here is a sample that's written for ComboBox but it's basically the same:

Code:

---

Option Explicit

Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

Private Sub Form_Load()
    Timer1.Enabled = True
    Timer1.Interval = 100 '1/10 of a second
End Sub

Private Sub Timer1_Timer()
'==================================
Dim Rec As RECT, Point As POINTAPI
Dim cbOpen As Boolean

    DoEvents
    GetWindowRect Combo1.hwnd, Rec
    GetCursorPos Point
    'check if cursor is over combobox
    If Point.X >= Rec.Left And Point.X <= Rec.Right And Point.Y >= Rec.Top And Point.Y <= Rec.Bottom Then
        Text1.Text = "MousePointer is over Combobox"
    Else
        Text1.Text = "MousePointer is outside Combobox"
    End If

End Sub

---

---

Hi! tks for suggestion...
I have create a userform with combo1.
But during the debug with PF8 the code go in error in:
Private Sub Form_Load()
Timer1.Enabled = True'''''variable not defined
Timer1.Interval = 100 '1/10 of a second
End Sub

Quote:

---

Originally Posted by LaVolpe

Another option is to not use the shape control. Use a graphics program (PhotoEditor or others that support transparency), create a circle with transparent background and save as gif. Use that gif in an Image control. Image controls support MouseMove events.

---

WOW La Volpe post a solution for me, very happy.!!!!
I know you about PSC i am meber from 2003... tks for you code on PSC!

But in effect not is possible to show tolltip ballon when code go in first condition and close when cod eintercept Else statement... I use this part of code:
If TPOS.X >= 420 And TPOS.X <= 430 And TPOS.Y >= 345 And TPOS.Y <= 355 Then
Me.Text2.Text = " " & "NAPOLI"
'here command to show tolitip balloon
Me.Shape1.FillColor = vbRed
Me.Label5.Caption = " " & "CAMPANIA": Exit Sub
Else
'here command to close tolitip balloon
Me.Shape1.FillColor = vbYellow
Me.Label5.Caption = ""
Me.Text2.Text = ""
End If

I think is very simple to run my code to undestand my qstion.

If you have only two colors for the circles, try using these gifs. Add them to image control and set image control stretch=True. Size as needed.

Yes, you will have problems changing the colors when you exit the circle, if the user exits very quickly. There are many techniques to overcome this problem. The easiest, for windowless controls, is to set a timer when you enter the circle and when you exit the circle, stop the timer. If the circle is exited without your mousemove knowing it, that is where the timer helps. In the timer event, check to see if the mouse coordinates are still in the circle, if not, then stop the timer and change your circle color.

Here are the circle GIFs, if you decide to use Image controls vs shape controls.

Luca, here is an example of using the timer with image controls
1. In a new project and on a new form...
a. Add 1 image control. Name it imgRed. Add one of the red circle gifs to it
b. Add 1 image control. Name it imgYellow. Add one of the yellow circle gifs
c. Add 2 image controls: Name them Image1(0) and Image1(1)
d. Add a timer. Name is Timer1
2. Copy and paste this code to the form

Code:

---

Option Explicit
Private Declare Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32.dll" (ByVal hwnd As Long, ByRef lpPoint As POINTAPI) As Long
Private Type POINTAPI
    x As Long
    y As Long
End Type


Private Sub Form_Load()
    Dim X As Long
    imgRed.Visible = False
    imgYellow.Visible = False
    Timer1.Enabled = False
    Timer1.Interval = 200
    For X = Image1.LBound To Image1.UBound
        Image1(X) = imgYellow
    Next
End Sub

Private Sub Image1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If Image1(Index).Tag = "" Then
        If Timer1.Tag <> "" Then    ' previous circle hasn't changed colors
            Timer1.Enabled = False  ' stop timer
            Image1(Timer1.Tag).Tag = "" ' reset timer tag
            Image1(Timer1.Tag) = imgYellow ' change circle
        End If
        Image1(Index) = imgRed  ' change this circle
        Image1(Index).Tag = "R" ' set tag as flag it is changed
        Timer1.Tag = Index      ' set timer tag to this circle index
        Timer1.Enabled = True  ' enable the timer
        ' show balloon tip
    End If
End Sub

Private Sub Timer1_Timer()
    Dim mousePT As POINTAPI, Index As Integer
    GetCursorPos mousePT                ' get mouse coords
    ScreenToClient Me.hwnd, mousePT    ' convert to form coords
    mousePT.x = ScaleX(mousePT.x, vbPixels, Me.ScaleMode) ' convert to form scalemode
    mousePT.y = ScaleY(mousePT.y, vbPixels, Me.ScaleMode)
    Index = Val(Timer1.Tag)            ' index of active circle
    ' see if in image coords
    If mousePT.x < Image1(Index).Left Or mousePT.y < Image1(Index).Top Then
        Timer1.Enabled = False
    ElseIf mousePT.x > Image1(Index).Left + Image1(Index).Width Then
        Timer1.Enabled = False
    ElseIf mousePT.y > Image1(Index).Top + Image1(Index).Height Then
        Timer1.Enabled = False
    End If
    If Timer1.Enabled = False Then  ' outside of image
        Timer1.Tag = ""            ' reset flag
        Image1(Index) = imgYellow  ' change to yellow
        Image1(Index).Tag = ""      ' reset image tag
    End If
   
End Sub

---

Now move your cursor over the circles.

Quote:

---

Originally Posted by luca90

Hi! tks for suggestion...
I have create a userform with combo1.
But during the debug with PF8 the code go in error in:
Private Sub Form_Load()
Timer1.Enabled = True'''''variable not defined
Timer1.Interval = 100 '1/10 of a second
End Sub

---

Wasn't it obvious that you needed a Timer control? :confused:

Quote:

---

Originally Posted by LaVolpe

Luca, here is an example of using the timer with image controls
1. In a new project and on a new form...
a. Add 1 image control. Name it imgRed. Add one of the red circle gifs to it
b. Add 1 image control. Name it imgYellow. Add one of the yellow circle gifs
c. Add 2 image controls: Name them Image1(0) and Image1(1)
d. Add a timer. Name is Timer1
2. Copy and paste this code to the form

Code:

---

Option Explicit
Private Declare Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32.dll" (ByVal hwnd As Long, ByRef lpPoint As POINTAPI) As Long
Private Type POINTAPI
    x As Long
    y As Long
End Type


Private Sub Form_Load()
    Dim X As Long
    imgRed.Visible = False
    imgYellow.Visible = False
    Timer1.Enabled = False
    Timer1.Interval = 200
    For X = Image1.LBound To Image1.UBound
        Image1(X) = imgYellow
    Next
End Sub

Private Sub Image1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If Image1(Index).Tag = "" Then
        If Timer1.Tag <> "" Then    ' previous circle hasn't changed colors
            Timer1.Enabled = False  ' stop timer
            Image1(Timer1.Tag).Tag = "" ' reset timer tag
            Image1(Timer1.Tag) = imgYellow ' change circle
        End If
        Image1(Index) = imgRed  ' change this circle
        Image1(Index).Tag = "R" ' set tag as flag it is changed
        Timer1.Tag = Index      ' set timer tag to this circle index
        Timer1.Enabled = True  ' enable the timer
        ' show balloon tip
    End If
End Sub

Private Sub Timer1_Timer()
    Dim mousePT As POINTAPI, Index As Integer
    GetCursorPos mousePT                ' get mouse coords
    ScreenToClient Me.hwnd, mousePT    ' convert to form coords
    mousePT.x = ScaleX(mousePT.x, vbPixels, Me.ScaleMode) ' convert to form scalemode
    mousePT.y = ScaleY(mousePT.y, vbPixels, Me.ScaleMode)
    Index = Val(Timer1.Tag)            ' index of active circle
    ' see if in image coords
    If mousePT.x < Image1(Index).Left Or mousePT.y < Image1(Index).Top Then
        Timer1.Enabled = False
    ElseIf mousePT.x > Image1(Index).Left + Image1(Index).Width Then
        Timer1.Enabled = False
    ElseIf mousePT.y > Image1(Index).Top + Image1(Index).Height Then
        Timer1.Enabled = False
    End If
    If Timer1.Enabled = False Then  ' outside of image
        Timer1.Tag = ""            ' reset flag
        Image1(Index) = imgYellow  ' change to yellow
        Image1(Index).Tag = ""      ' reset image tag
    End If
   
End Sub

---

Now move your cursor over the circles.

---

Hi LaVolpe... (i dont know your really name, but you have a Italian parents?)
Can you attach a little project here?
Tks for patience... Pizza from Napoli!

That is the project. Follow the instructions I gave and paste the code in a new form.

P.S. I lived near Venice for 3 years. La Volpe is Italian translation of my English last name. I do have great-relatives from Sicilia.

Quote:

---

Originally Posted by LaVolpe

Luca, here is an example of using the timer with image controls
1. In a new project and on a new form...
a. Add 1 image control. Name it imgRed. Add one of the red circle gifs to it
b. Add 1 image control. Name it imgYellow. Add one of the yellow circle gifs
c. Add 2 image controls: Name them Image1(0) and Image1(1)
d. Add a timer. Name is Timer1
2. Copy and paste this code to the form

Code:

---

Option Explicit
Private Declare Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32.dll" (ByVal hwnd As Long, ByRef lpPoint As POINTAPI) As Long
Private Type POINTAPI
    x As Long
    y As Long
End Type


Private Sub Form_Load()
    Dim X As Long
    imgRed.Visible = False
    imgYellow.Visible = False
    Timer1.Enabled = False
    Timer1.Interval = 200
    For X = Image1.LBound To Image1.UBound
        Image1(X) = imgYellow
    Next
End Sub

Private Sub Image1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If Image1(Index).Tag = "" Then
        If Timer1.Tag <> "" Then    ' previous circle hasn't changed colors
            Timer1.Enabled = False  ' stop timer
            Image1(Timer1.Tag).Tag = "" ' reset timer tag
            Image1(Timer1.Tag) = imgYellow ' change circle
        End If
        Image1(Index) = imgRed  ' change this circle
        Image1(Index).Tag = "R" ' set tag as flag it is changed
        Timer1.Tag = Index      ' set timer tag to this circle index
        Timer1.Enabled = True  ' enable the timer
        ' show balloon tip
    End If
End Sub

Private Sub Timer1_Timer()
    Dim mousePT As POINTAPI, Index As Integer
    GetCursorPos mousePT                ' get mouse coords
    ScreenToClient Me.hwnd, mousePT    ' convert to form coords
    mousePT.x = ScaleX(mousePT.x, vbPixels, Me.ScaleMode) ' convert to form scalemode
    mousePT.y = ScaleY(mousePT.y, vbPixels, Me.ScaleMode)
    Index = Val(Timer1.Tag)            ' index of active circle
    ' see if in image coords
    If mousePT.x < Image1(Index).Left Or mousePT.y < Image1(Index).Top Then
        Timer1.Enabled = False
    ElseIf mousePT.x > Image1(Index).Left + Image1(Index).Width Then
        Timer1.Enabled = False
    ElseIf mousePT.y > Image1(Index).Top + Image1(Index).Height Then
        Timer1.Enabled = False
    End If
    If Timer1.Enabled = False Then  ' outside of image
        Timer1.Tag = ""            ' reset flag
        Image1(Index) = imgYellow  ' change to yellow
        Image1(Index).Tag = ""      ' reset image tag
    End If
   
End Sub

---

Now move your cursor over the circles.

---

WOW!!!! Tks La Volpe, now all work perfect.
Pizza and Expresso coffe for you from Napoli.