VERSION 5.00 Begin VB.Form Form1 AutoRedraw = -1 'True BackColor = &H00C0C0C0& Caption = "MC999" ClientHeight = 6105 ClientLeft = 60 ClientTop = 345 ClientWidth = 8475 DrawWidth = 5 Icon = "source05.frx":0000 LinkTopic = "Form1" ScaleHeight = 407 ScaleMode = 3 'ﾋﾟｸｾﾙ ScaleWidth = 565 StartUpPosition = 3 'Windows の既定値 Begin VB.CommandButton continue_btn Caption = "Continue(&U)" Height = 495 Left = 6360 TabIndex = 19 Top = 5520 Width = 1695 End Begin VB.VScrollBar zoom_vsb Height = 6015 Left = 8160 Max = 10 Min = -10 TabIndex = 18 Top = 0 Width = 255 End Begin VB.TextBox zoomindicate_txt BeginProperty Font Name = "ＭＳ Ｐゴシック" Size = 12 Charset = 128 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 7200 TabIndex = 17 Text = "Text2" Top = 960 Width = 855 End Begin VB.TextBox auindicate_txt BeginProperty Font Name = "ＭＳ Ｐゴシック" Size = 12 Charset = 128 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 6360 TabIndex = 16 Text = "Text1" Top = 960 Width = 855 End Begin VB.TextBox nowtime_txt BackColor = &H00000000& BeginProperty Font Name = "ＭＳ Ｐゴシック" Size = 12 Charset = 128 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0000FFFF& Height = 390 Left = 6360 TabIndex = 15 Text = "0" Top = 1440 Width = 1695 End Begin VB.CommandButton exit_btn Caption = "Exit(&X)" Height = 855 Left = 7200 TabIndex = 14 Top = 0 Width = 855 End Begin VB.CommandButton pause_btn Caption = "Pause(&P)" Height = 495 Left = 6360 TabIndex = 13 Top = 4920 Width = 1695 End Begin VB.PictureBox Picture1 AutoRedraw = -1 'True BackColor = &H00000000& DrawWidth = 20 ForeColor = &H0000FFFF& Height = 6000 Left = 0 Negotiate = -1 'True ScaleHeight = 396 ScaleMode = 3 'ﾋﾟｸｾﾙ ScaleWidth = 412 TabIndex = 6 Top = 0 Width = 6240 Begin VB.Timer Timer1 Interval = 1 Left = 5400 Top = 120 End End Begin VB.CommandButton go_btn Caption = "Go (&G)" Height = 2895 Left = 7560 TabIndex = 5 Top = 1920 Width = 495 End Begin VB.TextBox accelchk_txt BeginProperty Font Name = "ＭＳ Ｐゴシック" Size = 12 Charset = 128 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 6720 TabIndex = 4 Text = "Text5" Top = 4320 Width = 735 End Begin VB.TextBox howlongyears_txt BeginProperty Font Name = "ＭＳ Ｐゴシック" Size = 12 Charset = 128 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 6720 TabIndex = 3 Text = "Text4" Top = 3720 Width = 735 End Begin VB.TextBox speedave_txt BeginProperty Font Name = "ＭＳ Ｐゴシック" Size = 12 Charset = 128 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 6720 TabIndex = 2 Text = "Text3" Top = 3120 Width = 735 End Begin VB.TextBox eachmass_txt BeginProperty Font Name = "ＭＳ Ｐゴシック" Size = 12 Charset = 128 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 6720 TabIndex = 1 Text = "Text2" Top = 2520 Width = 735 End Begin VB.TextBox n_txt BeginProperty Font Name = "ＭＳ Ｐゴシック" Size = 12 Charset = 128 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 6720 TabIndex = 0 Text = "Text1" Top = 1920 Width = 735 End Begin VB.Label Label6 BackColor = &H00FFFF80& BorderStyle = 1 '実線 Caption = "Multi Celestrone 999 V105 forWIN32" Height = 840 Left = 6240 TabIndex = 12 Top = 0 Width = 930 End Begin VB.Label Label5 Caption = "accel check" Height = 375 Left = 6240 TabIndex = 11 Top = 4320 Width = 495 End Begin VB.Label Label4 Caption = "how long years" Height = 615 Left = 6240 TabIndex = 10 Top = 3600 Width = 495 End Begin VB.Label Label3 Caption = "speed ave" Height = 375 Left = 6240 TabIndex = 9 Top = 3120 Width = 495 End Begin VB.Label Label2 Caption = "each mass" Height = 495 Left = 6240 TabIndex = 8 Top = 2520 Width = 495 End Begin VB.Label Label1 Caption = "n" Height = 255 Left = 6240 TabIndex = 7 Top = 1920 Width = 495 End End Attribute VB_Name = "Form1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Rem ======================================================== Rem MultiCelestron 999 : == Rem As Multi Points Movement Symlation Ver.1.05 for WIN32 == Rem == Rem Logic spreading Version as test == Rem Extended From comet3xx Basic Source File == Rem 1999 Feb 13th- 1999 Mar 10th. DOS as Ver.1.05 == Rem 2000 Mar 17th- 2000 Mar 26th. WIN32 as Ver.1.05 == Rem == Rem Copy Right: Kazuki Kimijima/Kaztomi Miyama == Rem Address VYE00525@nifty.ne.jp == Rem kaz_kimijima@livedoor.com == Rem == Rem URL:http://kimijima.tripod.co.jp/ == Rem == Rem First, For Borland/Imprise TurboC++ for DOS Ver.4.00 == Rem Second, For MicroSoft VisualBasic for WIN32 Ver.6.0 == Rem ======================================================== Rem ========================================================= Rem 論理構造 Rem Rem This Main Program's Logic is next Chart. Rem ========================================================= Rem 使用内部変数の宣言 Rem フォームが変形されたときのコントロールオブジェクトの再配置論理 Rem form_loadイベントによる各変数の初期化 Rem テキストボックスによる変数の取得論理 Rem 全質点と初期速度の乱数配置関数 Rem re-tune logic of control object when main form wide & shrink Rem parameters initialize by form_load event. Rem logical getting astro parameters by TXT BOX. Rem functions for all points's location and first speed(vector). Rem exitボタンの挙動 Rem pause一時停止ボタンの挙動（タイマーイベントを無効にする旗を立てる） Rem continue演算再開ボタンの挙動（タイマーイベントを有効にする旗を立てる） Rem goスタートボタンによる演算の開始 Rem native action of exit_btn. Rem naitive action of pause_btn. Rem native action of continue_btn. Rem Calculation starting by go_btn. Rem タイマーイベントによる配下の計算ルーチンの制御（経過表示 _ テキストボックスやピクチャに対する描画命令がリアルタイムに動か _ ないことによる表示用テクニック｡1/1000秒ごとに計算イベントを _ 呼び出し、計算イベントは一度呼び出された時に最低100ステップの _ 演算を行う｡計算イベントは100ステップの演算中はタイマーイベント _ のシグナルを無視する｡100ステップの演算が終了した後､主導権を _ タイマーイベントに渡し､みずからは待機状態に入る。） Rem control under_calculational ruitine by TimerEvent: Rem (a special technique for unable action of txt box and Rem picture box with realtime on calculation spreading step Rem by step. Rem 1:the under calculationa unit do calculations of 100 Rem times once it is called by Timer Event of Upper Rem locational of logical. The calculational process ignores Rem timer event's call signal when when it calcules terms. Rem (Forcely drawing cerestron points on picture box as 100 Rem dots at once then.) Rem 2:after 100 step calculation, the under unit takes to Rem sleep of itself. and rises up a flag to permit to call Rem it self to be work for TimerEvent.) Rem 計算プロセスの核 Rem 一つの質点の選択 Rem その質点が受けるすべての質点からの重力影響積算 Rem その質点の実際の移動までの計算 Rem 指定された時間リミットまで計算を繰り返す Rem core of under calculational process. Rem choice one cerestron point of "n" number Rem gravity calculation as sum from all others cerestron Rem points without itself of the No. "n" point. Rem real moving calculations from the gravity Rem influences sum from whole others. Rem if after 100 step calculation finished, Rem next timer event had not occered yet, Rem then this part process does take tiselves' Rem next loop again. Rem グラフィック関係の関数 Rem 視野の平行移動論理 Rem 視野のズーム論理 Rem ピクチャーボックスの初期化 Rem 現在の天体輝点の一斉描画 Rem 過去の軌道輝点の一斉描画 Rem 実際に描画をする下請け関数 Rem functions of graphic to picturebox. Rem logic to paralell moving of view zone. Rem logic to zoom of view. Rem picture box initialize. Rem now time all point dot-draw. Rem all past time-all point's orbit redraw. Rem real functions for dot and circle. Rem Rem 終了 Rem END. Rem ========================================================= Rem ======================================================== Rem グローバル変数の宣言 Rem Parameters Decleare as global. Rem ======================================================== Rem 天文固定変数の宣言 Rem declear astro parametrs. Dim earthspeed, gconst, sungravity As Double Dim eachmass, speedave As Double Rem -ave:Average(平均) Rem Rem このシュミレーションは、各質点の質量は同一とし、 Rem その初期速度と物理座標のみが異なる条件で出発します Rem 速度と座標は乱数で定義されます Rem This symilation: Rem 1:all cerestronpoint have same mass. Rem 2:differ as each init_speed(vector),x-y parametrs Rem only.(pancaked space). Rem by random fuction from on VisualBasic. Rem 基準地球公転速度（＝天文単位/年）earthspeed = 2*3.141592/365.251 Rem 空間単位（＝天文単位） Unit is 1 AU Rem 重力定数（このシステム独自） gconst=5.2/(10^8) Rem 太陽重力単位（地球の質量の３３万倍として定義） Rem sungravity= 3.3*(10^5)*gconst*earthspeed. Rem speed base unit=earth lotation speed on its orbit(AU/years). Rem Space unit is AU. Rem gravity const.(only unique of this symlational system.) Rem unit sun gravity is 3.3 * 10^5 of the earth. Rem 演算変数 Rem parameters of calculational local using. Dim howlong, howlongyears, timecounter As Double Dim dtd, accel, sumaccel, accel_chk As Double Rem dtd ＝Δtimedays 演算用微小時間区間（区分求積積分に使用、精度によって可変） Rem accel 重力変数＝加速度変数 Rem sumaccel 積算重力＝積算加速度 Rem accel_chk 積算加速度の過剰監視 Rem dtd =deltatimedays :differncial small time unit days and times. Rem accel =paramerter of accel swing. Rem sumaccel = sum of other gravity influences. Rem accel_chk =admin. to over accel swing. Dim d As Double Rem 加速度・重力微小三角で使用する補助変数 Rem d*d=ax*ax+ay*ay(Roof length of Dynamic triangle X-Y's Diagram)'s ^2. Rem 質点用配列変数 Rem sequences parametrs for each dot_cerestron_points. Dim n As Integer Dim x(101, 101), vx(101), ax, sumax As Double Dim y(101, 101), vy(101), ay, sumay As Double Rem Dim z(101,101), vz(101), az, sumaz As Double. Rem ３次元処理をするのには卓上計算機ではでは力不足。 Rem (2-Demention Version,No-Use.) Rem xy(past_point,n) n は質点の通し番号、past_point Rem は過去の質点の軌跡を記憶させるためのメモリー呼び出し変数。 Rem vx,yはベクトル速度用の配列変数 Rem n 計算する質点の任意の要素数｡ Rem PC is so low power for 3 demention calculation of this cases. Rem (This symlation 2 dimention version.) Rem xy(1,2,3......100 ,n):past_point is 1 to 100 Rem 1 is young, 100 is more old. Rem 1th is 100 step before xy point memory, Rem 2th, is 200 step before,.....100th is 100*100=10^5 Rem step before. Rem vx,vy are for now vector of spped. Rem Rem n =cerestron sum number on this calculational. Rem 描画用補助変数 Rem help parameters to draw on picture Dim past_point, nowaction_flag As Integer Dim tune_x, tune_y, base_tunex, base_tuney As Variant Dim justbefore_dotx, justbefore_doty As Single Dim zoom As Double Dim cr_h, before_formheight As Single Dim cr_w, before_formwidth As Single Rem past_point 過去の軌跡を呼び出すための変数 Rem x(past_point,0to100) Rem nowaction_flag Rem 100ステップ＝1単位演算中に、表示オブジェクトをコントロール Rem するタイマーをとりあえず無効にするためのフラグ Rem tune_x,y Rem 物理的なpictureオブジェクトのマウスクリックによる中心座標を Rem 取得するために用意された変数 Rem tune_basex,y Rem １天文単位の正方形仮想空間に対して、マウスクリックで要求さ Rem れた中心座標を翻訳するために用意された変数 Rem zoom 倍率変数。 Rem cr_h,w Rem フォームの伸縮に伴ってコントロールオブジェクトを Rem 相関伸縮させるための比率変数 Rem before_form..... Rem 前変数を機能させるための直前のフォームの大きさを記憶・格納 Rem するための変数。。 Rem past_point Rem rem for old point memory on past its orbit. Rem x(past_point,0to100) Rem nowaction_flag Rem the flag control TimerEvent to control Rem displayobject(picture box,TXT box) & under cal;culcational unit. Rem tune_x,y Rem to get central point of real picture objectby mouse click. Rem base_tunex,y Rem rem rem to get central point of squere virtual space of Rem 1AU, by mouse click.(those are transfered from native Rem tune_x,y and zoomingparameters.) Rem cr_h,w (height and width) Rem rational parameters to wide and shrink all control visula object Rem with mather form control. Rem before_form..... Rem rem rem rem rem rem parameters of just before bigthes of Rem mather form for to work the cr_h,w. Rem ========================================================= Rem フォームをクリックしたとき、コントロールの大きさを伸縮 Rem change bigthes of control object when form wide or shrinks. Rem ========================================================= Public Sub form_click() Rem poはpan_object（汎用構造体）の意 Rem po is pan_object. cr_h = Form1.Height / before_formheight cr_w = Form1.Width / before_formwidth before_formheight = Form1.Height before_formwidth = Form1.Width Rem =txt== Set po = accelchk_txt: GoSub gen Set po = eachmass_txt: GoSub gen Rem Set Set po = speedave_txt: GoSub gen Set po = howlongyears_txt: GoSub gen Set po = n_txt: GoSub gen Set po = nowtime_txt: GoSub gen Set po = auindicate_txt: GoSub gen Set po = zoomindicate_txt: GoSub gen Rem =btn== Set po = go_btn: GoSub gen Set po = continue_btn: GoSub gen Set po = pause_btn: GoSub gen Set po = exit_btn: GoSub gen Rem ==vsb== Set po = zoom_vsb: GoSub gen Rem ==picture_box== Set po = Picture1: GoSub gen Rem =lbl== Set po = Label1: GoSub gen Set po = Label2: GoSub gen Set po = Label3: GoSub gen Set po = Label4: GoSub gen Set po = Label5: GoSub gen Set po = Label6: GoSub gen GoTo escape gen: With po .Top = .Top * cr_h .Height = .Height * cr_h .Left = .Left * cr_w .Width = .Width * cr_w End With Return escape: tune_x = Picture1.ScaleWidth / 2 tune_y = Picture1.ScaleHeight / 2 Call init_persepective Call pastpoint_redraw Call pixel_func End Sub Rem ========================================================= Rem フォーム読み出され時の変数初期化 Rem initialize parameters whrn form loaded. Rem ========================================================= Public Sub form_load() Rem フォームとピクチャウィンドウの初期化 Rem initialize form and picturebox window. Form1.Cls Picture1.Cls Picture1.DrawWidth = 1 Picture1.BackColor = &H0& Picture1.ForeColor = &HFFFF& Rem フォーム・コントロールオブジェクト Rem 伸縮変数の初期化 Rem parameters for controlobjects. Rem -size initialize. cr_w = 1 cr_h = 1 before_formwidth = Form1.Width before_formheight = Form1.Height Rem 操作ボタン・イベントタイマー関係の初期化 Rem initialize operational btn and event timer. continue_btn.Visible = False past_point = 0 Timer1.Interval = 1 '1mili sec. nowaction_flag = 1 Rem 演算時間変数の初期化 Rem initialize differncial small time unit. dtd = 0.25 timecounter = 0 Rem 天文単位インジケータの初期化 Rem initialize AU unit indicater txt box. auindicate_txt.Text = "0 AU" Rem クリック>>センター点移動変数の初期化 Rem parameters click>> for picture object center point getting. tune_x = Picture1.ScaleWidth / 2 tune_y = Picture1.ScaleHeight / 2 base_tunex = tune_x base_tuney = tune_y justbefore_dotx = 0 justbefore_doty = 0 Rem ズーム変数とズームオブジェクトの初期化。 Rem initialize parameter and zoom ,zoom control object. zoomindicate_txt.Text = "1 ZOOM" zoom = 1 zoom_vsb.Max = 10 ^ 2 zoom_vsb.Min = 0 zoom_vsb.Value = 10 ^ 2 / 2 Rem 入力ウィンドウに推奨値を初期代入 Rem initialize parameter TXT box. n_txt.Text = 3 eachmass_txt.Text = 0.1 speedave_txt.Text = 2 howlongyears_txt.Text = 100 accelchk_txt.Text = 0.1 Rem 天文基本変数の値の宣言。 Rem declear numbers of astro parameters of base. earthspeed = 2 * 3.141592 / 365.251 gconst = 5.2 / (10 ^ 8) sungravity = 3.3 * (10 ^ 5) * gconst * earthspeed Rem n＝質点数に基づいて初期速度と座標を決定する。 Rem decide random vector init.speed and xy point of each Rem cerestron. Call making_randomtune End Sub Rem ===================================================================== Rem テキストボックスで変数の取得・入力 Rem Input Some Parameter on TXT box. Rem ===================================================================== Rem 質点の数 n_txt. Rem 質点の平均質量 eachmass_txt. Rem 質点の平均初期速度 speedave_txt. Rem 監視用過剰加速度の設定 accelchk_txt. Rem どのくらいの期間演算するのか。howlongyears_txt. Rem 質点の数 n_txt. Public Sub n_txt_lostfocus() If Val(n_txt.Text) < 0 + 0.5 Or _ 100 < Val(n_txt.Text) Then MsgBox ("天体数は０から１００個までです"), 48 _ : n_txt.Text = 3 n = Val(n_txt.Text) End Sub Rem 新しい変数が旧演算データに割り込むのを防ぐための機能 Rem function to defence to confuse old para. and new parameter numbers. Public Sub n_txt_change() continue_btn.Visible = False End Sub Rem 質点の平均質量 eachmass_txt. Public Sub eachmass_txt_lostfocus() If Val(eachmass_txt.Text) < 0 + 0.01 Or _ 300 < Val(eachmass_txt.Text) Then MsgBox ("平均質量は0.01-300太陽質量です"), 48 _ : eachmass_txt.Text = 0.1 eachmass = Val(eachmass_txt.Text) End Sub Public Sub eachmass_txt_change() continue_btn.Visible = False End Sub Rem 質点の平均初期速度 speedave_txt. Public Sub speedave_txt_lostfocus() If Val(speedave_txt.Text) < 0 + 0.1 Or _ 500 < Val(speedave_txt.Text) Then MsgBox ("平均初期速度は0.1-500地球公転速度です"), 48 _ : speedave_txt.Text = 2 speedave = Val(speedave_txt.Text) End Sub Public Sub speedave_txt_change() continue_btn.Visible = False End Sub Rem 監視用過剰加速度の設定 accelchk_txt. Public Sub accelchk_txt_lostfocus() If Val(accelchk_txt.Text) < 0 + 0.0001 Or _ 10 < Val(accelchk_txt.Text) Then MsgBox ("積算加速度監視値は0.0001-10地球公転速度です"), 48 _ : accelchk_txt.Text = 0.1 accel_chk = Val(accelchk_txt.Text) End Sub Public Sub acclechk_btn_change() continue_btn.Visible = False End Sub Rem どのくらいの期間演算するのか。howlongyears_txt. Public Sub howlongyears_txt_lostfocus() If Val(howlongyears_txt.Text) < 0 + 0.1 Or _ 10000 < Val(howlongyears_txt.Text) Then MsgBox ("計算期間は0.1-10000年です"), 48 _ : howlongyears_txt.Text = 100 howlongyears = Val(howlongyears_txt.Text) howlong = howlongyears * 365.251 End Sub Public Sub howlongyears_txt_change() continue_btn.Visible = False End Sub Rem ========================================================= Rem 各質点の初期速度と座標を乱数で決定 Rem each point's first vector speed and xy points. Rem ========================================================= Public Sub making_randomtune() Dim random As Integer Dim theta, tmp_d As Double For random = 1 To n Rem 平方根sqrは中心集中を避けるための補正。 Rem squrer function to defend to gather to center tendency in first time. theta = 2 * 3.141592 * Rnd(1) tmp_d = Rnd(1) x(past_point, random) = Sqr(tmp_d) * Cos(theta) y(past_point, random) = Sqr(tmp_d) * Sin(theta) theta = 2 * 3.141592 * Rnd(1) tmp_d = Rnd(1) vx(random) = earthspeed * speedave * (tmp_d) * Cos(theta) vy(random) = earthspeed * speedave * (tmp_d) * Sin(theta) Next random Rem 計算した座標に基づいて質点を描画散布 Rem draw and spread all cerestron points from memory forcely. Call pixel_func End Sub Rem ========================================================= Rem 機能ボタンの機能設定群 Rem function declear of action button. Rem ========================================================= Rem 終了ボタン Rem exit_btn. Public Sub exit_btn_click() Unload Me End Sub Rem 中断ボタン（イベントタイマーが演算を開始できない旗を立てる） Rem pause_btn(rise flag not to permit to make take Rem to calculation to EventTimer). Public Sub pause_btn_click() nowaction_flag = 1 End Sub Rem 再開ボタン（イベントタイマーが演算を開始できる旗を立てる） Rem continue_btn (rise flag to permit to EventTimer) Public Sub continue_btn_click() nowaction_flag = 0 End Sub Rem 開始ボタン 一切を初期化し、演算を開始する Rem go_btn (initialize all parameters needed,and send signal Rem going first). Public Sub go_btn_click() Dim init_i, init_hundred As Integer Dim tmp_au As Single Rem 入力ウィンドウから変数を取得 Rem getting parameters from TXT boxes. Call n_txt_lostfocus Call eachmass_txt_lostfocus Call speedave_txt_lostfocus Call howlongyears_txt_lostfocus Call accelchk_txt_lostfocus Rem 過去質点軌跡配列変数をクリア Rem clear past orbitmemory points. For init_i = 1 To 100 Rem 101番は支点変数（常にx,y(101,任意点)＝０）。 Rem x,y(pastpoint=101)=0 always is a fulcrum points. Rem for drawing logic For init_hundred = 1 To 101 x(init_hundred, init_i) = 0 y(init_hundred, init_i) = 0 Next init_hundred Next init_i Rem 過去質点軌跡線描画用補助変数をクリア Rem clear helpparameters to orbit line drawing. justbfore_dotx = 0 justbefore_doty = 0 Rem マウスクリック用平行移動変数を初期化 Rem initialize parameters to paralell stroke by mouse click. tune_x = Picture1.ScaleWidth / 2 tune_y = Picture1.ScaleHeight / 2 base_tunex = Picture1.ScaleWidth / 2 base_tuney = Picture1.ScaleHeight / 2 Rem 中心距離インジケータを初期化 Rem initialize auindicate_txt.Text. tmp_au = _ Sqr((Picture1.ScaleWidth / 2 - base_tunex) ^ 2 + _ (Picture1.ScaleHeight / 2 - base_tuney) ^ 2) _ / (Picture1.ScaleWidth / 2) auindicate_txt.Text = Int(tmp_au * 100) / 100 Rem ズーム変数・ズームオブジェクト、インジケータを初期化 Rem initializing parameter of zoom and zoom TXT box as indicater. zoom = 1 zoom_vsb.Value = 10 ^ 2 / 2 zoomindicate_txt.Text = Int(zoom * 100) / 100 Rem 質点の速度と座標を乱数決定 Rem all cerestron's vector speed and xp points. Call making_randomtune Rem 現在の演算時間を０に設定 Rem set nowtime is 0. timecounter = 0 Rem 画面をクリア Rem clear picturebox as virtual space. Call init_persepective Rem 継続ボタンを出現させる Rem be true on continue_btn. continue_btn.Visible = True Rem 継続ボタンに処理を渡す Rem pass process to continue_btn process. Call continue_btn_click End Sub Rem タイマーイベント：演算不可の旗が立っていなければ Rem 演算プロセスを呼ぶ Rem if flag permits to go,then call calculational function as under process. Public Sub timer1_timer() Rem 時間になれば処理を中止する論理になるように設定 Rem 'howlong' is calculational terminal limit. If howlong < timecounter Then nowaction_flag = 1: GoTo escape Rem Δ日時は初期設定１／４＝６時間//微小時間を初期化 Rem deltatimedays=1/4 days firstly//initialize dtd. dtd = 0.25 If nowaction_flag = 0 Then Call calc_bystep escape: End Sub Rem 演算プロセス本体 Rem main calculational process. Public Sub calc_bystep() Dim i, j, hundred As Integer Dim accelchk_by2 As Double nowaction_flag = 1 Rem 一度呼ばれたら、必ず100ステップの演算を実行。 Rem at least 100times calc. on one timer event. For hundred = 1 To 100 Rem 任意の質点を選出 Rem choice one from n numbers cestron. For i = 1 To n Rem 微小初期速度を初期化 Rem initialize deltatimedays. dtd = 0.25 Rem その１質点の積算重力を計算 Rem process block :whole gravity sum influences on the one cerestron. Rem 積算加速度過剰の場合の再計算のためのジャンプ先 Rem the escapepoint when error occured over accel gravity chk limit. secondloop: sumax = 0 sumay = 0 Rem 積算重力の演算 Rem calculation gravity sum influences. For j = 1 To n Rem 自分自身の差分を演算しないようにする Rem if oppsite and it self be same,occuered calculational error. If i = j Then GoTo sameserial_nopassaway d = (x(past_point, i) - x(past_point, j)) ^ 2 + (y(past_point, i) - y(past_point, j)) ^ 2 ax = -(x(past_point, i) - x(past_point, j)) / (d * Sqr(d)) ay = -(y(past_point, i) - y(past_point, j)) / (d * Sqr(d)) ax = eachmass * earthspeed * ax ay = eachmass * earthspeed * ay accel = Sqr(ax * ax + ay * ay) sumax = sumax + ax sumay = sumay + ay Rem 演算が遅くなるのでできるだけ平方根は使いたくない Rem more quick ^2 logic than sqr on PC. Rem sumaccel = Sqr(sumax * sumax + sumay * sumay) sumaccel_by2 = sumax * sumax + sumay * sumay Rem 常に中間段階で加速度の累積を監視し、途中でも Rem 規定変数を超えたらその時点で演算を中止してループを抜け、 Rem 無駄な演算を行わないようにする。 Rem always admin. accel over chk on this process loop, Rem escape not until process logical end,and expect Rem quick calculational. Rem if accel_chk>過去軌跡の描画>現在質点の再描画 Rem init. picturebox >>pastpoint orbit redraw>now n points forcely draw. Call init_persepective Call pastpoint_redraw Call pixel_func End Sub Rem ズーム・スクロールバーのコントロール論理 Rem logic to control zoom scroll bar. Public Sub zoom_vsb_change() Rem コントロールバーの数値は指数として取得、 Rem zoom ob ject's control paramerter is log. number. zoom = (10 ^ 5) ^ (Val(zoom_vsb.Value) / (10 ^ 2 / 2) - 1) Rem ズームインジケート窓に表示 Rem indicate zoom. zoomindicate_txt.Text = Int(zoom * 100) / 100 Rem 仮想空間調整座標変数とズーム変数から Rem ウィンドウズピクチャオブジェクト用の変数を算出 Rem calcuration picture object paralell center parameter Rem from virtual space paralell center and zoom parameters. tune_x = (1 - zoom) * Picture1.ScaleWidth / 2 + zoom * base_tunex tune_y = (1 - zoom) * Picture1.ScaleHeight / 2 + zoom * base_tuney Rem 画面の初期化>>過去軌跡の描画>現在質点の再描画 Rem intialize picturebox>>past point orbit point redraw> Rem forcely Now 'n' numbers points at once. Call init_persepective Call pastpoint_redraw Call pixel_func End Sub Rem 画面の初期化 Rem initialize picturebox as virtual space. Public Sub init_persepective() Rem 画面表示を消去 Rem forcely clear Picture1.Cls Rem 共有中心方向へのコンパス線を引く Rem commpas line drawed to commonvirtual space center. Picture1.Line (Picture1.ScaleWidth / 2, Picture1.ScaleHeight / 2)-(tune_x, tune_y), QBColor(7) Rem 共有中心から半径１天文単位の範囲円を描く Rem （埒外noaction論理込み） Rem draw 1AU from common virtual space center. Rem (if it be on out of space, it will be no action.) circle_centerx = tune_x + 0.5 If circle_centerx < 0 - ScaleWidth / 2 Then GoTo no_circledraw If 3 * ScaleWidth / 2 < circle_centerx Then GoTo no_circledraw circle_centery = tune_y + 0.5 If circle_centery < 0 - ScaleHeight / 2 Then GoTo no_circledraw If 3 * ScaleHeight / 2 < circle_centery Then GoTo no_circledraw Picture1.Circle (circle_centerx, circle_centery), zoom * Picture1.ScaleWidth / 2, QBColor(7) no_circledraw: End Sub Rem 現在の質点を再描画する Rem redraw now time points forcely at once. Public Sub pixel_func() Dim n_number As Integer Rem 質点を一つずつよぶ Rem call n point one by one. For n_number = 1 To n Rem 点は現在の変数を指定 Rem set nowtime as 0. past_point = 0 Rem 赤色を指定して下請け処理にまわす Rem choice red point color and call sub function. Call pixel_funcsub(&HFF&, n_number) 'red. Next n_number End Sub Rem 過去の質点の軌跡を再描画する Rem past orbit point and orbit line redraw. Public Sub pastpoint_redraw() Dim n_number As Integer Dim justbefore_dotx, justbefore_doty As Single Rem 質点を通し番号で順によぶ Rem call 'n' point one by one. For n_number = 1 To n Rem 過去軌跡線描画用補助変数の初期化 Rem help juste before point parametr to draw line whites. justbefore_dotx = 0 justbefore_doty = 0 Rem ある１質点を過去のすべての時間番地を呼び出して再描画する Rem １００番が最も古く、1番がもっとも新しい Rem old orbit redraw. Rem past_point old to new. (No.100>1). For past_point = 100 To 1 Step -1 Rem 色を白色に指定して下請け処理にまわす Rem call choice white color and call sub function. Call pixel_funcsub(&HFFFFFF, n_number) 'white. Next past_point Next n_number Rem 質点時間変数を現在に再設定して終了 Rem time parameter be made as now and then take end. past_point = 0 End Sub Rem 質点再描画下請け処理 Rem sub function dot and line drawing. Public Sub pixel_funcsub(dot_color As Variant, n_number As Integer) Dim result_x, result_y As Variant Rem ズーム変数と中心フォーカス変数により Rem ピクチャオブジェクトに質点を撒いていく Rem Rem 埒外描画待避論理折り込み済み Rem spread dots by zoom and paralell stroking parameters. Rem (out of site is no action as draw.) result_x = zoom * (Picture1.ScaleWidth / 2) * x(past_point, n_number) result_x = result_x + tune_x + 0.5 result_y = -zoom * (Picture1.ScaleHeight / 2) * y(past_point, n_number) result_y = result_y + tune_y + 0.5 If x(past_point, n_number) = 0 Then GoTo no_draw If y(past_point, n_number) = 0 Then GoTo no_draw Rem If past_point = 100 Then GoTo jump_tmp Rem Rem 101番を支点変数として確保しているのでこの論理は要らない Rem this logic line no needs ,fore x,y(101,n) is using as Rem fulcrum functional. If x(past_point + 1, n_number) = 0 Then justbefore_dotx = result_x If y(past_point + 1, n_number) = 0 Then justbefore_doty = result_y If justbefore_dotx = 0 Then justbefore_dotx = result_x If justbefore_doty = 0 Then justbefore_dotx = result_y Rem jump_tmp: If result_x < 0 - Picture1.ScaleWidth / 2 Then GoTo no_draw If 3 * Picture1.ScaleWidth / 2 < result_x Then GoTo no_draw If result_y < 0 - Picture1.ScaleWidth / 2 Then GoTo no_draw If 3 * Picture1.ScaleHeight / 2 < result_y Then GoTo no_draw Picture1.Circle (result_x, result_y), 1, dot_color If dot_color = &HFFFFFF Then _ Picture1.Line (justbefore_dotx, justbefore_doty)-(result_x, result_y), dot_color no_draw: If dot_color = &HFFFFFF Then _ justbefore_dotx = result_x: justbefore_doty = result_y End Sub Rem ============================================================= Rem プロセスの終わり Rem Processes' END. Rem ============================================================