How do I get the XY coordinates for the center of a label that's located within a VB6 picturebox control?

I have a VB6 baseball game with outfielders and infielders represented by their names on labels on a baseball stadium image within a picturebox control. There's a white shape (ball) that moves toward the outfielders. I want to make the ball stop when it surpasses the XY coordinate of the outfielder label that the ball is traveling toward. The XY coordinate for the very center of a label would work best if I could get those values somehow. How can I do this?

I don't want to use the .top or the .left attributes of the labels to make the ball stop because then one has to always uses straight-oriented ballpark photos/images. If a ballpark image is from an angle, then the ball won't travel the full distance to the label if you use the .top or the .left attributes------which is what it does now.

I have found a number of examples showing how to get XY cursor position of the mouse, but none that show you how to get the XY position of a label relative to the picturebox control on which that label is located.

Many thanks.
LVL 4
jazjefAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

GrahamSkanRetiredCommented:
Start with this:
Dim LabelCentreX As Single
Dim LabelCentreY As Single
LabelCentreX = Label1.Left + Label1.Width / 2
LabelCentreY = Label1.Top + Label1.Height / 2

Open in new window

0
Martin LissOlder than dirtCommented:
The project in this article on collision detection will probably enable you to do what you want. The code is posted below. Note that the code doesn't set the backcolor of the form (black) and that you press Enter to have it show circles.

'**************************************************************
'
' THIS WORK, INCLUDING THE SOURCE CODE, DOCUMENTATION
' AND RELATED MEDIA AND DATA, IS PLACED INTO THE PUBLIC DOMAIN.
'
' THE ORIGINAL AUTHOR IS RYAN CLARK.
'
' THIS SOFTWARE IS PROVIDED AS-IS WITHOUT WARRANTY
' OF ANY KIND, NOT EVEN THE IMPLIED WARRANTY OF
' MERCHANTABILITY. THE AUTHOR OF THIS SOFTWARE,
' ASSUMES _NO_ RESPONSIBILITY FOR ANY CONSEQUENCE
' RESULTING FROM THE USE, MODIFICATION, OR
' REDISTRIBUTION OF THIS SOFTWARE.
'
'**************************************************************
'
' This file was downloaded from The Game Programming Wiki.
' Come and visit us at http://gpwiki.org
'
'**************************************************************

Option Explicit

'The "RECT" type required by the IntersectRect API call
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

'Our API calls
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function IntersectRect Lib "user32" (lpDestRect As RECT, lpSrc1Rect As RECT, lpSrc2Rect As RECT) As Long

Const MS_DELAY = 25         'Milliseconds each frame
Const RADIUS1 = 30          'Radius of our first circle
Const RADIUS2 = 20          'Radius of our second circle
Const RECT_WIDTH = 80       'Width of our rectangles
Const RECT_HEIGHT = 60      'Height of our rectangles

Dim msngCircle1X As Single  'Current X coordinate of the 1st circle
Dim msngCircle1Y As Single  'Current Y coordinate of the 1st circle
Dim msngCircle2X As Single  'Current X coordinate of the 2nd circle
Dim msngCircle2Y As Single  'Current Y coordinate of the 2nd circle
Dim mudtRect1 As RECT       'Our first rectangle
Dim mudtRect2 As RECT       'Our second rectangle

Dim mblnCircles As Boolean  'Are we displaying the circles...
Dim mblnRects As Boolean    '...or the rectangles?
Dim mblnCollision As Boolean    'Is there a collision?

Dim mlngTimer As Long       'Holds system time since last frame was displayed
Dim mblnRunning As Boolean  'Is the render loop running?
Dim mblnLeftKey As Boolean  'Is the left arrow-key depressed?
Dim mblnRightKey As Boolean 'Is the right arrow-key depressed?
Dim mblnDownKey As Boolean  'Is the down arrow-key depressed?
Dim mblnUpKey As Boolean    'Is the up arrow-key depressed?

Private Sub Form_Load()

    'Randomize the locations (just for fun)
    Randomize
    msngCircle1X = (Rnd() * frmMain.ScaleWidth / 2) + frmMain.ScaleWidth / 4
    msngCircle1Y = (Rnd() * frmMain.ScaleHeight / 2) + frmMain.ScaleHeight / 4
    msngCircle2X = (Rnd() * frmMain.ScaleWidth / 2) + frmMain.ScaleWidth / 4
    msngCircle2Y = (Rnd() * frmMain.ScaleHeight / 2) + frmMain.ScaleHeight / 4
    With mudtRect1
        .Top = (Rnd() * frmMain.ScaleHeight / 2) + frmMain.ScaleHeight / 4
        .Left = (Rnd() * frmMain.ScaleWidth / 2) + frmMain.ScaleWidth / 4
        .Bottom = .Top + RECT_HEIGHT
        .Right = .Left + RECT_WIDTH
    End With
    With mudtRect2
        .Top = (Rnd() * frmMain.ScaleHeight / 2) + frmMain.ScaleHeight / 4
        .Left = (Rnd() * frmMain.ScaleWidth / 2) + frmMain.ScaleWidth / 4
        .Bottom = .Top + RECT_HEIGHT
        .Right = .Left + RECT_WIDTH
    End With
    
    'Display the rectangles first
    mblnRects = True
    
    'Show the form
    Me.Show
    
    'Start the render loop
    mblnRunning = True
    Do While mblnRunning
        'Check if we've waited for the appropriate number of milliseconds
        If mlngTimer + MS_DELAY <= GetTickCount() Then
            'Reset the timer
            mlngTimer = GetTickCount()
            'Clear the form
            frmMain.Cls
            'Display the circles...
            If mblnCircles Then
                'Check for collision
                CircleCollision
                'Move the circle
                MoveCircle
                'Display the circles
                DrawCircle msngCircle1X, msngCircle1Y, RADIUS1, vbWhite
                'Display RED if there is a collision
                If mblnCollision Then
                    DrawCircle msngCircle2X, msngCircle2Y, RADIUS2, vbRed
                Else
                    DrawCircle msngCircle2X, msngCircle2Y, RADIUS2, vbWhite
                End If
            'Display the rectangles...
            ElseIf mblnRects Then
                'Check for collision
                RectCollision
                'Move the rectangle
                MoveRect
                'Display the rectangles
                DrawRect mudtRect1, vbWhite
                'Display RED if there is a collision
                If mblnCollision Then
                    DrawRect mudtRect2, vbRed
                Else
                    DrawRect mudtRect2, vbWhite
                End If
            End If
        End If
        'Let windows do some stuff...
        DoEvents
    Loop

