VERSION 5.00 Begin VB.Form Galaxy BackColor = &H00000000& Caption = "Galaxy" ClientHeight = 5985 ClientLeft = 1695 ClientTop = 1875 ClientWidth = 6930 ClipControls = 0 'False ForeColor = &H00FFFFFF& Icon = "Galaxy.frx":0000 LinkTopic = "Form1" ScaleHeight = 5985 ScaleWidth = 6930 StartUpPosition = 2 'CenterScreen Begin VB.CheckBox CICheck BackColor = &H00000000& Caption = "Center Intruder" ForeColor = &H00FFFFFF& Height = 225 Left = 3600 TabIndex = 15 Top = 435 Width = 1350 End Begin VB.CheckBox CGCheck BackColor = &H00000000& Caption = "Center Galaxy" ForeColor = &H00FFFFFF& Height = 225 Left = 3600 TabIndex = 16 Top = 690 Width = 1290 End Begin VB.CheckBox PinGalaxyCheck BackColor = &H00000000& Caption = "Pin Galaxy" ForeColor = &H00FFFFFF& Height = 225 Left = 3600 TabIndex = 17 Top = 945 Width = 1140 End Begin VB.TextBox RingsBox BackColor = &H00C0C0C0& Height = 285 Left = 5355 TabIndex = 4 Text = "30" Top = 75 Width = 600 End Begin VB.TextBox BandsBox BackColor = &H00C0C0C0& Height = 285 Left = 4095 TabIndex = 3 Text = "8" Top = 75 Width = 600 End Begin VB.TextBox ScaleBox BackColor = &H00C0C0C0& Height = 285 Left = 1020 TabIndex = 1 Text = "10" Top = 75 Width = 600 End Begin VB.CommandButton InfoButton Caption = "Info" Height = 345 Left = 6180 TabIndex = 14 Top = 75 Width = 645 End Begin VB.CommandButton ContinueButton Caption = "Continue" Height = 405 Left = 2415 TabIndex = 13 Top = 1275 Width = 1080 End Begin VB.CommandButton StopButton Caption = "Stop" Height = 405 Left = 1305 TabIndex = 12 Top = 1275 Width = 1080 End Begin VB.CommandButton StartButton Caption = "Start" Height = 405 Left = 195 TabIndex = 11 Top = 1275 Width = 1080 End Begin VB.CheckBox FewerCheck BackColor = &H00000000& Caption = "Fewer Stars" ForeColor = &H00FFFFFF& Height = 270 Left = 3600 TabIndex = 18 Top = 1185 Width = 1170 End Begin VB.CheckBox StarsCheck BackColor = &H00000000& Caption = "Show Stars" ForeColor = &H00FFFFFF& Height = 270 Left = 3600 TabIndex = 19 Top = 1440 Value = 1 'Checked Width = 1185 End Begin VB.TextBox MassBox BackColor = &H00C0C0C0& ForeColor = &H00000000& Height = 285 Left = 2820 TabIndex = 2 Text = ".9" Top = 75 Width = 600 End Begin VB.TextBox VzBox BackColor = &H00C0C0C0& ForeColor = &H00000000& Height = 285 Left = 2820 TabIndex = 10 Text = "-.8" Top = 855 Width = 600 End Begin VB.TextBox VyBox BackColor = &H00C0C0C0& ForeColor = &H00000000& Height = 285 Left = 1920 TabIndex = 9 Text = "-.1" Top = 855 Width = 600 End Begin VB.TextBox VxBox BackColor = &H00C0C0C0& ForeColor = &H00000000& Height = 285 Left = 1020 TabIndex = 8 Text = "-.4" Top = 855 Width = 600 End Begin VB.TextBox PzBox BackColor = &H00C0C0C0& ForeColor = &H00000000& Height = 285 Left = 2820 TabIndex = 7 Text = "100" Top = 465 Width = 600 End Begin VB.TextBox PyBox BackColor = &H00C0C0C0& ForeColor = &H00000000& Height = 285 Left = 1920 TabIndex = 6 Text = "0" Top = 465 Width = 600 End Begin VB.TextBox PxBox BackColor = &H00C0C0C0& ForeColor = &H00000000& Height = 285 Left = 1020 TabIndex = 5 Text = "0" Top = 465 Width = 600 End Begin VB.Label Label13 BackColor = &H00000000& Caption = "Rings:" ForeColor = &H00FFFFFF& Height = 240 Left = 4845 TabIndex = 34 Top = 120 Width = 510 End Begin VB.Label Label2 BackColor = &H00000000& Caption = "Bands:" ForeColor = &H00FFFFFF& Height = 240 Left = 3540 TabIndex = 33 Top = 120 Width = 555 End Begin VB.Label Label12 BackColor = &H00000000& Caption = "Scale:" ForeColor = &H00FFFFFF& Height = 210 Left = 495 TabIndex = 32 Top = 120 Width = 510 End Begin VB.Label Label11 BackColor = &H00000000& Caption = "Galaxy Collision Simulator" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000080FF& Height = 600 Left = 5115 TabIndex = 31 Top = 660 Width = 1680 End Begin VB.Label XZViewLabel BackColor = &H00000000& Caption = "X-Z View" ForeColor = &H00FFFF00& Height = 240 Left = 4635 TabIndex = 30 Top = 5670 Width = 900 End Begin VB.Label XYViewLabel BackColor = &H00000000& Caption = "X-Y View" ForeColor = &H00FFFF00& Height = 240 Left = 1080 TabIndex = 29 Top = 5670 Width = 810 End Begin VB.Label TimeLabel BackColor = &H00000000& Caption = "Time: 0" ForeColor = &H000080FF& Height = 210 Left = 5130 TabIndex = 28 Top = 1485 Width = 1740 End Begin VB.Label Label10 BackColor = &H00000000& Caption = "Z:" ForeColor = &H00FFFFFF& Height = 225 Left = 2610 TabIndex = 27 Top = 885 Width = 255 End Begin VB.Label Label9 BackColor = &H00000000& Caption = "Y:" ForeColor = &H00FFFFFF& Height = 240 Left = 1710 TabIndex = 26 Top = 885 Width = 195 End Begin VB.Label Label8 BackColor = &H00000000& Caption = "X:" ForeColor = &H00FFFFFF& Height = 225 Left = 810 TabIndex = 25 Top = 885 Width = 210 End Begin VB.Label Label7 BackColor = &H00000000& Caption = "Z:" ForeColor = &H00FFFFFF& Height = 225 Left = 2610 TabIndex = 24 Top = 510 Width = 255 End Begin VB.Label Label6 BackColor = &H00000000& Caption = "X:" ForeColor = &H00FFFFFF& Height = 225 Left = 810 TabIndex = 23 Top = 510 Width = 210 End Begin VB.Label Label5 BackColor = &H00000000& Caption = "Y:" ForeColor = &H00FFFFFF& Height = 240 Left = 1710 TabIndex = 22 Top = 510 Width = 195 End Begin VB.Label Label4 BackColor = &H00000000& Caption = "Mass Ratio:" ForeColor = &H00FFFFFF& Height = 195 Left = 1905 TabIndex = 21 Top = 105 Width = 930 End Begin VB.Label Label3 BackColor = &H00000000& Caption = "Velocity" ForeColor = &H00FFFFFF& Height = 240 Left = 150 TabIndex = 20 Top = 885 Width = 600 End Begin VB.Label Label1 BackColor = &H00000000& Caption = "Intruder" ForeColor = &H00FFFFFF& Height = 225 Left = 150 TabIndex = 0 Top = 510 Width = 615 End End Attribute VB_Name = "Galaxy" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False 'GALAXY for VB by Terry Newton, made December 2001 ' 'Based on QB code from "Galactic Slam Dance" by Douglas E. Music, 'which was derived from a program published in the December 1988 'Astronomy in the article "Galactic Collisions on Your Computer" 'by Michael C. Schroeder and Neil F. Comins, page 91. ' 'This VB version is public domain. The QB code it came from was 'declared PD by the author, it is (at the time of writing) at: 'ftp://seds.lpl.arizona.edu/pub/software/pc/gravity/gc3d.zip ' 'To recompile the following must be added to the project... '------ cut SetPix.bas -------------- 'Attribute VB_Name = "SetPix" 'Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, _ ' ByVal x As Long, ByVal y As Long, ByVal colr As Long) As Long '------ stop cutting ---------------- Option Explicit Const FewerRatio = 10 'thinning factor for plotting fewer stars Const M1 = 5 'mass of main galaxy, value from QB code Const Stars = 10000 'could probably handle more Dim x(Stars) As Double 'x/y/z coordinates for each star Dim y(Stars) As Double Dim z(Stars) As Double Dim vx(Stars) As Double 'x/y/z velocities for each star Dim vy(Stars) As Double Dim vz(Stars) As Double Dim M2 As Double 'mass of intruder Dim x1 As Double 'main galaxy x,y,z coordinates Dim y1 As Double Dim z1 As Double Dim vx1 As Double ' and velocities Dim vy1 As Double Dim vz1 As Double Dim x2 As Double 'intruder coordinates Dim y2 As Double Dim z2 As Double Dim vx2 As Double ' and velocities Dim vy2 As Double Dim vz2 As Double Dim px2 As Double 'temps Dim py2 As Double Dim pz2 As Double Dim pvx2 As Double Dim pvy2 As Double Dim pvz2 As Double Dim OldX As Double 'old star position Dim OldY As Double Dim OldZ As Double Dim NewX As Double 'newly calculated position Dim NewY As Double Dim NewZ As Double Dim DintX As Double 'distances from star to intruder Dim DintY As Double Dim DintZ As Double Dim DgalX As Double 'distances from star to galaxy Dim DgalY As Double Dim DgalZ As Double Dim d1 As Double 'used in star distance Dim d2 As Double Dim f1 As Double ' and force calculations Dim f2 As Double Dim d As Double 'galaxy distance (cubed) Dim dx As Double 'distance components Dim dy As Double Dim dz As Double Dim f As Double 'total force Dim fx As Double 'force components Dim fy As Double Dim fz As Double Dim dr As Double 'for initial orbit calculations Dim v As Double Dim r As Double Dim t As Double Dim time As Long 'simulation time step Dim nrr As Long 'number of star rings Dim nrs As Long 'number of star bands Dim ns As Long 'total number of stars Dim i As Integer 'loop vars Dim ir As Integer Dim it As Integer Dim maxx As Double 'max X and Y (+- after offsetting) Dim maxy As Double ' to keep stars in the boxes Dim maxix As Double 'a little less to keep galaxies Dim maxiy As Double ' from hitting the edge Dim maxcx As Double 'well inside the box to trigger Dim maxcy As Double ' auto-centering when galaxy strays Dim tempX As Double Dim tempY As Double Dim tempZ As Double Dim PlotScale As Double 'multiply centered x/y/z by this to get twips Dim ofsX As Double 'x/y/z offsets to center starfield Dim ofsY As Double Dim ofsZ As Double Dim XTwips As Double 'twips per X pixel (15 here but calculated Dim YTwips As Double 'twips per Y pixel in case it varies...) Dim xx As Long 'actual screen location, twips for galaxies Dim yy As Long ' pixels for stars Dim Running As Boolean 'simulation quasi-thread runs until false Dim Initialised As Boolean 'true if variables have been init'd Dim ShowStars As Boolean 'if true stars are drawn Dim FewerStars As Boolean 'if true only 1/10 of the stars are drawn Dim Painting As Boolean 'lockout to prevent refresh loops Dim DisplayStar As Boolean 'temp var to decide if star should be shown Dim PinGalaxy As Boolean 'if true main galaxy cannot move Dim CenterGalaxy As Boolean 'if true tracks main galaxy position Dim CenterIntruder As Boolean 'if true tracks intruder (both can't be true) Dim ClearGrFlag As Boolean 'flag to avoid cls the very first time Dim Gr1Left As Long 'X start of X-Y view (all in twips) Dim Gr2Left As Long 'X start of X-Z view Dim GrTop As Long 'Y start of both views Dim GrWidth As Long 'width of each view Dim GrHeight As Long 'height of each view Dim Gr1Xcenter As Long 'X centerpoint of X-Y view Dim Gr2Xcenter As Long 'X centerpoint of X-Z view Dim GrYcenter As Long 'Y centerpoint of both views Dim BGColor As Long 'background color determined by form background Dim StarColor As Long 'other colors defined in the form_load sub Dim GalaxyColor As Long Dim IntruderColor As Long Dim FrameColor As Long Sub Initialise() 'mostly copied more or less as is from the QB code, this 'sub clears all arrays, resets variables that need clearing 'and gets others from the gui form (were inputs), and creates 'an initial stable galaxy in the X-Y plane For i = 0 To Stars x(i) = 0: y(i) = 0: z(i) = 0 vx(i) = 0: vy(i) = 0: vz(i) = 0 Next i nrr = Val(RingsBox.Text) nrs = Val(BandsBox.Text) ns = nrr * nrs If ns < 4 Or ns > Stars Then MsgBox ("Bands times Rings must be between 4 and" + Str$(Stars)) Running = False Else dr = 30 / (nrr - 1) x2 = Val(PxBox.Text) y2 = Val(PyBox.Text) z2 = Val(PzBox.Text) vx2 = Val(VxBox.Text) vy2 = Val(VyBox.Text) vz2 = Val(VzBox.Text) M2 = Val(MassBox.Text) * M1 If M2 = 0 Then MsgBox ("The instruder must have mass") Running = False Else x1 = 0: y1 = 0: z1 = 0 'vars to let galaxy roam free (were temps) vx1 = 0: vy1 = 0: vz1 = 0 'not used in orig code but now using ofsX = 0: ofsY = 0: ofsZ = 0 'offset from center time = 0: i = 0 For ir = 1 To nrr r = 20 + ir * dr v = Sqr(M1 / r) For it = 1 To nrs t = it * 6.283185 / nrs i = i + 1 x(i) = r * Cos(t) y(i) = r * Sin(t) z(i) = 0 vx(i) = -v * Sin(t) vy(i) = v * Cos(t) vz(i) = 0 Next it Next ir Initialised = True End If End If End Sub Sub DoSimulation() 'based on the QB code but I messed with it quite a bit, 'especially in the galaxy movement calculations. 'Added scaled/clipped pixel-plotting code in-line, 'using GDI32 call (SetPixel from SetPix.bas) for speed While Running For i = 1 To ns OldX = x(i) OldY = y(i) OldZ = z(i) DintX = x2 - OldX DintY = y2 - OldY DintZ = z2 - OldZ DgalX = OldX - x1 DgalY = OldY - y1 DgalZ = OldZ - z1 d1 = DgalX * DgalX + DgalY * DgalY + DgalZ * DgalZ d2 = DintX * DintX + DintY * DintY + DintZ * DintZ f1 = M1 / (d1 * Sqr(d1)) f2 = M2 / (d2 * Sqr(d2)) tempX = vx(i) - f1 * DgalX + f2 * DintX tempY = vy(i) - f1 * DgalY + f2 * DintY tempZ = vz(i) - f1 * DgalZ + f2 * DintZ vx(i) = tempX vy(i) = tempY vz(i) = tempZ NewX = OldX + tempX NewY = OldY + tempY NewZ = OldZ + tempZ x(i) = NewX y(i) = NewY z(i) = NewZ If ShowStars Then 'added switches DisplayStar = True If FewerStars Then 'thin if selected... If i Mod FewerRatio > 0 Then DisplayStar = False End If If DisplayStar Then 'erase pixel for OldX,OldY,OldZ tempX = OldX - ofsX tempY = OldY - ofsY tempZ = OldZ - ofsZ If tempX < maxx And tempX > -maxx Then If tempY < maxy And tempY > -maxy Then xx = (tempX * PlotScale + Gr1Xcenter) / XTwips yy = (tempY * -PlotScale + GrYcenter) / YTwips SetPixel Galaxy.hdc, xx, yy, BGColor End If If tempZ < maxy And tempZ > -maxy Then xx = (tempX * PlotScale + Gr2Xcenter) / XTwips yy = (tempZ * -PlotScale + GrYcenter) / YTwips SetPixel Galaxy.hdc, xx, yy, BGColor End If End If 'plot pixel for NewX,NewY,NewZ tempX = NewX - ofsX tempY = NewY - ofsY tempZ = NewZ - ofsZ If tempX < maxx And tempX > -maxx Then If tempY < maxy And tempY > -maxy Then xx = (tempX * PlotScale + Gr1Xcenter) / XTwips yy = (tempY * -PlotScale + GrYcenter) / YTwips SetPixel Galaxy.hdc, xx, yy, StarColor End If If tempZ < maxy And tempZ > -maxy Then xx = (tempX * PlotScale + Gr2Xcenter) / XTwips yy = (tempZ * -PlotScale + GrYcenter) / YTwips SetPixel Galaxy.hdc, xx, yy, StarColor End If End If End If 'displaystar End If 'showstars Next i 'move both galaxies... highly modified from original dx = x2 - x1 dy = y2 - y1 dz = z2 - z1 d = dx * dx + dy * dy + dz * dz If d = 0 Then Running = False MsgBox ("Change parameters to avoid head-on collision") StopButton.Enabled = False ContinueButton.Enabled = False StartButton.Enabled = True Else f = (M1 * M2) / (d * Sqr(d)) fx = f * dx fy = f * dy fz = f * dz If PinGalaxy Then vx1 = 0 vy1 = 0 vz1 = 0 Else vx1 = vx1 + fx / M1 vy1 = vy1 + fy / M1 vz1 = vz1 + fz / M1 End If vx2 = vx2 - fx / M2 vy2 = vy2 - fy / M2 vz2 = vz2 - fz / M2 PlotGalaxy x1, y1, z1, BGColor, 0 PlotGalaxy x2, y2, z2, BGColor, 0 x1 = x1 + vx1 y1 = y1 + vy1 z1 = z1 + vz1 x2 = x2 + vx2 y2 = y2 + vy2 z2 = z2 + vz2 DrawBothGalaxies time = time + 1 TimeLabel.Caption = "Time:" + Str$(time) 'auto-center galaxy/intruder if selected If CenterGalaxy Then tempX = x1 - ofsX tempY = y1 - ofsY tempZ = z1 - ofsZ If tempX > maxcx Or tempX < -maxcx _ Or tempY > maxcy Or tempY < -maxcy _ Or tempZ > maxcy Or tempZ < -maxcy Then MoveUniverse x1, y1, z1 'undraw everything and recenter End If End If If CenterIntruder Then tempX = x2 - ofsX tempY = y2 - ofsY tempZ = z2 - ofsZ If tempX > maxcx Or tempX < -maxcx _ Or tempY > maxcy Or tempY < -maxcy _ Or tempZ > maxcy Or tempZ < -maxcy Then MoveUniverse x2, y2, z2 End If End If End If 'for if d=0 then DoEvents Wend End Sub Sub DrawBothGalaxies() 'plot galaxies so that they overlap properly 'x-y display... If z2 > z1 Then 'intruder in front PlotGalaxy x1, y1, z1, GalaxyColor, 1 PlotGalaxy x2, y2, z2, IntruderColor, 1 Else 'galaxy in front PlotGalaxy x2, y2, z2, IntruderColor, 1 PlotGalaxy x1, y1, z1, GalaxyColor, 1 End If 'x-z display... If y2 < y1 Then 'intruder in front PlotGalaxy x1, y1, z1, GalaxyColor, 2 PlotGalaxy x2, y2, z2, IntruderColor, 2 Else 'galaxy in front PlotGalaxy x2, y2, z2, IntruderColor, 2 PlotGalaxy x1, y1, z1, GalaxyColor, 2 End If End Sub Sub MoveUniverse(px As Double, py As Double, pz As Double) 'avoid flicker from RedrawGraphics.. erase current celestial objects 'then redraw them centered on the specified coordinates PlotGalaxy x1, y1, z1, BGColor, 0 'erase galaxies PlotGalaxy x2, y2, z2, BGColor, 0 PlotStars BGColor 'erase stars ofsX = px 'center to specified ofsY = py ofsZ = pz PlotStars StarColor 'redraw stars DrawBothGalaxies End Sub Sub PlotGalaxy(px As Double, py As Double, pz As Double, _ c As Long, flag As Integer) 'this sub draws a circle at the coordinates using specified color 'flag = 0 for both, 1 to draw x-y, 2 to draw x-z (digging myself out...) 'x/y/z are universe coordinates, scaled by PlotScale, offset by ofsX-Z, 'clipped by maxx/y, centered using Gr1XCenter, Gr2XCenter, GrYCenter Dim tmpx As Double Dim tmpy As Double Dim tmpz As Double tmpx = px - ofsX tmpy = py - ofsY tmpz = pz - ofsZ If tmpx < maxix And tmpx > -maxix Then Galaxy.FillColor = c If tmpy < maxiy And tmpy > -maxiy And flag <> 2 Then xx = tmpx * PlotScale + Gr1Xcenter yy = tmpy * -PlotScale + GrYcenter Galaxy.Circle (xx, yy), 30, c End If If tmpz < maxiy And tmpz > -maxiy And flag <> 1 Then xx = tmpx * PlotScale + Gr2Xcenter yy = tmpz * -PlotScale + GrYcenter Galaxy.Circle (xx, yy), 30, c End If End If End Sub Sub RedrawGraphics() 'updates everything but blinks the buttons DrawFrame 'has a cls If Initialised Then 'don't attempt if vars uncertain PlotStars StarColor 'draw stars DrawBothGalaxies End If End Sub Sub PlotStars(colr As Long) 'the simulation code redraws itself but this is needed for 'refreshing after resizing or rescaling, and used by recentering 'code in both the simulation code and when manually triggered. 'colr=BGColor to erase, StarColor to draw. Uses PlotScale, ofsX-Z 'Gr1/2XCenter, GrYCenter, XTwips, YTwips to scale and clip, 'ShowStars/FewerStars determines stars displayed Dim myi As Integer Dim tmpx As Double Dim tmpy As Double Dim tmpz As Double If ShowStars Then For myi = 1 To ns DisplayStar = True If FewerStars Then If myi Mod FewerRatio > 0 Then DisplayStar = False End If If DisplayStar Then tmpx = x(myi) - ofsX tmpy = y(myi) - ofsY tmpz = z(myi) - ofsZ If tmpx < maxx And tmpx > -maxx Then If tmpy < maxy And tmpy > -maxy Then xx = (tmpx * PlotScale + Gr1Xcenter) / XTwips yy = (tmpy * -PlotScale + GrYcenter) / YTwips SetPixel Galaxy.hdc, xx, yy, colr End If If tmpz < maxy And tmpz > -maxy Then xx = (tmpx * PlotScale + Gr2Xcenter) / XTwips yy = (tmpz * -PlotScale + GrYcenter) / YTwips SetPixel Galaxy.hdc, xx, yy, colr End If End If End If 'displaystar Next myi End If 'showstars End Sub Sub DrawFrame() 'clear everything and draw two side-by-side boxes If ClearGrFlag Then Galaxy.Cls ClearGrFlag = True Galaxy.Line (Gr1Left, GrTop)-(Gr1Left + GrWidth, GrTop), FrameColor Galaxy.Line (Gr1Left + GrWidth, GrTop)-(Gr1Left + GrWidth, GrTop + GrHeight), FrameColor Galaxy.Line (Gr1Left + GrWidth, GrTop + GrHeight)-(Gr1Left, GrTop + GrHeight), FrameColor Galaxy.Line (Gr1Left, GrTop + GrHeight)-(Gr1Left, GrTop), FrameColor Galaxy.Line (Gr2Left, GrTop)-(Gr2Left + GrWidth, GrTop), FrameColor Galaxy.Line (Gr2Left + GrWidth, GrTop)-(Gr2Left + GrWidth, GrTop + GrHeight), FrameColor Galaxy.Line (Gr2Left + GrWidth, GrTop + GrHeight)-(Gr2Left, GrTop + GrHeight), FrameColor Galaxy.Line (Gr2Left, GrTop + GrHeight)-(Gr2Left, GrTop), FrameColor End Sub Sub UpdatePlotScale() 'called from several points to grab the scale and redraw if changed Dim a As Double a = Val(ScaleBox.Text) If a <= 0 Then ScaleBox.Text = Trim$(Str$(PlotScale)) Else If a <> PlotScale Then PlotScale = a CalcMaxes RedrawGraphics End If End If End Sub Sub CalcMaxes() 'calculate clip and autocenter points maxx = (GrWidth / 2 - 40) / PlotScale 'clip for stars maxy = (GrHeight / 2 - 40) / PlotScale maxix = (GrWidth / 2 - 60) / PlotScale 'clip for galaxy centers maxiy = (GrHeight / 2 - 60) / PlotScale maxcx = (GrWidth / 2 - 500) / PlotScale 'auto-center threshold maxcy = (GrHeight / 2 - 500) / PlotScale End Sub Private Sub CGCheck_Click() 'here if 'Center Galaxy' checked/unchecked If CGCheck.Value = 1 Then CenterGalaxy = True CenterIntruder = False CICheck.Value = 0 If Initialised Then MoveUniverse x1, y1, z1 Else CenterGalaxy = False End If End Sub Private Sub CICheck_Click() 'here if 'Center Intruder' checked/unchecked If CICheck.Value = 1 Then CenterIntruder = True CenterGalaxy = False CGCheck.Value = 0 If Initialised Then MoveUniverse x2, y2, z2 Else CenterIntruder = False End If End Sub Private Sub ContinueButton_Click() 'here if continue button is clicked 'grab the scale, twiddle with other buttons, 'set the running flag and restart the simulation UpdatePlotScale ContinueButton.Enabled = False StartButton.Enabled = False StopButton.Enabled = True StopButton.SetFocus Running = True DoSimulation End Sub Private Sub FewerCheck_Click() ''Fewer Stars' checked/unchecked, update flag and redraw FewerStars = False If FewerCheck.Value = 1 Then FewerStars = True RedrawGraphics End Sub Private Sub Form_Load() 'here first (I think!!! hard to tell sometimes) 'initialise critical variables, set flags, colors etc XTwips = Galaxy.ScaleWidth YTwips = Galaxy.ScaleHeight Galaxy.ScaleMode = 3 'pixel scaling XTwips = XTwips / Galaxy.ScaleWidth YTwips = YTwips / Galaxy.ScaleHeight Galaxy.ScaleMode = 1 'back to twips Galaxy.FillStyle = vbFSSolid PlotScale = Val(ScaleBox.Text) ContinueButton.Enabled = False StopButton.Enabled = False Running = False Initialised = False ShowStars = True FewerStars = True PinGalaxy = True CenterGalaxy = True CenterIntruder = True If StarsCheck.Value = 0 Then ShowStars = False If FewerCheck.Value = 0 Then FewerStars = False If PinGalaxyCheck.Value = 0 Then PinGalaxy = False If CGCheck.Value = 0 Then CenterGalaxy = False If CICheck.Value = 0 Then CenterIntruder = False ofsX = 0: ofsY = 0: ofsZ = 0 x1 = 0: y1 = 0: z1 = 0 x2 = 0: y2 = 0: z2 = 0 BGColor = Galaxy.BackColor StarColor = RGB(255, 255, 255) 'white GalaxyColor = RGB(0, 200, 0) 'green IntruderColor = RGB(220, 0, 0) 'red FrameColor = RGB(200, 200, 200) 'lite gray Painting = False End Sub Private Sub Form_Paint() 'gets called anytime anything is covered/uncovered or 'otherwise needs redrawing (when VB decides:) If Not Painting Then RedrawGraphics 'ignore self-trigger End Sub Private Sub Form_Resize() 'called once when program starts, then anytime resized If Galaxy.WindowState <> 1 Then 'if not minimised Painting = True 'lockout to prevent triggering refresh If Galaxy.Width < 4400 Then Galaxy.Width = 4400 'not too small If Galaxy.Height < 4400 Then Galaxy.Height = 4400 GrTop = 1850 'box corner stays the same Gr1Left = 100 GrWidth = Galaxy.Width / 2 - 250 'calculate everything else Gr2Left = Galaxy.Width / 2 GrHeight = Galaxy.Height - 2600 Gr1Xcenter = Gr1Left + GrWidth / 2 Gr2Xcenter = Gr2Left + GrWidth / 2 GrYcenter = GrTop + GrHeight / 2 XYViewLabel.Left = Gr1Xcenter - 300 XYViewLabel.Top = Galaxy.Height - 670 XZViewLabel.Left = Gr2Xcenter - 300 XZViewLabel.Top = Galaxy.Height - 670 CalcMaxes RedrawGraphics 'now refresh Painting = False 'reset lockout End If End Sub Private Sub Form_Unload(Cancel As Integer) 'called just before yanking the plug 'make sure simulation task is not running (or bombs) Running = False End Sub Private Sub PinGalaxyCheck_Click() 'update 'Pin Galaxy' flag PinGalaxy = False If PinGalaxyCheck.Value = 1 Then PinGalaxy = True End Sub Private Sub ScaleBox_KeyPress(KeyAscii As Integer) 'rescale if enter pressed in scale box If KeyAscii = 13 Then UpdatePlotScale End Sub Private Sub ScaleBox_Validate(Cancel As Boolean) 'rescale if another box selected after being in scale box UpdatePlotScale End Sub Private Sub StarsCheck_Click() 'update 'Show Stars' flag If StarsCheck.Value = 1 Then ShowStars = True FewerCheck.Enabled = True Else ShowStars = False FewerCheck.Enabled = False End If RedrawGraphics End Sub Private Sub InfoButton_Click() 'just a little background Dim a$ a$ = "Galaxy for VB/Windows" + vbCrLf + "Terry Newton, December 2001" a$ = a$ + vbCrLf + vbCrLf a$ = a$ + "Based on QB code from " + Chr$(34) a$ = a$ + "Galactic Slam Dance" + Chr$(34) + " (gc3d.zip) by Douglas " a$ = a$ + "E. Music, which was derived from a program published in " a$ = a$ + "the December 1988 issue of Astronomy in the article " + Chr$(34) a$ = a$ + "Galactic Collisions on Your Computer" + Chr$(34) a$ = a$ + " by Michael C. Schroeder and Neil F. Comins, page 91." a$ = a$ + vbCrLf + vbCrLf a$ = a$ + "This program lets you slam a massive object into a system " a$ = a$ + "of points orbiting another massive object to roughly model " a$ = a$ + "what happens when two galaxies collide. Relative mass, X,Y,Z " a$ = a$ + "coordinates and velocities for the intruder specify the initial " a$ = a$ + "conditions. This version lets the main galaxy roam free, check " a$ = a$ + "the 'Pin Galaxy' box to make it more like the original." MsgBox (a$) End Sub Private Sub StartButton_Click() 'start the simulation... initialise with a new galaxy and user vars, 'if valid then twiddle button enables and start the simulation Running = True Initialise UpdatePlotScale RedrawGraphics ContinueButton.Enabled = False If Running = True Then 'init resets Running if bad data StartButton.Enabled = False StopButton.Enabled = True StopButton.SetFocus DoSimulation End If End Sub Private Sub StopButton_Click() 'stop the simulation Running = False ContinueButton.Enabled = True ContinueButton.SetFocus StartButton.Enabled = True StopButton.Enabled = False End Sub '------- end of VB code -------