太阳系行星轨道及运行.docx

资源描述

太阳系行星轨道及运行.docx

《太阳系行星轨道及运行.docx》由会员分享，可在线阅读，更多相关《太阳系行星轨道及运行.docx（19页珍藏版）》请在冰豆网上搜索。

太阳系行星轨道及运行.docx

太阳系行星轨道及运行

动画演示

本程序对太阳系行星、卫星运行情况进行动画演示。

具有以下功能：

1.可单独（或全部）显示或隐藏某个天体、运行轨道、天体名称。

2.可调节演示速度、画面比列、观察角度（从天球赤道到天球北极观察太阳系）。

3.可将某个天体（例如月亮）设置为屏幕中间静止不动的天体，观察其他天体相对于该天体运行的情况。

本程序改进版见：

太阳系行星轨道及运行-3D立体动画演示

通过设置不同的参数，可得到许多美丽而奇妙的图案，如下：

'需在窗体放置以下3个控件，所有控件均采用默认设置：

' Picture1，Command1，Timer1

'注意：

在属性窗口将Command1的Index属性设置为0

'其次，为窗体添加一个名为mFast的菜单，再为mFast添加一个名为mmFast的下级子菜单，并将mmFast的索引设置为0。

' 即：

mmFast是以序号0开头的菜单数组控件的第一个。

'以下是窗体代码，在VB6.0调试通过：

DimctD（）AstyD,ctDsAsLong,ctPAsSingle,ctCenterAsLong

DimctBiAsSingle,ctVAsSingle,ctTrackAsBoolean,ctBWAsLong

DimctSeeJAsLong,ctSeeBiAsSingle,ctSetAsMenuSet

'定义表示天体的数据类型

PrivateTypetyD

CapAsString '天体名称

rAsLong '天体半径（像素，下同）

aAsSingle '轨道：

横半径

bAsSingle '轨道：

纵半径

cAsSingle '轨道：

焦点

eAsSingle '轨道：

偏心率

IsHuiAsBoolean'是否彗星

FatherAsLong '父天体序号：

轨道焦点上的天体

SeAsLong '颜色

VAsSingle '运行角速度

JiaoAsSingle '某时刻的与父天体连线角度

XAsSingle '天体当前坐标

YAsSingle

xUpAsSingle '上一时刻坐标

yUpAsSingle

VisibleAsBoolean'是否显示：

球体

ShowCapAsBoolean'是否显示：

标题

GuiDaoAsBoolean'是否显示：

轨道

EndType

EnumMenuSet

'以下为选项菜单标示

ms_All=-2

ms_NoAll=-1

'以下为按钮标示

ms_RunStop=0'开始/暂停

ms_Step '步进，下一位置

ms_UnRun '后退

ms_Track '轨迹：

显示/隐藏

ms_DefSet '默认设置

ms_Center '参照系

ms_Visible '天体：

显示/隐藏

ms_ShowCap '天体名称

ms_GuiDao '轨道

ms_Bi '缩放比

ms_V '速度

ms_SeeJ '视角

EndEnum

PrivateSubForm_Load（）

Me.ScaleMode=3:

Me.Caption="太阳系行星运行演示"

mFast.Visible=False:

ctP=3.1415926

Timer1.Interval=25:

Timer1.Enabled=True

CallInit

'Me.WindowState=vbMaximized'最大化窗体

'窗体大小为屏幕的3/4，居中

Me.MoveScreen.Width*0.1,Screen.Height*0.1,Screen.Width*0.8,Screen.Height*0.8

EndSub

PrivateSubForm_Resize（）

DimIAsLong,LAsSingle,TAsSingle,HAsSingle,H1AsSingle,WAsSingle

'设置控件位置

H1=Me.TextHeight（"A"）:

L=H1*0.3:

T=L

L=3

ForI=0ToCommand1.Count-1

W=Me.TextWidth（Command1（I）.Caption&"ab"）

Command1（I）.MoveL,T,W,H1*2

L=L+W+3

T=T*2+Command1（0）.Height:

H=Me.ScaleHeight-T

IfH>0ThenPicture1.Move0,T,Me.ScaleWidth,H

'将Picture1的中心设置为坐标原点

Picture1.ScaleMode=3