End Sub

Private Sub MoveCircle()

    'Move the circle around...
    If mblnDownKey = True Then msngCircle1Y = msngCircle1Y + 1
    If mblnUpKey = True Then msngCircle1Y = msngCircle1Y - 1
    If mblnLeftKey = True Then msngCircle1X = msngCircle1X - 1
    If mblnRightKey = True Then msngCircle1X = msngCircle1X + 1

End Sub

Private Sub MoveRect()

    'Move the rectangle around
    With mudtRect1
        If mblnDownKey = True Then
            .Top = .Top + 1
            .Bottom = .Bottom + 1
        End If
        If mblnUpKey = True Then
            .Top = .Top - 1
            .Bottom = .Bottom - 1
        End If
        If mblnLeftKey = True Then
            .Left = .Left - 1
            .Right = .Right - 1
        End If
        If mblnRightKey = True Then
            .Left = .Left + 1
            .Right = .Right + 1
        End If
    End With

End Sub

Private Sub CircleCollision()

    'Check for circle collision
    mblnCollision = GetDist(msngCircle1X, msngCircle1Y, msngCircle2X, msngCircle2Y) <= RADIUS1 + RADIUS2

End Sub

Private Sub RectCollision()

Dim udtTempRect As RECT     'The IntersectRect call will return a rectangle equal in size to the intersection between our two rectangles... but we don't really need this data here

    'Check for rectangle collision
    mblnCollision = IntersectRect(udtTempRect, mudtRect1, mudtRect2)

End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

    'Check for keypresses
    If KeyCode = vbKeyLeft Then mblnLeftKey = True
    If KeyCode = vbKeyRight Then mblnRightKey = True
    If KeyCode = vbKeyUp Then mblnUpKey = True
    If KeyCode = vbKeyDown Then mblnDownKey = True
    
    'If the user presses enter, switch between circles and rects
    If KeyCode = vbKeyReturn Then
        mblnCircles = Not (mblnCircles)
        mblnRects = Not (mblnRects)
    End If

End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)

    'Check for keyreleases
    If KeyCode = vbKeyLeft Then mblnLeftKey = False
    If KeyCode = vbKeyRight Then mblnRightKey = False
    If KeyCode = vbKeyUp Then mblnUpKey = False
    If KeyCode = vbKeyDown Then mblnDownKey = False

End Sub

Private Sub DrawRect(rectSource As RECT, lngColour As Long)

    'Draw the given rectangle
    Line (rectSource.Left, rectSource.Top)-(rectSource.Left, rectSource.Bottom), lngColour
    Line (rectSource.Left, rectSource.Top)-(rectSource.Right, rectSource.Top), lngColour
    Line (rectSource.Right, rectSource.Bottom)-(rectSource.Right, rectSource.Top), lngColour
    Line (rectSource.Right, rectSource.Bottom)-(rectSource.Left, rectSource.Bottom), lngColour

End Sub

Private Sub DrawCircle(sngX As Single, sngY As Single, sngRadius As Single, lngColour As Long)

    'Draw the given circle
    
    Circle (sngX, sngY), sngRadius, lngColour

End Sub

Private Function GetDist(intX1 As Single, intY1 As Single, intX2 As Single, intY2 As Single) As Single

    'Return the distance between the two points (I love you, Mr. Pythagoras)
    GetDist = Sqr((intX1 - intX2) ^ 2 + (intY1 - intY2) ^ 2)

End Function

Private Sub Form_Unload(Cancel As Integer)
    
    'Terminate the render loop
    mblnRunning = False

End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Martin LissOlder than dirtCommented:
I've requested that this question be closed as follows:

Accepted answer: 500 points for Martin Liss's comment #a40828861

for the following reason:

This question has been classified as abandoned and is closed as part of the Cleanup Program. See the recommendation for more details.
0
jazjefAuthor Commented:
This solution works----I had to learn a lot, and then try to implement it. The learning was easy, but getting it configured was harder.... but I have it working pretty well. Thanks. [I was on vacation---that's why I couldn't respond as quickly]
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.