天体运行程序代码.docx

资源描述

天体运行程序代码.docx

《天体运行程序代码.docx》由会员分享，可在线阅读，更多相关《天体运行程序代码.docx（26页珍藏版）》请在冰豆网上搜索。

天体运行程序代码.docx

天体运行程序代码

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

'一、必须在引用中勾选：

OLEAutomatuon，否则ImgAsStdPicture语句会出错

'二、需在窗体放置以下4个控件，所有控件不用设置任何属性，均采用默认设置：

' Picture1，Picture2，Timer1，Command1（注意：

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

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

' 即：

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

DimctD（）AstyD,ctDsAsLong,ctB（）AsLong,ctCenterAsLong,ct3DAsBoolean

DimctBiAsSingle,ctVAsSingle,ctBWAsLong,ctSeeJAsLong,ctTrackAsBoolean

DimctSeeBiAsSingle,ctSetAsMenuSet,ctShowXXAsBoolean,ctColorXXAsBoolean

DimctP180AsSingle,ctP90AsSingle,ctP270AsSingle,ctP360AsSingle

DimctSmall（）AstySmall,ctSmallsAsLong,ctX（）AstyX,ctXsAsLong,ctSizeAsLong

'定义表示星星的数据类型

PrivateTypetyX

xAsSingle

yAsSingle

rAsLong

tAsLong

SeAsLong

EndType

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

PrivateTypetyD

JiAsLong '天体级别

CapAsString '天体名称

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

aAsSingle '轨道：

横半径

bAsSingle '轨道：

纵半径

CAsSingle '轨道：

焦点

eAsSingle '轨道：

偏心率

DipAsSingle '轨道：

倾角

IsHuiAsBoolean'是否彗星

IsSmallAsBoolean'是否小行星

FatherAsLong '父天体序号：

轨道焦点上的天体

SeAsLong '颜色

VAsSingle '运行角速度

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

xAsSingle '天体当前坐标

yAsSingle

xUpAsSingle '上一时刻坐标

yUpAsSingle

VisibleAsBoolean'是否显示：

球体

ShowCapAsBoolean'是否显示：

标题

GuiDaoAsBoolean '是否显示：

轨道

GuiJiAsBoolean '是否显示：

轨迹

ImgAsStdPicture '天体3D图像

LineFuAsBoolean '与父天体的中心连线

EndType

'定义小行星类型

PrivateTypetySmall

aAsSingle '轨道：

横半径

bAsSingle '轨道：

纵半径

JiaoAsSingle

EndType

EnumMenuSet

'以下为选项菜单标示

ms_Size=-11 '设置字体大小

ms_RunStop=-10'开始/暂停

ms_3D=-9 '3D立体图像

ms_ColorXX=-8 '是否显彩色星星

ms_ShowXX=-7 '是否显示闪烁的星星

ms_DefSet=-6 '默认设置

ms_Track=-5 '轨迹：

显示/隐藏

'以下为菜单全选、全不选

ms_Wei=-4

ms_Xing=-3

ms_All=-2

ms_NoAll=-1

'以下为按钮标示

ms_Step=0 '步进，下一位置

ms_UnRun '后退

ms_Opt '显示选项菜单

ms_Center '参照系

ms_Visible '天体：

显示/隐藏

ms_ShowCap '天体名称

ms_GuiDao '轨道

ms_GuiJi '轨迹

ms_LineFu '与父天体的中心连线

ms_Bi '缩放比

ms_V '速度

ms_SeeJ '视角

EndEnum

PrivateDeclareFunctionGdiTransparentBltLib"gdi32"（ByValhdc1AsLong,ByValX1AsLong,ByValy1AsLong,ByValW1AsLong,ByValH1AsLong,ByValHdc2AsLong,ByValX2AsLong,ByValY2AsLong,ByValW2AsLong,ByValH2AsLong,ByValColorAsLong）AsLong

PrivateSubForm_Load（）

Me.ScaleMode=3:

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

mFast.Visible=False:

