Hi All !
Could this code be successfully converted to work in PowerPoint?
It's intended to make a shape smoothly follow the mouse cursor. I've been trying to transcribe it for hours but I'm afraid it's over my head. Any help or alternatives to getting a shape to follow the mouse cursor would be much appreciated. Thank you for your consideration!
'Option Explicit
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Sub MouseMoveObjectTest()
Dim lngCurPos As POINTAPI
Dim DocZero As POINTAPI
Dim PointsPerPixelY As Double
Dim PointsPerPixelX As Double
Dim hdc As Long
For Each sp In Worksheets("Sheet1").Shapes
sp.Delete
Next
Set a = Worksheets("Sheet1").Shapes.AddShape(92, 50, 50, 20, 20)
a.Name = "Oval2"
a.Fill.ForeColor.SchemeColor = False
hdc = GetDC(0)
PointsPerPixelY = 72 / GetDeviceCaps(hdc, 90)
PointsPerPixelX = 72 / GetDeviceCaps(hdc, 88)
ReleaseDC 0, hdc
DocZero.Y = ActiveWindow.PointsToScreenPixelsY(0)
DocZero.X = ActiveWindow.PointsToScreenPixelsX(0)
Do
GetCursorPos lngCurPos
' Find the Center of the Stationary and Moving Object
CenterRowStationary = (lngCurPos.Y - DocZero.Y) * PointsPerPixelY
CenterColStationary = (lngCurPos.X - DocZero.X) * PointsPerPixelX
CenterRowMoving = Shapes("Oval2").Top + Shapes("Oval2").Height / 2
CenterColMoving = Shapes("Oval2").Left + Shapes("Oval2").Width / 2
MovementSpeed = 1.25
' Now comes the hard part. I want the object to follow a straight path to the stationary
' object, so I will need to use Right Triangle Math to do this.
' First, I need to determine the Hypotenus of the Right Triangle give the height and width
' of the right triangle
TriangleHeight = Abs(CenterRowStationary - CenterRowMoving)
TriangleWidth = Abs(CenterColStationary - CenterColMoving)
TriangleHyp = Sqr(TriangleHeight ^ 2 + TriangleWidth ^ 2)
' Ok, now I will need to use the movement speed (which is the hypotenuse of a smaller
' right triangle within the larger right triangle above) to determine the height and width
' of this new triangle. These values are directly proportional to the values in the above
' triangle.
If TriangleHeight = 0 Then
NewTriangleHeight = 0
Else
NewTriangleHeight = (TriangleHeight / TriangleHyp) * MovementSpeed
End If
If TriangleWidth = 0 Then
NewTriangleWidth = 0
Else
NewTriangleWidth = (TriangleWidth / TriangleHyp) * MovementSpeed
End If
' These new values are the row and column adjustment factors we will use to move
' the object.
With Shapes("Oval2")
If (.Top + Shapes("Oval2").Height / 2) > CenterRowStationary Then .Top = .Top - NewTriangleHeight
If (.Top + Shapes("Oval2").Height / 2) < CenterRowStationary Then .Top = .Top + NewTriangleHeight
If (.Left + Shapes("Oval2").Width / 2) > CenterColStationary Then .Left = .Left - NewTriangleWidth
If (.Left + Shapes("Oval2").Width / 2) < CenterColStationary Then .Left = .Left + NewTriangleWidth
End With
DoEvents
Loop
End Sub