Solved

Orbit around an Object in Delphi

Posted on 2001-06-26
5
693 Views
Last Modified: 2013-12-26
Can someone help me with some instructions/formulas or better a sample code on how to make an object circle around another (in a circular orbit).

Ex. think of the moon around the earth. How do I make  the moon to move/orbit around the earth?

I already designed a primitive sample but what I get is a diamond-type orbit not a arounded or elliptical orbit.

I'm using Delphi 4.0/5.0 but I also know Visual basic

Please Help me.
0
Comment
Question by:Omarmartnz
  • 3
5 Comments
 
LVL 3

Accepted Solution

by:
HDE226868 earned 300 total points
ID: 6244244
For the first approximation I suggest You use circular movemet only. In that case all of the phisics and maths You need to understand is as follows:

*** gravitation force:

F = k*mc*ms/(r*r)
 k=gravitational constant
 mc = mass of the central object
 ms = mass of the orbiting object
 r = distance between them


*** force that pulls object away (because of the speed)
(sorry I don't know English expression - should be something like centrifugal force)

F = ms*w*w/r
 w = angular velocity

If You combine these two equatations You get:

w = squareroot(k*mc/(r*r*r))


*** some trigonometry

You need to find the center of each object (objects do not circulate around their top-left corners)

(in the example I dont't work with mass centre, but with the centre of the central object - this is not completely accurate, as You can make heavier object to orbit a lighter one, but since central objects are ussualy much morre massive than their sattelites, it looks nice enough - for instance in moon/earth system, mass centre is about 2000 km under earths surface and some 4000 km above earths centre)

Position of each objects centre is:
Position of the mass centre for each dimension + its position on the orbit.

x = x_central + (distance * cos(current_angle))
y = y_central + (distance * sin(current_angle))



*** Example

Next example is in VB.
The way it works:
 Objects (buttons, textboxes, labels, etc) are placed on the window
 You set one of these objects as a central object (see Private Sub Command1_Click)
 You set other objects as a satelittes or planets (see Private Sub Command1_Click)

Example works so that it calculates starting positions of all objects and make them orbit each other. It allows maximum of 100 objects, but You can change this number by changning constant OBJECT_NUMBER. Speed of objects is determined by a constant GRAV_CONST. Raise it and all objects will move faster and vice versa. Also You can ghange speeds of objects by changing mass of each central object. Functions allow more levels of orbiting (sun - planets - moons - ...). If You rise the mass of a planet, all of its moons will move faster.

There are two parts of the program:
- First part is used at start and You use it to define ralations between objects. Sun does not move and You define it with place_sun function. You need to tell it which object on the window is it and its mass. Planets, moons, etc are placed using place_satelitte function. This also tells which object satelitte orbits.

- Second part is used to move the objects



To make this example work You start a VB project and create a preety big form and one module. You place two textboxes named Text1 and Text2, one command button named Command1, one label named Label1 and one timer named Timer1).


You need to put this code into the form:

Private Sub Command1_Click()
Dim i As Integer
Dim j As Integer
 
'set textbox 1 as the sun
  i = place_sun(5000000, Text1)
 
'set textbox 2 as a planet
  j = place_satelitte(300000, Text2, i)
 
'set label 1 as a satelitte of the first planet
  j = place_satelitte(3, Label1, j)
 
'set command button 1 as a planet
  j = place_satelitte(3, Command1, i)
  Timer1.Enabled = True
End Sub

Private Sub Form_Load()
  Timer1.Enabled = False
  Timer1.Interval = 10
End Sub

Private Sub Timer1_Timer()
  move_all_objects
  paint_all_objects
End Sub



And You need to put this code into the module:

Public Const GRAV_CONST As Double = 1000
Public Const OBJECT_NUMBER As Integer = 100
Public Const PI_CONST As Double = 3.14159265358979

Type satelitte_type
  window_object As Object
  center_x As Long
  center_y As Long
  central_offset_x As Long
  central_offset_y As Long
  parent As Integer 'index of the object, this object orbits around
  distance As Double
  angle As Double
  mass As Long
  ang_vel As Double
  used As Boolean
  is_moving As Boolean
End Type

Dim objects(1 To OBJECT_NUMBER) As satelitte_type

'***************************************
' Functions used at initialisation
'***************************************

Function calc_angle(coor_x As Long, coor_y As Long) As Double
'Calculates starting angle between the two objects

  If coor_x = 0 Then

'first take care of divisions by zero, if x coordinate is zero,
'angle can only be 90 or 270 degrees
    If coor_y > 0 Then
      calc_angle = 90
    Else
      calc_angle = 270
    End If
  Else
 
'otherwise angle is determined as inverse tangent of coordinates
    calc_angle = (Atn(coor_y / coor_x)) * 180 / PI_CONST
  End If
 
'this is only valid for two quadrants (for right side of the coordinate system)
  If coor_x < 0 Then
    calc_angle = calc_angle + 180
  End If
  If calc_angle < 0 Then
 
'looks better if all numberes are positive
    calc_angle = calc_angle + 360
  End If
End Function

Function calc_distance(dist_x As Long, dist_y As Long) As Double
'Calculates distance between two objects

'Pitagora
  calc_distance = Sqr((dist_x * dist_x) + (dist_y * dist_y))
End Function

Function calc_gravity(central_mass As Long, distance As Double) As Double
'Calculates velocity caused by gravitational pull

  calc_gravity = Sqr((GRAV_CONST * central_mass) / (distance * distance * distance))
End Function

Function place_sun(mass As Long, object_handle As Object) As Integer
Dim sun_index As Integer
 
  sun_index = find_next_free_object
  If sun_index = 0 Then
    MsgBox "Too many objects"
    Exit Function
  End If
  place_sun = sun_index
  Set objects(sun_index).window_object = object_handle
  objects(sun_index).used = True
  objects(sun_index).is_moving = False
  objects(sun_index).center_x = object_handle.Left + (object_handle.Width / 2)
  objects(sun_index).center_y = object_handle.Top + (object_handle.Height / 2)
  objects(sun_index).central_offset_x = object_handle.Width / 2
  objects(sun_index).central_offset_y = object_handle.Height / 2
  objects(sun_index).mass = mass
End Function

Function place_satelitte(mass As Long, object_handle As Object, parent_object As Integer) As Integer
Dim sat_index As Integer
 
  sat_index = find_next_free_object
  If sat_index = 0 Then
    MsgBox "Too many objects"
    Exit Function
  End If
  place_satelitte = sat_index
  Set objects(sat_index).window_object = object_handle
  objects(sat_index).used = True
  objects(sat_index).is_moving = True
  objects(sat_index).parent = parent_object
  objects(sat_index).center_x = object_handle.Left + (object_handle.Width / 2)
  objects(sat_index).center_y = object_handle.Top + (object_handle.Height / 2)
  objects(sat_index).central_offset_x = object_handle.Width / 2
  objects(sat_index).central_offset_y = object_handle.Height / 2
  objects(sat_index).mass = mass
  objects(sat_index).distance = calc_distance(objects(sat_index).center_x - objects(parent_object).center_x, objects(sat_index).center_y - objects(parent_object).center_y)
  objects(sat_index).angle = calc_angle(objects(sat_index).center_x - objects(parent_object).center_x, objects(sat_index).center_y - objects(parent_object).center_y)
  objects(sat_index).ang_vel = calc_gravity(objects(parent_object).mass, objects(sat_index).distance)
End Function

Private Function find_next_free_object() As Integer
'Where to put current object into objects structure (which index to give it)
Dim i As Integer
 
  For i = 1 To OBJECT_NUMBER
    If objects(i).used = False Then
      find_next_free_object = i
      Exit Function
    End If
  Next i
  find_next_free_object = 0
End Function




'****************************************
' Functions needed for movement
'****************************************

Sub move_all_objects()
'change coordinates of all objects
Dim i As Integer
 
  For i = 1 To OBJECT_NUMBER
 
'move only defined objects
    If objects(i).used = True Then
   
'don't move the sun
      If objects(i).is_moving = True Then
        objects(i).angle = objects(i).angle + objects(i).ang_vel
       
'degrees are used, but cos and sin use radians
        objects(i).center_x = objects(objects(i).parent).center_x + (objects(i).distance * Cos((objects(i).angle) * PI_CONST / 180))
        objects(i).center_y = objects(objects(i).parent).center_y + (objects(i).distance * Sin((objects(i).angle) * PI_CONST / 180))
      End If
    End If
  Next i
End Sub

Sub paint_all_objects()
'put all objects to the screen
Dim i As Integer
 
  For i = 1 To OBJECT_NUMBER
 
'move only defined objects
    If objects(i).used = True Then
   
'don't move the sun
      If objects(i).is_moving = True Then
        objects(i).window_object.Top = objects(i).center_y - objects(i).central_offset_y
        objects(i).window_object.Left = objects(i).center_x - objects(i).central_offset_x
      End If
    End If
  Next i
End Sub

0
 
LVL 3

Expert Comment

by:HDE226868
ID: 6244251
Sorry I forgot to tell, taht You start the example by pressing command button.

Feel free to add more objects.
0
 
LVL 3

Expert Comment

by:HDE226868
ID: 6244281
I tried now to make a simple planetarium
This is complete code. You need to place it into a balnk text document (notepad) and then save it as form1. frm and module1.bas. Then You open a VB project, erase starting form and load these two files (one form and one module).
Module part is the same as before, so You can only load the form.

***** form1.frm *************

VERSION 5.00
Begin VB.Form Form1
   BackColor       =   &H80000007&
   Caption         =   "Form1"
   ClientHeight    =   9315
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   11040
   LinkTopic       =   "Form1"
   ScaleHeight     =   9315
   ScaleWidth      =   11040
   StartUpPosition =   3  'Windows Default
   Begin VB.Timer Timer1
      Left            =   7920
      Top             =   4620
   End
   Begin VB.CommandButton Command1
      Caption         =   "Start"
      Height          =   495
      Left            =   180
      TabIndex        =   0
      Top             =   2160
      Width           =   1215
   End
   Begin VB.Shape Shape8
      BorderColor     =   &H0000FFFF&
      BorderStyle     =   0  'Transparent
      FillColor       =   &H00E0E0E0&
      FillStyle       =   0  'Solid
      Height          =   135
      Left            =   3660
      Shape           =   3  'Circle
      Top             =   2580
      Width           =   135
   End
   Begin VB.Shape Shape7
      BorderColor     =   &H0000FFFF&
      BorderStyle     =   0  'Transparent
      FillColor       =   &H00E0E0E0&
      FillStyle       =   0  'Solid
      Height          =   135
      Left            =   3900
      Shape           =   3  'Circle
      Top             =   2400
      Width           =   135
   End
   Begin VB.Shape Shape6
      BorderColor     =   &H0000FFFF&
      BorderStyle     =   0  'Transparent
      FillColor       =   &H000000FF&
      FillStyle       =   0  'Solid
      Height          =   435
      Left            =   3540
      Shape           =   3  'Circle
      Top             =   2760
      Width           =   435
   End
   Begin VB.Shape Shape5
      BorderColor     =   &H0000FFFF&
      BorderStyle     =   0  'Transparent
      FillColor       =   &H00E0E0E0&
      FillStyle       =   0  'Solid
      Height          =   255
      Left            =   5220
      Shape           =   3  'Circle
      Top             =   3600
      Width           =   255
   End
   Begin VB.Shape Shape4
      BorderColor     =   &H0000FFFF&
      BorderStyle     =   0  'Transparent
      FillColor       =   &H00FF0000&
      FillStyle       =   0  'Solid
      Height          =   555
      Left            =   4800
      Shape           =   3  'Circle
      Top             =   3960
      Width           =   555
   End
   Begin VB.Shape Shape3
      BorderColor     =   &H0000FFFF&
      BorderStyle     =   0  'Transparent
      FillColor       =   &H0080C0FF&
      FillStyle       =   0  'Solid
      Height          =   495
      Left            =   5820
      Shape           =   3  'Circle
      Top             =   4980
      Width           =   495
   End
   Begin VB.Shape Shape2
      BorderColor     =   &H0000FFFF&
      BorderStyle     =   0  'Transparent
      FillColor       =   &H00E0E0E0&
      FillStyle       =   0  'Solid
      Height          =   315
      Left            =   6540
      Shape           =   3  'Circle
      Top             =   5700
      Width           =   315
   End
   Begin VB.Shape Shape1
      BackStyle       =   1  'Opaque
      BorderColor     =   &H0000FFFF&
      FillColor       =   &H0000FFFF&
      FillStyle       =   0  'Solid
      Height          =   1095
      Left            =   6840
      Shape           =   3  'Circle
      Top             =   6000
      Width           =   1095
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
Dim i As Integer
Dim j As Integer
Dim k As Integer
 
'set sun
 i = place_sun(5000000, Shape1)
 
'set mercury
 j = place_satelitte(100000, Shape2, i)
 
'set venus
 j = place_satelitte(250000, Shape3, i)

'set earth
 j = place_satelitte(300000, Shape4, i)

'set moon
 j = place_satelitte(3, Shape5, j)
 
'set mars
 j = place_satelitte(200000, Shape6, i)

'set fobos
 k = place_satelitte(3, Shape7, j)

'set demios
 k = place_satelitte(3, Shape8, j)
 
 Timer1.Enabled = True
End Sub

Private Sub Form_Load()
 Timer1.Enabled = False
 Timer1.Interval = 10
End Sub

Private Sub Timer1_Timer()
 move_all_objects
 paint_all_objects
End Sub




****** Module1.bas *****

Attribute VB_Name = "Module1"
Public Const GRAV_CONST As Double = 1000
Public Const OBJECT_NUMBER As Integer = 100
Public Const PI_CONST As Double = 3.14159265358979

Type satelitte_type
 window_object As Object
 center_x As Long
 center_y As Long
 central_offset_x As Long
 central_offset_y As Long
 parent As Integer 'index of the object, this object orbits around
 distance As Double
 angle As Double
 mass As Long
 ang_vel As Double
 used As Boolean
 is_moving As Boolean
End Type

Dim objects(1 To OBJECT_NUMBER) As satelitte_type

'***************************************
' Functions used at initialisation
'***************************************

Function calc_angle(coor_x As Long, coor_y As Long) As Double
'Calculates starting angle between the two objects

 If coor_x = 0 Then

'first take care of divisions by zero, if x coordinate is zero,
'angle can only be 90 or 270 degrees
   If coor_y > 0 Then
     calc_angle = 90
   Else
     calc_angle = 270
   End If
 Else
 
'otherwise angle is determined as inverse tangent of coordinates
   calc_angle = (Atn(coor_y / coor_x)) * 180 / PI_CONST
 End If
 
'this is only valid for two quadrants (for right side of the coordinate system)
 If coor_x < 0 Then
   calc_angle = calc_angle + 180
 End If
 If calc_angle < 0 Then
 
'looks better if all numberes are positive
   calc_angle = calc_angle + 360
 End If
End Function

Function calc_distance(dist_x As Long, dist_y As Long) As Double
'Calculates distance between two objects

'Pitagora
 calc_distance = Sqr((dist_x * dist_x) + (dist_y * dist_y))
End Function

Function calc_gravity(central_mass As Long, distance As Double) As Double
'Calculates velocity caused by gravitational pull

 calc_gravity = Sqr((GRAV_CONST * central_mass) / (distance * distance * distance))
End Function

Function place_sun(mass As Long, object_handle As Object) As Integer
Dim sun_index As Integer
 
 sun_index = find_next_free_object
 If sun_index = 0 Then
   MsgBox "Too many objects"
   Exit Function
 End If
 place_sun = sun_index
 Set objects(sun_index).window_object = object_handle
 objects(sun_index).used = True
 objects(sun_index).is_moving = False
 objects(sun_index).center_x = object_handle.Left + (object_handle.Width / 2)
 objects(sun_index).center_y = object_handle.Top + (object_handle.Height / 2)
 objects(sun_index).central_offset_x = object_handle.Width / 2
 objects(sun_index).central_offset_y = object_handle.Height / 2
 objects(sun_index).mass = mass
End Function

Function place_satelitte(mass As Long, object_handle As Object, parent_object As Integer) As Integer
Dim sat_index As Integer
 
 sat_index = find_next_free_object
 If sat_index = 0 Then
   MsgBox "Too many objects"
   Exit Function
 End If
 place_satelitte = sat_index
 Set objects(sat_index).window_object = object_handle
 objects(sat_index).used = True
 objects(sat_index).is_moving = True
 objects(sat_index).parent = parent_object
 objects(sat_index).center_x = object_handle.Left + (object_handle.Width / 2)
 objects(sat_index).center_y = object_handle.Top + (object_handle.Height / 2)
 objects(sat_index).central_offset_x = object_handle.Width / 2
 objects(sat_index).central_offset_y = object_handle.Height / 2
 objects(sat_index).mass = mass
 objects(sat_index).distance = calc_distance(objects(sat_index).center_x - objects(parent_object).center_x, objects(sat_index).center_y - objects(parent_object).center_y)
 objects(sat_index).angle = calc_angle(objects(sat_index).center_x - objects(parent_object).center_x, objects(sat_index).center_y - objects(parent_object).center_y)
 objects(sat_index).ang_vel = calc_gravity(objects(parent_object).mass, objects(sat_index).distance)
End Function

Private Function find_next_free_object() As Integer
'Where to put current object into objects structure (which index to give it)
Dim i As Integer
 
 For i = 1 To OBJECT_NUMBER
   If objects(i).used = False Then
     find_next_free_object = i
     Exit Function
   End If
 Next i
 find_next_free_object = 0
End Function




'****************************************
' Functions needed for movement
'****************************************

Sub move_all_objects()
'change coordinates of all objects
Dim i As Integer
 
 For i = 1 To OBJECT_NUMBER
 
'move only defined objects
   If objects(i).used = True Then
   
'don't move the sun
     If objects(i).is_moving = True Then
       objects(i).angle = objects(i).angle + objects(i).ang_vel
       
'degrees are used, but cos and sin use radians
       objects(i).center_x = objects(objects(i).parent).center_x + (objects(i).distance * Cos((objects(i).angle) * PI_CONST / 180))
       objects(i).center_y = objects(objects(i).parent).center_y + (objects(i).distance * Sin((objects(i).angle) * PI_CONST / 180))
     End If
   End If
 Next i
End Sub

Sub paint_all_objects()
'put all objects to the screen
Dim i As Integer
 
 For i = 1 To OBJECT_NUMBER
 
'move only defined objects
   If objects(i).used = True Then
   
'don't move the sun
     If objects(i).is_moving = True Then
       objects(i).window_object.Top = objects(i).center_y - objects(i).central_offset_y
       objects(i).window_object.Left = objects(i).center_x - objects(i).central_offset_x
     End If
   End If
 Next i
End Sub
0
 

Author Comment

by:Omarmartnz
ID: 6244974
Great Answer thanks..

I'll translate the functions to delphi and add somethings for my application needs.


Thanks again..
0
 
LVL 2

Expert Comment

by:joepezt
ID: 6263652
hi, could you email the translated code for delphi?
would be great :)
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Artificial Intelligence comes in many forms, and for game developers, Path-Finding is an important ability for making an NPC (Non-Playable Character) maneuver through terrain.  A* is a particularly easy way to approach it.  I’ll start with the algor…
Recently, in one of the tech-blogs I usually read, I saw a post about the best-selling video games through history. The first place in the list is for the classic, extremely addictive Tetris. Well, a long time ago, in a galaxy far far away, I was…
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …
This tutorial demonstrates a quick way of adding group price to multiple Magento products.

746 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now