ctP180=3.1415926

ctP90=ctP180*0.5:

ctP360=ctP180*2:

ctP270=ctP90*3

Timer1.Interval=25:

Timer1.Enabled=True

CallInit

'窗体大小为屏幕的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,KAsLong,SAsLong

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

调试完毕应设为0。

调试代码****

Picture1.AutoRedraw=True:

Picture1.BackColor=&H180000

Picture1.ScaleMode=3

Picture2.BorderStyle=0:

Picture2.ScaleMode=3

Picture2.AutoRedraw=True:

Picture2.Visible=False

Picture2.BackColor=Picture1.BackColor

ctSize=9

ctCenter=0:

ctBi=1:

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

ctSeeJ=30:

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

ctTrack=False'默认：

不显示运动轨迹（不是轨道）

ct3D=True '默认：

3D立体图像

ctShowXX=True'默认：

显示闪烁的星星

CallRndXX '初始闪烁的星星

'添加按钮

KjClsCommand1:

Command1（0）.BackColor=Me.BackColor

KjAddCommand1,"选项（&O）",ms_Opt,"设置选项"

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

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

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

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

显示/隐藏"

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

显示/隐藏"

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

显示/隐藏"

KjAddCommand1,"轨迹（&J）",ms_GuiJi,"运动轨迹，选中“选项-显示运动轨迹”时有效"

KjAddCommand1,"连线（&L）",ms_LineFu,"与父天体的中心连线，同时显示对应天体时有效"

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

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

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

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

'参数依次是：

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

ctDs=-1:

ReDimctD（0To0）

AddCircle"太阳","",22,2,0,1.44,,RGB（230,180,0）

AddCircle"水星","",5,0.5,0.206,5.45,7.001,&H999999

AddCircle"金星","",9,0.8,0.007,3.24,3.394,&H55AAAA

AddCircle"地球","",10,1.2,0.017,1.81,,RGB（0,0,255）

AddCircle"月亮","地球",4,0.2,0,10.8,,&H333333

' ctD（CapToNum（"月亮"））.IsSmall=True'调试代码****

AddCircle"嫦娥1号","月亮",2,0.06,0,21.6,,&HCCCCCC

AddCircle"火星","",6,1.8,0.093,0.91,1.851,&H1155FF

AddCircle"火卫1","火星",3,0.1,0,15,,&H555500,10

AddCircle"火卫2","火星",3,0.15,0,17,,&H5555DD,200

AddCircle"小行星","",6,2.4,0.093,0.7,0,&H666666'小行星轨道倾角多少？

ctD（CapToNum（"小行星"））.IsSmall=True

AddCircle"木星","",16,3,0.0483,0.54,1.308,&H776655

AddCircle"木卫1","木星",2,0.25,0,9,,&H883487,10

AddCircle"木卫2","木星",2,0.3,0,6.3,,&H348888,100

AddCircle"木卫3","木星",3,0.35,0,5.4,,&HAA34CC,190

AddCircle"木卫4","木星",4,0.45,0,3.6,,&H888888,280

AddCircle"土星","",14,5,0.056,0.36,2.488,&H2266CC

AddCircle"土卫6","土星",4,0.25,0,9.5,30,&H99EEEE

AddCircle"天王星","",12,6.5,0.046,0.27,0.774,&HCC7777

AddCircle"天卫3","天王星",3,0.2,0,9.6,,&H33FF88,10

AddCircle"天卫4","天王星",3,0.3,0,6.2,,&HFF3311,200

AddCircle"海王星","",12,9.2,0.009,0.18,1.774,&HFF7766

AddCircle"海卫1","海王星",3,0.25,0,-5.4,,&H882388

AddCircle"哈雷彗星","",2,5.5,0.83,-0.21,18,&H777777,-10

ctD（CapToNum（"哈雷彗星"））.IsHui=True

'初始化小行星

ForK=0ToctDs

IfctD（K）.IsSmallThen

ctD（K）.GuiDao=False:

ctSmalls=90'小行星总个数

