Shape Events

[Imperceptus]

Is there any way to attatch events to Shapes such like

Code Select Expand


Private Sub Shape1_Click()

End Sub


I have thought about using a Image or PictureBox instead, but I need a control that has FillColor, BackColor, and BorderColor Properties.

Any Thoughts?

[Stealth]

Yes, you should be able to do that just fine.

Go to the code window and pull down the left menu at the top of that window. Choose your shape object, then select an event from the right menu and code away.

[Imperceptus]

Yes, you should be able to do that just fine.

Go to the code window and pull down the left menu at the top of that window. Choose your shape object, then select an event from the right menu and code away.

Sorry Shape dont have events.

But heres what I did do...  See is how my shapes are on a Frame ,note that HousePic is a Control array of Shapes.

Code Select Expand


Private Sub Frame2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim HouseIndex As Integer
FindClickedShapeIndex X, Y, HouseIndex
If HouseIndex = 10000 Then ' Just used for now to catch , going to make boolean later
Else
MsgBox HousePic(HouseIndex).Tag
End If
End Sub

Public Sub FindClickedShapeIndex(ByVal X As Integer, ByVal Y As Integer, ByRef ReturnedIndex As Integer)
'  X and Y are referenced to the Control that is Catching the MouseDown Event
Dim N As Integer

For N = 0 To MaxShapes
   With frmList.HousePic(N)
       If InShapeWidthRange(X, .Left, .Width, Y, .Top, .Height) = True Then ReturnedIndex = N: Exit Sub
   End With
Next N
ReturnedIndex = 10000

Public Function InShapeWidthRange(X As Integer, Left As Integer, Width As Integer, Y As Integer, Top As Integer, Height As Integer) As Boolean
' Need to Perform a Range Check Between 2 numbers
' THose two number need ak value to be between them
' Greater then the lowextreme, lesser then the highextreme
Dim WidthExtreme(1), HeightExtreme(1)
WidthExtreme(0) = Left
WidthExtreme(1) = Left + Width
HeightExtreme(0) = Top
HeightExtreme(1) = Top + Height
If WidthExtreme(0) < X And WidthExtreme(1) > X Then
   If HeightExtreme(0) < Y And HeightExtreme(1) > Y Then
   InShapeWidthRange = True: Exit Function
End If
End If
InShapeWidthRange = False
End Function



Works pretty good until i have shapes over lapping each other, but beyond that its a good start.

Edit :: spelling

[Grok]

If this is a professional project with a budget, and this is a required feature, you can buy a shapes library that has events.  Visio is one example, but I'm sure there are more.  For the most part, any need you ever have has been needed by other people, and solved hundreds of times over.  Some of those solutions are for sale or free.

[Imperceptus]

whats a professional project with a budget? You think im getting Paid for this? LoL.. I wish, would make it worth my time and frustration.