Picture1.ScaleLeft=-Picture1.ScaleWidth*0.5

Picture1.ScaleTop=-Picture1.ScaleHeight*0.5

Picture1.Cls

CallRun1

EndSub

PrivateSubInit（）

'初始化天体参数

DimIAsLong,VAsSingle,JAsSingle

ctBW=0'40'四周边界空白区，仅用于调试。

调试完毕应设为0。

调试代码****

Picture1.AutoRedraw=True

Picture1.BackColor=&H220000'&HFFFFFF'

ctCenter=0:

ctBi=1:

ctV=1'参照系（位于中心的天体），缩放比列，速度

ctSeeJ=30:

ctSeeBi=ctSeeJ/90'视点角度，视角比

ctTrack=False'不显示运动轨迹（不是轨道）

'添加按钮

KjClsCommand1

KjAddCommand1,"始/停（&K）",ms_RunStop,"天体的运动状态：

开始/暂停"

KjAddCommand1,"进（&J）",ms_Step,"步进，运行到下一位置"

KjAddCommand1,"退（&T）",ms_UnRun,"步进，后退到上一位置"

KjAddCommand1,"迹（&A）",ms_Track,"运动轨迹：

显示/隐藏"

KjAddCommand1,"默（&D）",ms_DefSet,"将所有参数恢复为默认设置"

KjAddCommand1,"参照系（&C）",ms_Center,"设置参照系（位于中心的天体）"

KjAddCommand1,"天体（&X）",ms_Visible,"天体：

显示/隐藏"

KjAddCommand1,"名称（&M）",ms_ShowCap,"天体名称：

显示/隐藏"

KjAddCommand1,"轨道（&G）",ms_GuiDao,"天体运行轨道：

显示/隐藏"

KjAddCommand1,"速度（&V）",ms_V,"设置速度"

KjAddCommand1,"视角（&L）",ms_SeeJ,"设置视点角度"

KjAddCommand1,"缩放（&S）",ms_Bi,"设置缩放比列"

'添加天体（演示比列状态下），半径以100像素为标准

'参数依次是：

名称，父天体名称，天体半径，轨道长半轴，轨道偏心率，运动角速度，天体颜色，初始角度，彗星否

ctDs=-1:

ReDimctD（0）

AddCircle"太阳","",22,2,0,ctP*0.008,RGB（255,200,0）

AddCircle"水星","",5,0.5,0.206,ctP*0.03,&H999999

AddCircle"金星","",9,0.8,0.0068,ctP*0.018,&H55AAAA

AddCircle"地球","",10,1.2,0.0167,ctP*0.01,RGB（0,0,255）

AddCircle"月亮","地球",4,0.2,0,ctP*0.06,&H888888

AddCircle"嫦娥1号","月亮",2,0.06,0,ctP*0.12,&HCCCCCC

AddCircle"火星","",6,1.8,0.093,ctP*0.005,&H1155FF

AddCircle"火卫1","火星",3,0.1,0,ctP*0.1,&HFFFF00,ctP*2*0.3

AddCircle"火卫2","火星",3,0.15,0,ctP*0.1,&H7777FF,ctP*2*0.7

AddCircle"木星","",16,3,0.0483,ctP*0.003,&HEEDDCC

AddCircle"木卫1","木星",2,0.25,0,ctP*0.05,&H883487,ctP*2*0.2

AddCircle"木卫2","木星",2,0.3,0,ctP*0.035,&H348888,ctP*2*0.4

AddCircle"木卫3","木星",3,0.35,0,ctP*0.03,&HAA34CC,ctP*2*0.6

AddCircle"木卫4","木星",4,0.45,0,ctP*0.02,&H888888,ctP*2*0.8

AddCircle"土星","",14,5,0.056,ctP*0.002,&H5599FF

AddCircle"土卫6","土星",4,0.25,0,ctP*0.055,&H99EEEE

AddCircle"天王星","",12,6.5,0.0461,ctP*0.0015,&HFFCCCC

AddCircle"天卫3","天王星",3,0.2,0,ctP*0.05,&H33FF88,ctP*2*0.5

AddCircle"天卫4","天王星",3,0.3,0,ctP*0.035,&HFF3311,ctP*2*0.8