S=ctD（K）.b*0.07'12 '小行星带宽度

ReDimctSmall（0ToctSmalls）

ctSmall（0）.a=ctD（K）.a:

ctSmall（0）.b=ctD（K）.b

ForI=1ToctSmalls

RandomizeI

ctSmall（I）.a=Rnd*S-S*0.5+ctD（K）.a

ctSmall（I）.b=Rnd*S-S*0.5+ctD（K）.b

ctSmall（I）.Jiao=Rnd*ctP360

ExitFor

EndIf

CallSortB '将天体按轨道短半径从小到大排序，用数组ctB（）记忆排序结果（天体序号）

CallDrawAllBall'绘制所有天体的3D立体图像，存入天体变量ctD（I）.Img

CallForm_Resize

EndSub

PrivateSubRndXX（）

DimIAsLong,JAsLong

ctXs=90'闪烁的星星个数

ReDimctX（0ToctXs）

ForI=0ToctXs

RandomizeI

ctX（I）.x=Rnd*Screen.Width/Screen.TwipsPerPixelX-Screen.Width/Screen.TwipsPerPixelX*0.5

ctX（I）.y=Rnd*Screen.Height/Screen.TwipsPerPixelY-Screen.Height/Screen.TwipsPerPixelY*0.5

Randomize

ctX（I）.r=2*Rnd:

ctX（I）.t=6*Rnd

IfctColorXXThen

ctX（I）.Se=&HFFFFFF*Rnd

Else

J=255*Rnd:

ctX（I）.Se=RGB（J,J,J）

EndIf

EndSub

PrivateSubDrawAllBall（OptionalIAsLong=-1,OptionalShowInfAsBoolean）

'绘制所有天体的3D球形图像

DimrAsLong,nStrAsString,xAsSingle,yAsSingle

IfI>-1ThenGoSubSubDraw1:

ExitSub

Me.MousePointer=11

Picture1.Font.Size=32

ForI=0ToctDs

IfShowInfThen

IfI=0ThennStr="1%"ElsenStr=Int（I/ctDs*100）&"%"

nStr="正在更新图像"&vbCrLf&nStr

x=-Picture1.TextWidth（nStr）*0.5:

y=-Picture1.TextHeight（nStr）*0.5

Picture1.Line（x,y）-Step（-x*2,-y*2）,&H776633,BF

Picture1.CurrentX=x:

Picture1.CurrentY=y

Picture1.PrintnStr

Picture1.Refresh

EndIf

GoSubSubDraw1

Picture2.Cls

Picture2.Move0,0,2,2

Me.MousePointer=0

'doe

ExitSub

SubDraw1:

r=ctBi*ctD（I）.r

Ifr<2Thenr=2

DrawBallr,r,r,&HFFFFFF,ctD（I）.Se

SetctD（I）.Img=Picture2.Image

Return

EndSub

PrivateSubDrawBall（rAsLong,ByValx0AsLong,ByValy0AsLong,Se1AsLong,Se2AsLong）

'画一个立体球图案

DimGDsAsLong,r0AsSingle,rGAsSingle

DimStepRAsSingle,StepGAsSingle,StepBAsSingle

DimxAsLong,yAsLong,X1AsLong,y1AsLong,BiAsSingle

DimR1AsLong,G1AsLong,B1AsLong,R2AsLong,G2AsLong,B2AsLong

GetRGBSe1,R1,G1,B1:

GetRGBSe2,R2,G2,B2

Picture2.Cls

Picture2.Width=r*2+1:

Picture2.Height=r*2+1

GDs=6'与背景的过渡带

X1=r*0.6:

y1=r*0.6 '高光中心点

rG=Sqr（（X1-x0）^2+（y1-y0）^2）'高光与中心的距离

StepR=R2-R1:

StepG=G2-G1:

StepB=B2-B1

Fory=0ToPicture2.ScaleHeight

Forx=0ToPicture2.ScaleWidth

r0=Sqr（（x-x0）^2+（y-y0

展开阅读全文