AddCircle"海王星","",12,9,0.0097,ctP*0.001,&HFF7766

AddCircle"海卫1","海王星",3,0.25,0,-ctP*0.03,&H882388

AddCircle"哈雷彗星","",2,5.5,0.83,ctP*0.0012,&H777777,ctP*1,True

CallForm_Resize

EndSub

PrivateSubCommand1_Click（IndexAsInteger）

DimIAsLong,JAsLong,nStrAsString,ZuAsVariant

DimnSelAsLong,nAllAsLong,nNoAsLong

ctSet=Val（Command1（Index）.Tag）'得到按钮标示

KjClsmmFast '清除菜单

'装载快捷菜单，并勾选选定项目

SelectCasectSet

Casems_DefSet:

CallInit:

Run1:

ExitSub '默认设置

Casems_RunStop:

Timer1.Enabled=NotTimer1.Enabled:

ExitSub'开始/暂停

Casems_Track:

ctTrack=NotctTrack:

Picture1.Cls:

CallRun1'保留运动轨迹

Casems_Step'步进，前进到下一位置

IfNotTimer1.EnabledThenRun1True

Timer1.Enabled=False

Casems_UnRun'步进，后退到下一位置

IfNotTimer1.EnabledThenRun1True,True

Timer1.Enabled=False

Casems_Bi'缩放比列

Zu=Array（0.1,0.2,0.3,0.4,"-",0.5,0.6,0.7,0.8,0.9,"-",1,1.2,1.5,1.8,2,3,5,8,10）

KjAddZummFast,Zu,ctBi,"倍":

GoToShow1'添加数组菜单，并勾选ctBi

Casems_SeeJ'视点角度

Zu=Array（"90度（天球北极）","80度","70度","60度","50度","45度","40度","30度","20度","15度","10度","5度","0度（天球赤道）"）

KjAddZummFast,Zu,ctSeeJ:

GoToShow1'添加数组菜单，并勾选ctSeeJ

Casems_V'速度

Zu=Array（0.1,0.2,0.3,0.4,"-",0.5,0.6,0.7,0.8,0.9,"-",1,1.5,2,2.5,3,4,5,7.5,10）

KjAddZummFast,Zu,ctV,"倍":

GoToShow1

CaseElse '装载天体名称

ForI=0ToctDs

J=Ji（I）'天体I的级别

KjAddmmFast,"&"&I&""&String（J*2,""）&ctD（I）.Cap

EndSelect

'勾选选定天体

SelectCasectSet

Casems_Center:

mmFast（ctCenter）.Checked=True:

GoToShow1'参照系（中心天体）

Casems_ShowCap'显示天体名称

ForI=0ToctDs:

mmFast（I）.Checked=ctD（I）.ShowCap:

Casems_Visible'天体是否可见

ForI=0ToctDs:

mmFast（I）.Checked=ctD（I）.Visible:

Casems_GuiDao'轨道

ForI=0ToctDs:

mmFast（I）.Checked=ctD（I）.GuiDao:

CaseElse:

ExitSub

EndSelect

KjAddmmFast,"-"

nAll=KjAdd（mmFast,"全选",ms_All）

nNo=KjAdd（mmFast,"全不选",ms_NoAll）

ForI=0ToctDs

IfmmFast（I）.CheckedThennSel=nSel+1

IfnSel=0ThenmmFast（nNo）.Checked=True:

mmFast（nNo）.Enabled=False

IfnSel=ctDs+1ThenmmFast（nAll）.Checked=True:

mmFast（nAll）.Enabled=False

Show1:

Command1（Index）.BackColor=&HFFCCCC'将选中按钮设置为淡蓝色

Me.PopupMenumFast,,Command1（Index）.Left,Command1（Index）.Top+Command1（Index）.Height-3

Command1（Index）.BackColor=Me.BackColor

EndSub

PrivateSubmmFast_Click（IndexAsInteger）

'通过快捷菜单设置天体有关参数

DimnTagAsMenuSet,IAsLong,TFAsBoolean

nTag=Val（mmFast（Index）.Tag）'菜单标示：

ms_All全选，ms_NoAll全不选

SelectCasectSet'ctSet：

按钮标示，在Command1_Click中设置

Casems_V'速度

ctV=Val（mmFast（Index）.Caption）

Casems_SeeJ'视点角度

ctSeeJ=Val（mmFast（Index）.Caption）'视点角度

ctSeeBi=ctSeeJ/90'视角比

ForI=0ToctDs:

ctD（I）.xUp=0:

ctD（I）.yUp=0:

Casems_Bi'缩放比列

ctBi=Val（mmFast（Index）.Caption）

ForI=0ToctDs:

ctD（I）.xUp=0:

ctD（I）.yUp=0:

Casems_Center'参照系（中心天体）

ctCenter=Index

ForI=0ToctDs:

ctD（I）.xUp=0:

ctD（I）.yUp=0:

Casems_ShowCap'显示名称

IfIndex<=ctDsThen

ctD（Index）.ShowCap=NotctD（Index）.ShowCap

Else

TF=nTag=ms_All

ForI=0ToctDs:

ctD（I）.ShowCap=TF:

EndIf

Casems_Visible'天体是否可见

IfIndex<=ctDsThen

ctD（Index）.Visible=NotctD（Index）.Visible

Else

TF=nTag=ms_All

ForI=0ToctDs:

ctD（I）.Visible=TF:

EndIf

Casems_GuiDao'轨道

IfIndex<=ctDsThen

ctD（Index）.GuiDao=NotctD（Index）.GuiDao

Else

TF=nTag=ms_All

ForI=0ToctDs:

ctD（I）.GuiDao=TF:

EndIf

EndSelect

Picture1.Cls

CallRun1

EndSub

PrivateSubAddCircle（nNameAsString,nFatherAsString,rAsLong,aAsSingle,eAsSingle,VAsSingle,_

OptionalSeAsLong=255,OptionalJiaoAsSingle,OptionalIsHuiAsBoolean）

'添加一个天体，参数依次是：

' 名称，父天体名称，天体半径，轨道长半轴，轨道偏心率，运动角速度，天体颜色，初始角度，彗星否

DimIAsLong,JAsLong

a=a*100'半径以100像素为标准

ctDs=ctDs+1:

ReDimPreservectD（ctDs）

'设置父天体编号

ForI=0ToctDs-1

IfLCase（ctD（I）.Cap）=LCase（nFather）ThenctD（ctDs）.Father=I:

ExitFor

ctD（ctDs）.Cap=nName:

ctD（ctDs）.r=r:

ctD（ctDs）.a=a

ctD（ctDs）.c=a*e:

ctD（ctDs）.b=Sqr（a^2-ctD（ctDs）.c^2）

ctD（ctDs）.IsHui=IsHui:

ctD（ctDs）.V=V:

ctD（ctDs）.Se=Se

ctD（ctDs）.xUp=0:

ctD（ctDs）.yUp=0:

ctD（ctDs）.Visible=True

ctD（ctDs）.GuiDao=True

Randomize

IfJiao=0ThenctD（ctDs）.Jiao=Rnd*ctP*2ElsectD（ctDs）.Jiao=Jiao

EndSub

PrivateFunctionKjAddZu（Kj,ZuAsVariant,ByValCheckStrAsString,OptionalSameStrAsString）

'添加一个数组菜单，并勾选标题为CheckStr的条目

DimIAsLong,JAsLong,nCapAsString

IfLeft（CheckStr,1）="."ThenCheckStr="0"&CheckStr

ForI=LBound（Zu）ToUBound（Zu）

nCap=Zu（I）

IfLeft（nCap,1）="."ThennCap="0"&nCap

IfnCap="-"ThenJ=KjAdd（Kj,nCap）ElseJ=KjAdd（Kj,nCap&SameStr）

'IfLCase（CheckStr）=LCase（nCap）ThenKj（J）.Checked=True

IfVal（CheckStr）=Val（nCap）ThenKj（J）.Checked=True

EndFunction

PrivateFunctionKjAdd（Kj,nCapAsString,OptionalnTagAsString,OptionalnNoteAsString）AsLong

'为数组控件添加一个成员，返回新添加的成员序号

DimIAsLong

I=Kj.Count-1

IfKj（I）.Caption<>""ThenI=I+1:

LoadKj（I）

OnError

展开阅读全文