Visual Basic Source Code

home *** CD-ROM | disk | FTP | other *** search

/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / autose1g / frmgames.frm (.txt) < prev next >

Wrap

Visual Basic Form | 1999-06-24 | 212.6 KB | 5,908 lines

VERSION 5.00 Begin VB.Form frmGameScreen AutoRedraw = -1 'True BorderStyle = 1 'Fixed Single Caption = " 4000 A.D." ClientHeight = 6795 ClientLeft = 60 ClientTop = 345 ClientWidth = 9480 Icon = "FRMGAMES.frx":0000 KeyPreview = -1 'True LinkTopic = "Form1" PaletteMode = 1 'UseZOrder ScaleHeight = 6795 ScaleWidth = 9480 WindowState = 2 'Maximized Begin VB.Timer tmrUpdateMessageBox Enabled = 0 'False Interval = 3000 Left = 1155 Top = 390 End Begin VB.PictureBox picNuclear Height = 315 Left = 1560 Picture = "FRMGAMES.frx":08CA ScaleHeight = 255 ScaleWidth = 255 TabIndex = 135 Top = 1035 Visible = 0 'False Width = 315 End Begin VB.PictureBox picPlanet5 Height = 285 Left = 465 Picture = "FRMGAMES.frx":09C4 ScaleHeight = 225 ScaleWidth = 195 TabIndex = 134 Top = 480 Visible = 0 'False Width = 255 End Begin VB.PictureBox picPlanet4 Height = 285 Left = 45 Picture = "FRMGAMES.frx":0EE6 ScaleHeight = 225 ScaleWidth = 195 TabIndex = 133 Top = 465 Visible = 0 'False Width = 255 End Begin VB.PictureBox picPlanet3 Height = 285 Left = 735 Picture = "FRMGAMES.frx":1418 ScaleHeight = 225 ScaleWidth = 195 TabIndex = 132 Top = 75 Visible = 0 'False Width = 255 End Begin VB.PictureBox picPlanet2 Height = 285 Left = 405 Picture = "FRMGAMES.frx":194A ScaleHeight = 225 ScaleWidth = 195 TabIndex = 131 Top = 60 Visible = 0 'False Width = 255 End Begin VB.PictureBox picPlanet1 Height = 270 Left = 45 Picture = "FRMGAMES.frx":1E7C ScaleHeight = 210 ScaleWidth = 165 TabIndex = 130 Top = 90 Visible = 0 'False Width = 225 End Begin VB.PictureBox picTiny Height = 510 Left = -45 Picture = "FRMGAMES.frx":23AE ScaleHeight = 450 ScaleWidth = 420 TabIndex = 129 Top = 1635 Visible = 0 'False Width = 480 End Begin VB.Frame fraLanding Caption = "Attack/Land Ships" Enabled = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 945 Left = 7635 TabIndex = 113 Top = 5910 Width = 1860 Begin VB.CommandButton cmdLandShip2 Caption = "Ship 2" Enabled = 0 'False Height = 300 Left = 180 TabIndex = 115 Top = 540 Width = 1500 End Begin VB.CommandButton cmdLandShip1 Caption = "Ship 1" Enabled = 0 'False Height = 300 Left = 180 TabIndex = 114 Top = 240 Width = 1500 End End Begin VB.PictureBox picTemp BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 525 Left = 30 Picture = "FRMGAMES.frx":2C78 ScaleHeight = 465 ScaleWidth = 495 TabIndex = 112 Top = 990 Visible = 0 'False Width = 555 End Begin VB.TextBox txtPlayerName BackColor = &H00000000& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0000FF00& Height = 330 Left = 6105 TabIndex = 84 Text = "Player 1" Top = 6480 Width = 1485 End Begin VB.TextBox txtTurnNumber BackColor = &H00000000& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0000FF00& Height = 330 Left = 5190 TabIndex = 55 Text = "Turn " Top = 6480 Width = 885 End Begin VB.CommandButton cmdEndTurn Caption = "&Save Turn" Height = 330 Left = 180 TabIndex = 45 Top = 5490 Width = 1200 End Begin VB.Frame fraUpgrade Caption = "Resource Mgmt" Enabled = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 5820 Left = 7620 TabIndex = 44 Top = 30 Width = 1875 Begin VB.CommandButton cmdRepairIndustry Caption = "Repair Industry" Enabled = 0 'False Height = 300 Left = 180 TabIndex = 138 Top = 4830 Width = 1500 End Begin VB.CommandButton cmdCleanup Caption = "Detoxify Planet" Enabled = 0 'False Height = 300 Left = 180 TabIndex = 127 Top = 5130 Width = 1500 End Begin VB.CommandButton cmdRegenerate Caption = "Regenerate Planet" Enabled = 0 'False Height = 300 Left = 180 TabIndex = 126 Top = 5430 Width = 1500 End Begin VB.PictureBox picUpgrade BackColor = &H00C0C0C0& Height = 660 Index = 7 Left = 1230 Picture = "FRMGAMES.frx":3542 ScaleHeight = 600 ScaleMode = 0 'User ScaleWidth = 495 TabIndex = 125 Top = 1890 Width = 555 End Begin VB.PictureBox picUpgrade BackColor = &H00C0C0C0& Height = 645 Index = 6 Left = 1260 Picture = "FRMGAMES.frx":3FD8 ScaleHeight = 585 ScaleMode = 0 'User ScaleWidth = 465 TabIndex = 124 Top = 1215 Width = 525 End Begin VB.CommandButton cmdScan Caption = "Scanner" Enabled = 0 'False Height = 300 Left = 180 TabIndex = 123 Top = 4530 Width = 1500 End Begin VB.CommandButton cmdPlanetName Height = 270 Left = 105 TabIndex = 120 Top = 210 Width = 1665 End Begin VB.Frame fraTactical BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 825 Left = 60 TabIndex = 110 Top = 3660 Width = 1755 Begin VB.CommandButton cmdLaunchBioRocket Caption = "BioHazard Rocket" Enabled = 0 'False Height = 300 Left = 120 TabIndex = 128 Top = 450 Width = 1500 End Begin VB.CommandButton cmdLaunch Caption = "&Launch Ship" Enabled = 0 'False Height = 300 Left = 120 TabIndex = 111 Top = 150 Width = 1500 End End Begin VB.CommandButton cmdOK Caption = "&OK" Enabled = 0 'False Height = 270 Left = 450 TabIndex = 90 Top = 3375 Width = 1050 End Begin VB.TextBox txtTotal BackColor = &H00000000& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0000FF00& Height = 285 Left = 945 MultiLine = -1 'True TabIndex = 89 Top = 3045 Width = 555 End Begin VB.HScrollBar hsbQuantity Enabled = 0 'False Height = 240 LargeChange = 2 Left = 90 Max = 50 TabIndex = 86 Top = 2760 Width = 1425 End Begin VB.PictureBox picUpgrade BackColor = &H00000000& Height = 660 Index = 5 Left = 105 Picture = "FRMGAMES.frx":493A ScaleHeight = 600 ScaleWidth = 510 TabIndex = 53 Top = 1890 Width = 570 End Begin VB.PictureBox picUpgrade BackColor = &H00808080& Height = 645 Index = 4 Left = 690 Picture = "FRMGAMES.frx":4C44 ScaleHeight = 585 ScaleWidth = 480 TabIndex = 52 Top = 1215 Width = 540 End Begin VB.PictureBox picUpgrade Height = 645 Index = 3 Left = 105 Picture = "FRMGAMES.frx":5D52 ScaleHeight = 585 ScaleWidth = 495 TabIndex = 51 Top = 1215 Width = 555 End Begin VB.PictureBox picUpgrade BackColor = &H00800080& Height = 675 Index = 2 Left = 1260 Picture = "FRMGAMES.frx":67D4 ScaleHeight = 615 ScaleWidth = 480 TabIndex = 50 Top = 525 Width = 540 End Begin VB.PictureBox picUpgrade Height = 675 Index = 1 Left = 660 Picture = "FRMGAMES.frx":78E2 ScaleHeight = 615 ScaleWidth = 525 TabIndex = 49 Top = 525 Width = 585 End Begin VB.PictureBox picUpgrade Height = 675 Index = 0 Left = 105 Picture = "FRMGAMES.frx":8330 ScaleHeight = 615 ScaleWidth = 480 TabIndex = 48 Top = 525 Width = 540 End Begin VB.Label lblTotal Caption = "Cost:" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 225 Left = 420 TabIndex = 88 Top = 3075 Width = 480 End Begin VB.Label lblQuantity BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 225 Left = 1530 TabIndex = 87 Top = 2760 Width = 300 End Begin VB.Label lblItemName Alignment = 2 'Center Height = 195 Left = 105 TabIndex = 85 Top = 2580 Width = 1590 End End Begin VB.Frame fraEnemyWarpPath Caption = "Player 2 Warp Path" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 975 Left = 1515 TabIndex = 23 Top = 30 Width = 6015 Begin VB.CommandButton cmdPreviewEnemy2 Caption = "Ship 2" Height = 255 Left = 75 TabIndex = 117 Top = 585 Width = 775 End Begin VB.CommandButton cmdPreviewEnemy1 Caption = "Ship 1" Height = 255 Left = 75 TabIndex = 116 Top = 255 Width = 775 End Begin VB.PictureBox picEnemyPath AutoRedraw = -1 'True BackColor = &H000000C0& ForeColor = &H000000FF& Height = 675 Index = 7 Left = 5295 ScaleHeight = 615 ScaleWidth = 570 TabIndex = 98 Top = 195 Width = 625 End Begin VB.PictureBox picEnemyPath AutoRedraw = -1 'True BackColor = &H000040C0& ForeColor = &H000000FF& Height = 675 Index = 6 Left = 4665 ScaleHeight = 615 ScaleWidth = 570 TabIndex = 97 Top = 195 Width = 625 End Begin VB.PictureBox picEnemyPath AutoRedraw = -1 'True BackColor = &H00000000& ForeColor = &H000000FF& Height = 675 Index = 5 Left = 4035 ScaleHeight = 615 ScaleWidth = 570 TabIndex = 96 Top = 195 Width = 625 End Begin VB.PictureBox picEnemyPath AutoRedraw = -1 'True BackColor = &H00000000& ForeColor = &H000000FF& Height = 675 Index = 4 Left = 3405 ScaleHeight = 615 ScaleWidth = 570 TabIndex = 95 Top = 195 Width = 625 End Begin VB.PictureBox picEnemyPath AutoRedraw = -1 'True BackColor = &H00000000& ForeColor = &H000000FF& Height = 675 Index = 3 Left = 2775 ScaleHeight = 615 ScaleWidth = 570 TabIndex = 94 Top = 195 Width = 625 End Begin VB.PictureBox picEnemyPath AutoRedraw = -1 'True BackColor = &H00000000& ForeColor = &H000000FF& Height = 675 Index = 2 Left = 2140 ScaleHeight = 615 ScaleWidth = 570 TabIndex = 93 Top = 195 Width = 625 End Begin VB.PictureBox picEnemyPath AutoRedraw = -1 'True BackColor = &H00000000& ForeColor = &H000000FF& Height = 675 Index = 1 Left = 1515 ScaleHeight = 615 ScaleWidth = 570 TabIndex = 92 Top = 195 Width = 625 End Begin VB.PictureBox picEnemyPath AutoRedraw = -1 'True BackColor = &H00400000& ForeColor = &H000000FF& Height = 675 Index = 0 Left = 885 ScaleHeight = 615 ScaleWidth = 570 TabIndex = 91 Top = 195 Width = 625 End End Begin VB.Frame fraWarpPath Caption = "Player 1 Warp Path" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 975 Left = 1545 TabIndex = 12 Top = 5445 Width = 6045 Begin VB.CommandButton cmdPreviewShip2 Caption = "Ship 2" Height = 255 Left = 75 TabIndex = 119 Top = 585 Width = 775 End Begin VB.CommandButton cmdPreviewShip1 Caption = "Ship 1" Height = 255 Left = 75 TabIndex = 118 Top = 255 Width = 775 End Begin VB.PictureBox picPlayerPath AutoRedraw = -1 'True BackColor = &H000000C0& BeginProperty Font Name = "MS Serif" Size = 6.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0000FFFF& Height = 675 Index = 7 Left = 5310 ScaleHeight = 615 ScaleWidth = 570 TabIndex = 106 Top = 195 Width = 625 End Begin VB.PictureBox picPlayerPath AutoRedraw = -1 'True BackColor = &H000040C0& BeginProperty Font Name = "MS Serif" Size = 6.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0000FFFF& Height = 675 Index = 6 Left = 4680 ScaleHeight = 615 ScaleWidth = 570 TabIndex = 105 Top = 195 Width = 625 End Begin VB.PictureBox picPlayerPath AutoRedraw = -1 'True BackColor = &H00000000& BeginProperty Font Name = "MS Serif" Size = 6.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0000FFFF& Height = 675 Index = 5 Left = 4050 ScaleHeight = 615 ScaleWidth = 570 TabIndex = 104 Top = 195 Width = 625 End Begin VB.PictureBox picPlayerPath AutoRedraw = -1 'True BackColor = &H00000000& BeginProperty Font Name = "MS Serif" Size = 6.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0000FFFF& Height = 675 Index = 4 Left = 3420 ScaleHeight = 615 ScaleWidth = 570 TabIndex = 103 Top = 195 Width = 625 End Begin VB.PictureBox picPlayerPath AutoRedraw = -1 'True BackColor = &H00000000& BeginProperty Font Name = "MS Serif" Size = 6.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0000FFFF& Height = 675 Index = 3 Left = 2790 ScaleHeight = 615 ScaleWidth = 570 TabIndex = 102 Top = 195 Width = 625 End Begin VB.PictureBox picPlayerPath AutoRedraw = -1 'True BackColor = &H00000000& BeginProperty Font Name = "MS Serif" Size = 6.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0000FFFF& Height = 675 Index = 2 Left = 2160 ScaleHeight = 615 ScaleWidth = 570 TabIndex = 101 Top = 195 Width = 625 End Begin VB.PictureBox picPlayerPath AutoRedraw = -1 'True BackColor = &H00000000& BeginProperty Font Name = "MS Serif" Size = 6.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0000FFFF& Height = 675 Index = 1 Left = 1530 ScaleHeight = 615 ScaleWidth = 570 TabIndex = 100 Top = 195 Width = 625 End Begin VB.PictureBox picPlayerPath AutoRedraw = -1 'True BackColor = &H00400000& BeginProperty Font Name = "MS Serif" Size = 6.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0000FFFF& Height = 675 Index = 0 Left = 900 ScaleHeight = 615 ScaleWidth = 570 TabIndex = 99 Top = 195 Width = 625 End End Begin VB.Frame fraPlayerStats Caption = "Player Stats" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 2595 Left = 60 TabIndex = 5 Top = 2430 Width = 1440 Begin VB.TextBox txtProduction BackColor = &H00000000& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0000FF00& Height = 300 Left = 405 MultiLine = -1 'True TabIndex = 137 Top = 2160 Width = 660 End Begin VB.TextBox txtNumAssaultTroops BackColor = &H00000000& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0000FF00& Height = 285 Left = 675 MultiLine = -1 'True TabIndex = 109 Top = 1020 Width = 660 End Begin VB.TextBox txtNumResources BackColor = &H00000000& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0000FF00& Height = 285 Left = 405 MultiLine = -1 'True TabIndex = 11 Top = 1590 Width = 660 End Begin VB.TextBox txtNumTroops BackColor = &H00000000& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0000FF00& Height = 285 Left = 675 MultiLine = -1 'True TabIndex = 10 Top = 645 Width = 660 End Begin VB.TextBox txtNumPlanets BackColor = &H00000000& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0000FF00& Height = 285 Left = 675 MultiLine = -1 'True TabIndex = 9 Top = 270 Width = 660 End Begin VB.Label Label1 Caption = "Resources/Turn:" Height = 210 Left = 105 TabIndex = 136 Top = 1920 Width = 1290 End Begin VB.Label lblAssaultTroops Caption = "Mechs:" Height = 225 Left = 90 TabIndex = 108 Top = 1050 Width = 570 End Begin VB.Label lblResources Caption = "Total Resources:" Height = 210 Left = 90 TabIndex = 8 Top = 1365 Width = 1260 End Begin VB.Label lblNumTroops Caption = "Troops:" Height = 225 Left = 75 TabIndex = 7 Top = 675 Width = 570 End Begin VB.Label lblnumplanets Caption = "Planets:" Height = 210 Left = 60 TabIndex = 6 Top = 300 Width = 615 End End Begin VB.CommandButton cmdAbort Caption = "&Abort" Height = 330 Left = 180 TabIndex = 4 Top = 5820 Width = 1200 End Begin VB.Timer tmrRandomSounds Interval = 35000 Left = 495 Top = 6180 End Begin VB.Frame fraMessages Caption = "Messages" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 1395 Left = 45 TabIndex = 2 Top = 1005 Width = 1455 Begin VB.CommandButton cmdViewSend Caption = "&View/Send" Height = 300 Left = 60 TabIndex = 54 Top = 975 Width = 1275 End Begin VB.TextBox txtMessages BackColor = &H00000000& BeginProperty Font Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0000FF00& Height = 645 Left = 45 MultiLine = -1 'True TabIndex = 3 Text = "FRMGAMES.frx":8D7E Top = 240 Width = 1350 End End Begin VB.TextBox txtStatus BackColor = &H00000000& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0000FF00& Height = 330 Left = 90 Locked = -1 'True TabIndex = 1 Top = 6480 Width = 5070 End Begin VB.PictureBox picGalaxy AutoRedraw = -1 'True AutoSize = -1 'True BackColor = &H00000000& BeginProperty Font Name = "MS Serif" Size = 6 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00FFFFFF& Height = 4095 Left = 1800 ScaleHeight = 4035 ScaleWidth = 5670 TabIndex = 0 Top = 1230 Width = 5730 Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 49 Left = 5220 Picture = "FRMGAMES.frx":8D99 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 83 Top = 3510 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 48 Left = 4770 Picture = "FRMGAMES.frx":92CB ScaleHeight = 225 ScaleWidth = 225 TabIndex = 82 Top = 3120 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 210 Index = 47 Left = 4320 Picture = "FRMGAMES.frx":97FD ScaleHeight = 210 ScaleWidth = 210 TabIndex = 81 Top = 3660 Width = 210 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 46 Left = 3540 Picture = "FRMGAMES.frx":9D1F ScaleHeight = 225 ScaleWidth = 225 TabIndex = 80 Top = 3360 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 45 Left = 2820 Picture = "FRMGAMES.frx":A251 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 79 Top = 3300 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 44 Left = 2160 Picture = "FRMGAMES.frx":A783 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 78 Top = 3660 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 43 Left = 1620 Picture = "FRMGAMES.frx":ACB5 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 77 Top = 3285 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 210 Index = 42 Left = 960 Picture = "FRMGAMES.frx":B1E7 ScaleHeight = 210 ScaleWidth = 210 TabIndex = 76 Top = 3660 Width = 210 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 41 Left = 600 Picture = "FRMGAMES.frx":B709 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 75 Top = 3120 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 40 Left = 225 Picture = "FRMGAMES.frx":BC3B ScaleHeight = 225 ScaleWidth = 225 TabIndex = 74 Top = 3555 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 39 Left = 5340 Picture = "FRMGAMES.frx":C16D ScaleHeight = 225 ScaleWidth = 225 TabIndex = 73 Top = 2820 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 38 Left = 4920 Picture = "FRMGAMES.frx":C69F ScaleHeight = 225 ScaleWidth = 225 TabIndex = 72 Top = 2400 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 37 Left = 4230 Picture = "FRMGAMES.frx":CBD1 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 71 Top = 2820 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 210 Index = 36 Left = 3600 Picture = "FRMGAMES.frx":D103 ScaleHeight = 210 ScaleWidth = 210 TabIndex = 70 Top = 2580 Width = 210 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 35 Left = 2820 Picture = "FRMGAMES.frx":D625 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 69 Top = 2700 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 34 Left = 2100 Picture = "FRMGAMES.frx":DB57 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 68 Top = 2760 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 33 Left = 1620 Picture = "FRMGAMES.frx":E089 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 67 Top = 2355 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 32 Left = 1080 Picture = "FRMGAMES.frx":E5BB ScaleHeight = 225 ScaleWidth = 225 TabIndex = 66 Top = 2880 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 31 Left = 120 Picture = "FRMGAMES.frx":EAED ScaleHeight = 225 ScaleWidth = 225 TabIndex = 65 Top = 2760 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 210 Index = 30 Left = 900 Picture = "FRMGAMES.frx":F01F ScaleHeight = 210 ScaleWidth = 210 TabIndex = 64 Top = 2160 Width = 210 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 210 Index = 29 Left = 5340 Picture = "FRMGAMES.frx":F541 ScaleHeight = 210 ScaleWidth = 210 TabIndex = 63 Top = 1740 Width = 210 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 28 Left = 4695 Picture = "FRMGAMES.frx":FA63 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 62 Top = 1680 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 27 Left = 4200 Picture = "FRMGAMES.frx":FF95 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 61 Top = 2220 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 26 Left = 3720 Picture = "FRMGAMES.frx":104C7 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 60 Top = 1650 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 25 Left = 3240 Picture = "FRMGAMES.frx":109F9 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 59 Top = 1980 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 210 Index = 24 Left = 2580 Picture = "FRMGAMES.frx":10F2B ScaleHeight = 210 ScaleWidth = 210 TabIndex = 58 Top = 2145 Width = 210 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 23 Left = 1995 Picture = "FRMGAMES.frx":1144D ScaleHeight = 225 ScaleWidth = 225 TabIndex = 57 Top = 1845 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 22 Left = 1350 Picture = "FRMGAMES.frx":1197F ScaleHeight = 225 ScaleWidth = 225 TabIndex = 56 Top = 1575 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 21 Left = 630 Picture = "FRMGAMES.frx":11EB1 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 47 Top = 1545 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 20 Left = 180 Picture = "FRMGAMES.frx":123E3 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 46 Top = 2100 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 19 Left = 5280 Picture = "FRMGAMES.frx":12915 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 43 Top = 1080 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 18 Left = 4740 Picture = "FRMGAMES.frx":12E47 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 42 Top = 780 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 17 Left = 4230 Picture = "FRMGAMES.frx":13379 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 41 Top = 1215 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 210 Index = 16 Left = 3660 Picture = "FRMGAMES.frx":138AB ScaleHeight = 210 ScaleWidth = 210 TabIndex = 40 Top = 960 Width = 210 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 15 Left = 2970 Picture = "FRMGAMES.frx":13DCD ScaleHeight = 225 ScaleWidth = 225 TabIndex = 39 Top = 1365 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 14 Left = 2475 Picture = "FRMGAMES.frx":142FF ScaleHeight = 225 ScaleWidth = 225 TabIndex = 38 Top = 870 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 13 Left = 2205 Picture = "FRMGAMES.frx":14831 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 37 Top = 1365 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 12 Left = 1620 Picture = "FRMGAMES.frx":14D63 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 36 Top = 975 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 11 Left = 810 Picture = "FRMGAMES.frx":15295 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 35 Top = 900 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 210 Index = 10 Left = 165 Picture = "FRMGAMES.frx":157C7 ScaleHeight = 210 ScaleWidth = 210 TabIndex = 34 Top = 1125 Width = 210 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 9 Left = 5265 Picture = "FRMGAMES.frx":15CE9 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 33 Top = 345 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 210 Index = 8 Left = 4725 Picture = "FRMGAMES.frx":1621B ScaleHeight = 210 ScaleWidth = 210 TabIndex = 32 Top = 135 Width = 210 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 7 Left = 4140 Picture = "FRMGAMES.frx":1673D ScaleHeight = 225 ScaleWidth = 225 TabIndex = 31 Top = 480 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 6 Left = 3615 Picture = "FRMGAMES.frx":16C6F ScaleHeight = 225 ScaleWidth = 225 TabIndex = 30 Top = 105 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 5 Left = 3060 Picture = "FRMGAMES.frx":171A1 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 29 Top = 525 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 210 Index = 4 Left = 2610 Picture = "FRMGAMES.frx":176D3 ScaleHeight = 210 ScaleWidth = 210 TabIndex = 28 Top = 180 Width = 210 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 3 Left = 1905 Picture = "FRMGAMES.frx":17BF5 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 27 Top = 315 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 2 Left = 1140 Picture = "FRMGAMES.frx":18127 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 26 Top = 360 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 1 Left = 570 Picture = "FRMGAMES.frx":18659 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 25 Top = 60 Width = 225 End Begin VB.PictureBox picPlanet Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 225 Index = 0 Left = 150 Picture = "FRMGAMES.frx":18B8B ScaleHeight = 225 ScaleWidth = 225 TabIndex = 24 Top = 480 Width = 225 End End Begin VB.Frame fraOptions Caption = "Game Options" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 1260 Left = 90 TabIndex = 107 Top = 5145 Width = 1410 End Begin VB.Label lblTitle2 BackStyle = 0 'Transparent Caption = "A.D." BeginProperty Font Name = "Times New Roman" Size = 24 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00000080& Height = 495 Left = 300 TabIndex = 122 Top = 450 Width = 945 End Begin VB.Label lblTitle BackStyle = 0 'Transparent Caption = "4000" BeginProperty Font Name = "Times New Roman" Size = 24 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00000080& Height = 510 Left = 225 TabIndex = 121 Top = 30 Width = 1050 End Begin VB.Label lblE Caption = "E" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 6900 TabIndex = 22 Top = 1020 Width = 255 End Begin VB.Label lblD Caption = "D" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 5820 TabIndex = 21 Top = 1020 Width = 195 End Begin VB.Label lblC Caption = "C" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 4620 TabIndex = 20 Top = 1020 Width = 195 End Begin VB.Label lblB Caption = "B" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 3480 TabIndex = 19 Top = 1020 Width = 195 End Begin VB.Label lblA Caption = "A" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 2340 TabIndex = 18 Top = 1020 Width = 195 End Begin VB.Label lblFive Caption = "5" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 1620 TabIndex = 17 Top = 4800 Width = 195 End Begin VB.Label lblFour Caption = "4" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 1620 TabIndex = 16 Top = 3960 Width = 195 End Begin VB.Label lblThree Caption = "3" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 1620 TabIndex = 15 Top = 3180 Width = 135 End Begin VB.Label lblTwo Caption = "2" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 1620 TabIndex = 14 Top = 2400 Width = 195 End Begin VB.Label lblOne Caption = "1" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 1620 TabIndex = 13 Top = 1560 Width = 195 End Attribute VB_Name = "frmGameScreen" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit 'declare the function keys Const vbKeyF1 = &H70 'for help Const vbKeyF2 = &H71 'to save the game Const vbKeyF3 = &H72 'to quit without saving Const vbKeyF4 = &H73 Dim CloakingChecked(2) As Boolean 'so cloaked ships are only checked once/turn 'to see if they're hidden or not Public Warp7WarningGiven As Boolean Public Warp8WarningGiven As Boolean 'to limit the warp path warnings to once at 'the beginning of the turn, and again when 'the player hits cmdendturn Public NumPlanets1 As Integer 'checks number of planets in range on warp 8 'if zero, ship is destroyed Public NumPlanets2 As Integer 'same, for ship 2 Public GridLinesOn As Boolean 'whether or not the grid lines are showing Public ContaminationWarningGiven As Boolean 'to only show contamination results msgbox once/turn Private Sub cmdAbort_Click() 'abort the game without saving PlaySoundEffect "Button2" If MsgBox("Are you sure you want to quit without saving?", vbQuestion + vbYesNo, "Abort Turn") = vbYes Then PlaySoundEffect "Abort" Dim Counter For Counter = 1 To 100000 Next Counter 'deregister help file QuitHelp 'turn off scanner If ScannerOn Then cmdScan_Click ScannerOn = False cmdScan.Enabled = False End If If TurnNumber = 1 Then 'for some as-yet unknown reason (at least to me), 'the program will not shut all the way down on turn 1 'unless I use End - I know it makes no sense, but... End Else '***Alternative to using End: Dim F As Long 'fade form into taskbar Me.WindowState = 1 'count forms opened For F = Forms.Count - 1 To 0 Step -1 Unload Forms(F) Next F 'close any open files If (Forms.Count = 0) Then Close 'set all open forms to Nothing Set frmGameScreen = Nothing End If End If End Sub Private Sub cmdAbort_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) txtStatus.ForeColor = vbGreen txtStatus.Text = "Quit without saving" End Sub Private Sub cmdCleanup_Click() 'detoxify planet contaminated by biorocket Dim ResourceFlag As Boolean 'adds second line to msgbox, showing extra resources Dim Q As Integer 'extra resources if currently < 2 'added check for money If Planet(ActivePlanet).Contaminated And Player(Current).BioCleanupResearched Then UnitCost = 10 If Player(Current).NumResources >= UnitCost Then PlaySoundEffect "Button2" If MsgBox("Detoxify this planet?", vbYesNo, "") = vbYes Then 'deduct cost of cleanup Player(Current).NumResources = Player(Current).NumResources - UnitCost UpdatePlayerStats Planet(ActivePlanet).Contaminated = False 'add 1-2 resources if planet has < 2 If Planet(ActivePlanet).Resources < 2 Then 'rejuvenate 1-2 resources Randomize Q = Int(Rnd * 1) + 1 Planet(ActivePlanet).Resources = Planet(ActivePlanet).Resources + Q End If Dim Msg As String Msg = "Planetary environment now suitable for Humans" If ResourceFlag Then Msg = Msg + Chr(13) + "Resource Production increased to " + Str(Planet(ActivePlanet).Resources) ResourceFlag = False End If PlaySoundEffect "Quiet" MsgBox Msg, , "Detoxification complete" 'restore planet picture Select Case Planet(ActivePlanet).BackGround Case 1 picPlanet(ActivePlanet).Picture = picPlanet1.Picture Case 2 picPlanet(ActivePlanet).Picture = picPlanet2.Picture Case 3 picPlanet(ActivePlanet).Picture = picPlanet3.Picture Case 4 picPlanet(ActivePlanet).Picture = picPlanet4.Picture Case 5 picPlanet(ActivePlanet).Picture = picPlanet5.Picture End Select End If Else 'insufficient funds PlaySoundEffect "Quiet" MsgBox "Detoxification costs 10 resource units", vbExclamation, "Insufficient Resources" End If End If End Sub Private Sub cmdCleanup_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) txtStatus.Text = "Detoxify Planet Contaminated By BioHazard" End Sub Private Sub cmdEndTurn_Click() 'save the game PlaySoundEffect "Button2" If MsgBox("Save this turn?", vbYesNo + vbQuestion, "Ending Turn") = vbYes Then 'advance ships on warp path if not landed If Player(Current).Ship(0).WarpPosition = 8 Or Player(Current).Ship(1).WarpPosition = 8 Then 'don't end turn until player lands ship PlaySoundEffect "Disintegrate" MsgBox "Your ship must land this turn", vbExclamation, "Warp Limit" Exit Sub End If 'confirm ending turn, then give message to player Dim z As Integer For z = 0 To 1 If Player(Current).Ship(z).Launched Then Player(Current).Ship(z).WarpPosition = Player(Current).Ship(z).WarpPosition + 1 End If Next z 'set it to the next turn if player 2 is finishing up If Current = 1 Then TurnNumber = TurnNumber + 1 End If 'turn off scanner If ScannerOn Then cmdScan_Click ScannerOn = False cmdScan.Enabled = False End If 'save planet and player info to a file, then end WriteBigFile 'here's where zlib is used to compress the file just written frmCompress.Show Modal 'frmCompress calls frmContinue for choice of main menu or quit 'if main menu, then this form is unloaded by frmContinue End If End Sub Private Sub cmdEndTurn_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) txtStatus.ForeColor = vbGreen txtStatus.Text = "End Turn, Prepare Information File for Upload" End Sub Private Sub cmdLandShip1_Click() 'figure out which planets are available for landing Dim Count As Integer Dim x1, y1, X2, Y2 Dim a As Integer Dim b As Integer Dim Distance Dim RangeLow, RangeHigh Dim xpos, ypos, radius 'set toggle state: If ReadyToLand1 = True Then ReadyToLand1 = False ElseIf ReadyToLand1 = False Then ReadyToLand1 = True End If If ReadyToLand1 Then cmdLandShip2.Enabled = False cmdPreviewShip1.Enabled = False cmdPreviewShip2.Enabled = False cmdPreviewEnemy1.Enabled = False cmdPreviewEnemy2.Enabled = False ElseIf ReadyToLand1 = False Then If Player(Current).Ship(1).Launched Then cmdLandShip2.Enabled = True End If cmdPreviewShip1.Enabled = True cmdPreviewShip2.Enabled = True cmdPreviewEnemy1.Enabled = True cmdPreviewEnemy2.Enabled = True End If 'set activeship to appropriate ship number activeship = 0 'clear the board of any inrange settings Dim z For z = 0 To 49 Planet(z).InRange = False Next z 'Check for UltraWarp and set ranges If Player(Current).UltraWarpResearched Then 'increased range RangeLow = Player(Current).Ship(0).WarpPosition * 250 RangeHigh = RangeLow + 700 ElseIf Player(Current).UltraWarpResearched = False Then 'lower ranges RangeLow = Player(Current).Ship(0).WarpPosition * 250 RangeHigh = RangeLow + 350 End If 'ship's starting position - originating planet x1 = Player(Current).Ship(0).CenterX y1 = Player(Current).Ship(0).CenterY 'check distance from home planet to each other planet 'if within the range, set planet's InRange to true For Count = 0 To 49 X2 = picPlanet(Count).Left + (picPlanet(Count).Width / 2) Y2 = picPlanet(Count).Top + (picPlanet(Count).Height / 2) a = Abs(x1 - X2) b = Abs(y1 - Y2) Distance = Int(Sqr(a ^ 2 + b ^ 2)) If Distance >= RangeLow And Distance <= RangeHigh And picPlanet(Count).Visible Then 'planet is within range - set value Planet(Count).InRange = True End If Next Count 'if in range, draw circle For Count = 0 To 49 If Planet(Count).InRange And picPlanet(Count).Visible Then 'find center of the picturebox and draw circle xpos = picPlanet(Count).Left + (picPlanet(Count).Width / 2) ypos = picPlanet(Count).Top + (picPlanet(Count).Height / 2) radius = (picPlanet(Count).Width / 2) + 45 picGalaxy.DrawMode = 7 picGalaxy.DrawWidth = 1 picGalaxy.Circle (xpos, ypos), radius, vbYellow End If Next Count End Sub Private Sub cmdLandShip1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) txtStatus.Text = "Prepare Ship 1 for Attack/Landing" End Sub Private Sub cmdLandShip2_Click() 'figure out which planets are available for landing Dim Count As Integer Dim x1, y1, X2, Y2 Dim a As Integer Dim b As Integer Dim Distance Dim RangeLow, RangeHigh Dim xpos, ypos, radius 'set toggle state: If ReadyToLand2 = True Then ReadyToLand2 = False ElseIf ReadyToLand2 = False Then ReadyToLand2 = True End If If ReadyToLand2 Then cmdLandShip1.Enabled = False cmdPreviewShip1.Enabled = False cmdPreviewShip2.Enabled = False cmdPreviewEnemy1.Enabled = False cmdPreviewEnemy2.Enabled = False ElseIf ReadyToLand2 = False Then '**see if other ship launched If Player(Current).Ship(0).Launched Then cmdLandShip1.Enabled = True End If cmdPreviewShip1.Enabled = True cmdPreviewShip2.Enabled = True cmdPreviewEnemy1.Enabled = True cmdPreviewEnemy2.Enabled = True End If 'set activeship to appropriate ship number activeship = 1 'clear the board of any inrange settings Dim z For z = 0 To 49 Planet(z).InRange = False Next z 'Check for UltraWarp and set ranges If Player(Current).UltraWarpResearched Then 'increased range RangeLow = Player(Current).Ship(1).WarpPosition * 250 RangeHigh = RangeLow + 700 ElseIf Player(Current).UltraWarpResearched = False Then 'lower ranges RangeLow = Player(Current).Ship(1).WarpPosition * 250 RangeHigh = RangeLow + 350 End If 'ship's starting position - originating planet x1 = Player(Current).Ship(1).CenterX y1 = Player(Current).Ship(1).CenterY 'check distance from home planet to each other planet 'if within the range, set planet's InRange to true For Count = 0 To 49 X2 = picPlanet(Count).Left + (picPlanet(Count).Width / 2) Y2 = picPlanet(Count).Top + (picPlanet(Count).Height / 2) a = Abs(x1 - X2) b = Abs(y1 - Y2) Distance = Int(Sqr(a ^ 2 + b ^ 2)) If Distance >= RangeLow And Distance <= RangeHigh Then 'planet is within range - set value Planet(Count).InRange = True End If Next Count 'if in range, draw circle For Count = 0 To 49 If Planet(Count).InRange And picPlanet(Count).Visible Then 'find center of the picturebox and draw circle xpos = picPlanet(Count).Left + (picPlanet(Count).Width / 2) ypos = picPlanet(Count).Top + (picPlanet(Count).Height / 2) radius = (picPlanet(Count).Width / 2) + 45 picGalaxy.DrawMode = 7 picGalaxy.DrawWidth = 1 picGalaxy.Circle (xpos, ypos), radius, vbYellow End If Next Count End Sub Private Sub cmdLandShip2_LostFocus() 'EraseCircles End Sub Private Sub cmdLandShip2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) txtStatus.Text = "Prepare Ship 2 for Attack/Landing" End Sub Private Sub cmdLaunch_Click() 'launch a ship PlaySoundEffect "Button4" 'check to see if a new planet - can't take off this turn Dim msg1 As String msg1 = "Engines being re-tooled after landing:" & Chr(13) msg1 = msg1 + "Ship cannot launch this turn." If Planet(ActivePlanet).JustLanded Then PlaySoundEffect "Quiet" MsgBox msg1, vbOKOnly + vbExclamation, "Operation Terminated" Exit Sub ElseIf Player(Current).Ship(0).Launched And Player(Current).Ship(1).Launched Then PlaySoundEffect "Quiet" MsgBox "No ships available for launch", vbOKOnly, "Launch Cancelled" Exit Sub 'load the launch form frmLaunch.Show Modal End If End Sub Private Sub cmdLaunch_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) txtStatus.Text = "Prepare a ship for launch" End Sub Private Sub cmdLaunchBioRocket_Click() 'launch biorocket - check if planets in range PlaySoundEffect "Button4" Dim Range Dim x1, y1, X2, Y2 Dim Count Dim a, b Dim Distance Dim RocketCost RocketCost = 30 'set toggle state: If BioRocketOn = True Then BioRocketOn = False Planet(ActivePlanet).LaunchSite = False ElseIf BioRocketOn = False Then BioRocketOn = True Planet(ActivePlanet).LaunchSite = True End If If Player(Current).BioRocketResearched And Player(Current).NumResources >= RocketCost Then 'continue 'set range If Player(Current).LongBioResearched Then Range = 1200 Else Range = 750 End If 'clear the board of any inbiorange settings Dim z For z = 0 To 49 Planet(z).InBioRange = False Next z 'rocket's centre - originating planet x1 = picPlanet(ActivePlanet).Left + (picPlanet(ActivePlanet).Width / 2) y1 = picPlanet(ActivePlanet).Top + (picPlanet(ActivePlanet).Height / 2) 'check distance from source planet to each other planet 'if within the range and visible (ie. different galaxy sizes), 'then set planet's InBioRange to true For Count = 0 To 49 X2 = picPlanet(Count).Left + (picPlanet(Count).Width / 2) Y2 = picPlanet(Count).Top + (picPlanet(Count).Height / 2) a = Abs(x1 - X2) b = Abs(y1 - Y2) Distance = Int(Sqr(a ^ 2 + b ^ 2)) If Distance <= Range And picPlanet(Count).Visible Then Planet(Count).InBioRange = True Planet(Count).BioDistance = Distance End If Next Count 'Disallow targeting of planets you own For Count = 0 To 49 If Planet(Count).Owner = Current Then Planet(Count).InBioRange = False End If Next Count 'if in range and visible, draw line For Count = 0 To 49 If Planet(Count).InBioRange And picPlanet(Count).Visible Then 'find center of the picturebox and draw line X2 = picPlanet(Count).Left + (picPlanet(Count).Width / 2) Y2 = picPlanet(Count).Top + (picPlanet(Count).Height / 2) picGalaxy.DrawWidth = 2 picGalaxy.DrawMode = 7 picGalaxy.Line (x1, y1)-(X2, Y2), vbMagenta End If Next Count 'not enough money, or don't have technology PlaySoundEffect "Quiet" MsgBox "Insufficient funds - BioHazard Rockets" + Chr(13) + "cost 30 resource units each", vbOKOnly + vbInformation, "Launch Cancelled" Exit Sub End If End Sub Private Sub cmdLaunchBioRocket_LostFocus() 'EraseLines (ActivePlanet) End Sub Private Sub cmdLaunchBioRocket_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) txtStatus.Text = "Launch BioHazard Rocket" End Sub Private Sub cmdOK_Click() 'put the purchase order through 'and update the player and planet stats 'uses horizontal scroll bar hsbQuantity to set # of units purchased PlaySoundEffect "Button1" Select Case lblItemName.Caption Case "Missile Defences" 'Buy missile defenses for planet 'Cost: 10, Adds 5 to combatstrength 'exit sub if planet already has missiles If Planet(ActivePlanet).HaveMissiles Then Exit Sub End If Player(Current).NumResources = Player(Current).NumResources - PurchasePrice UpdatePlayerStats 'add to planet's combatstrength if hsbquantity >0 If hsbQuantity.Value > 0 Then Planet(ActivePlanet).HaveMissiles = True SetCombatStrength (ActivePlanet) End If Case "Planetary Shield" 'Buy shield defense for planet 'Cost:20, Adds 25 to combatstrength Player(Current).NumResources = Player(Current).NumResources - PurchasePrice UpdatePlayerStats 'add to planet's combatstrength if hsbquantity>0 If hsbQuantity.Value > 0 Then Planet(ActivePlanet).HaveShields = True SetCombatStrength (ActivePlanet) End If Case "Troops" 'update #troops for player and for planet Player(Current).NumTroops = Player(Current).NumTroops + Quantity Planet(ActivePlanet).Troops = Planet(ActivePlanet).Troops + Quantity Player(Current).NumResources = Player(Current).NumResources - PurchasePrice 'call update procedure UpdatePlayerStats SetCombatStrength (ActivePlanet) Case "Assault Mechs" 'update #assault troops for player and planet Player(Current).NumAssaultTroops = Player(Current).NumAssaultTroops + Quantity Planet(ActivePlanet).AssaultTroops = Planet(ActivePlanet).AssaultTroops + Quantity Player(Current).NumResources = Player(Current).NumResources - PurchasePrice 'call update procedure UpdatePlayerStats SetCombatStrength (ActivePlanet) Case "Improved Resource Production" 'Increase planet's resource production 'Cost: 15, Adds random 2-5 to planet's resources 'set flag that this planet has improved resources if hsbquantity>0 If hsbQuantity.Value > 0 Then 'add to planet's resources Dim Increase As Integer Increase = Int(Rnd * 3) + 2 Planet(ActivePlanet).Resources = Planet(ActivePlanet).Resources + Increase 'set improved flag Planet(ActivePlanet).ImprovedResources = True 'charge the player Player(Current).NumResources = Player(Current).NumResources - PurchasePrice UpdatePlayerStats End If Case "Scanner" 'Cost: 25, lets player see detailed info on surrounding planets Player(Current).NumResources = Player(Current).NumResources - PurchasePrice UpdatePlayerStats 'set flag that this planet has scanner '***if quantity=1 If hsbQuantity.Value > 0 Then Planet(ActivePlanet).HaveScanner = True End If Case "Scanner Jamming Device" 'Cost: 15 'PurchasePrice = 15 Player(Current).NumResources = Player(Current).NumResources - PurchasePrice UpdatePlayerStats 'set flag that this planet has scanner jamming device If hsbQuantity.Value > 0 Then Planet(ActivePlanet).HaveJammer = True End If End Select 'reset the scroll bar and labels cmdLaunch.Enabled = False ClearFrame 'disable landing frame only if no ships launched If Player(Current).Ship(0).Launched = False And Player(Current).Ship(1).Launched = False Then fraLanding.Enabled = False End If End Sub Private Sub cmdPlanetName_Click() 'go to the landscape view frmLandscape.Show Modal End Sub Private Sub cmdPlanetName_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) txtStatus.Text = "Click here to view the planet" End Sub Private Sub cmdPreviewEnemy1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'figure out which planets are available for enemy landing next turn 'exit sub if warp scanner not researched If Player(Current).WarpScannerResearched = False Then 'don't do the preview at all PlaySoundEffect "Quiet" MsgBox "No landing data available", vbInformation + vbOKOnly, "Probe Error" Exit Sub End If '*********************** 'In form_activate, there is a base 98% chance of a cloaked ship staying hidden. 'If the current player has the warp scanner, there is an 75% chance, +/- 5%, of remaining 'hidden. I'm not sure if that's too high... 'Either the chance of being hidden in the first place is reduced if the player 'has a warp scanner (ie. by 50%), or I have to recalculate the chance of successfully 'previewing the ship's landing sites here. '*********************** If Player(Other).Ship(0).HaveCloakingDevice And Player(Other).Ship(0).Hidden Then 'don't do the preview at all PlaySoundEffect "Quiet" MsgBox "No landing data available", vbInformation + vbOKOnly, "Probe Error" Exit Sub End If 'first, see if there's a ship in the warp path If Player(Other).Ship(0).Launched Then Dim Count As Integer Dim x1, y1, X2, Y2 Dim a As Integer Dim b As Integer Dim Distance Dim RangeLow, RangeHigh Dim xpos, ypos, radius 'clear the board of any inrange settings Dim z For z = 0 To 49 Planet(z).InRange = False Next z 'Check for UltraWarp and set ranges If Player(Other).UltraWarpResearched Then 'increased range RangeLow = Player(Other).Ship(0).WarpPosition * 250 RangeHigh = RangeLow + 700 ElseIf Player(Other).UltraWarpResearched = False Then 'lower ranges RangeLow = Player(Other).Ship(0).WarpPosition * 250 RangeHigh = RangeLow + 350 End If 'ship's starting position - originating planet x1 = Player(Other).Ship(0).CenterX y1 = Player(Other).Ship(0).CenterY For Count = 0 To 49 'check distance from home planet to each other planet 'if within the range, set planet's InRange to true 'use centre of planets, not top left corner X2 = picPlanet(Count).Left + (picPlanet(Count).Width / 2) Y2 = picPlanet(Count).Top + (picPlanet(Count).Height / 2) a = Abs(x1 - X2) b = Abs(y1 - Y2) Distance = Int(Sqr(a ^ 2 + b ^ 2)) If Distance >= RangeLow And Distance <= RangeHigh And picPlanet(Count).Visible Then 'planet is within range - set value Planet(Count).InRange = True 'find center of the picturebox and draw circle xpos = picPlanet(Count).Left + (picPlanet(Count).Width / 2) ypos = picPlanet(Count).Top + (picPlanet(Count).Height / 2) radius = (picPlanet(Count).Width / 2) + 45 'set drawmode picGalaxy.DrawMode = 7 picGalaxy.DrawWidth = 1 picGalaxy.Circle (xpos, ypos), radius, vbRed End If Next Count 'if no ship in the warp path, error message PlaySoundEffect "Quiet" MsgBox "No landing data available", vbInformation + vbOKOnly, "Probe Error" End If End Sub Private Sub cmdPreviewEnemy1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 'redraw the circles to erase them 'if cloaked, don't do this routine at all If Player(Other).Ship(0).HaveCloakingDevice And Player(Other).Ship(0).Hidden Then 'don't do the preview at all Exit Sub End If Dim xpos, ypos, radius Dim z For z = 0 To 49 If Planet(z).InRange And picPlanet(z).Visible Then 'find center of the picturebox and draw circle xpos = picPlanet(z).Left + (picPlanet(z).Width / 2) ypos = picPlanet(z).Top + (picPlanet(z).Height / 2) radius = (picPlanet(z).Width / 2) + 45 'set drawmode picGalaxy.DrawMode = 7 picGalaxy.DrawWidth = 1 picGalaxy.Circle (xpos, ypos), radius, vbRed End If Next z End Sub Private Sub cmdPreviewEnemy2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'figure out which planets are available for enemy landing next turn 'exit sub if warp scanner not researched If Player(Current).WarpScannerResearched = False Then 'don't do the preview at all PlaySoundEffect "Quiet" MsgBox "No landing data available", vbInformation + vbOKOnly, "Probe Error" Exit Sub End If If Player(Other).Ship(1).HaveCloakingDevice And Player(Other).Ship(1).Hidden Then 'don't do the preview at all PlaySoundEffect "Quiet" MsgBox "No landing data available", vbInformation + vbOKOnly, "Probe Error" Exit Sub End If If Player(Other).Ship(1).Launched Then Dim Count As Integer Dim x1, y1, X2, Y2 Dim a As Integer Dim b As Integer Dim Distance Dim RangeLow, RangeHigh Dim xpos, ypos, radius 'clear the board of any inrange settings Dim z For z = 0 To 49 Planet(z).InRange = False Next z 'Check for UltraWarp and set ranges If Player(Other).UltraWarpResearched Then 'increased range RangeLow = Player(Other).Ship(1).WarpPosition * 250 RangeHigh = RangeLow + 700 ElseIf Player(Other).UltraWarpResearched = False Then 'lower ranges RangeLow = Player(Other).Ship(1).WarpPosition * 250 RangeHigh = RangeLow + 350 End If 'ship's starting position - originating planet x1 = Player(Other).Ship(1).CenterX y1 = Player(Other).Ship(1).CenterY For Count = 0 To 49 'check distance from home planet to each other planet 'if within the range, set planet's InRange to true 'use centre of planets, not top left corner X2 = picPlanet(Count).Left + (picPlanet(Count).Width / 2) Y2 = picPlanet(Count).Top + (picPlanet(Count).Height / 2) a = Abs(x1 - X2) b = Abs(y1 - Y2) Distance = Int(Sqr(a ^ 2 + b ^ 2)) If Distance >= RangeLow And Distance <= RangeHigh And picPlanet(Count).Visible Then 'planet is within range - set value Planet(Count).InRange = True 'find center of the picturebox and draw circle xpos = picPlanet(Count).Left + (picPlanet(Count).Width / 2) ypos = picPlanet(Count).Top + (picPlanet(Count).Height / 2) radius = (picPlanet(Count).Width / 2) + 45 'set drawmode picGalaxy.DrawMode = 7 picGalaxy.DrawWidth = 1 picGalaxy.Circle (xpos, ypos), radius, vbRed End If Next Count PlaySoundEffect "Quiet" MsgBox "No landing data available", vbInformation + vbOKOnly, "Probe Error" End If End Sub Private Sub cmdPreviewEnemy2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 'redraw the circles to erase them 'if cloaked, don't do this routine at all If Player(Other).Ship(1).HaveCloakingDevice And Player(Other).Ship(1).Hidden Then 'don't do the preview at all Exit Sub End If Dim xpos, ypos, radius Dim z For z = 0 To 49 If Planet(z).InRange And picPlanet(z).Visible Then 'find center of the picturebox and draw circle xpos = picPlanet(z).Left + (picPlanet(z).Width / 2) ypos = picPlanet(z).Top + (picPlanet(z).Height / 2) radius = (picPlanet(z).Width / 2) + 45 'set drawmode picGalaxy.DrawMode = 7 picGalaxy.DrawWidth = 1 picGalaxy.Circle (xpos, ypos), radius, vbRed End If Next z End Sub Private Sub cmdPreviewShip1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'figure out which planets are available for landing Dim NumPlanetsInRange As Integer 'if none, tell player If Player(Current).Ship(0).Launched Then 'figure out which planets are available for landing Dim Count As Integer Dim x1, y1, X2, Y2 Dim a As Integer Dim b As Integer Dim Distance Dim RangeLow, RangeHigh Dim xpos, ypos, radius 'set activeship to appropriate ship number activeship = 0 'clear the board of any inrange settings Dim z For z = 0 To 49 Planet(z).InRange = False Next z 'Check for UltraWarp and set ranges If Player(Current).UltraWarpResearched Then 'increased range RangeLow = Player(Current).Ship(0).WarpPosition * 250 RangeHigh = RangeLow + 700 ElseIf Player(Current).UltraWarpResearched = False Then 'lower ranges RangeLow = Player(Current).Ship(0).WarpPosition * 250 RangeHigh = RangeLow + 350 End If 'ship's starting position - originating planet x1 = Player(Current).Ship(0).CenterX y1 = Player(Current).Ship(0).CenterY 'check distance from home planet to each other planet 'if within the range, set planet's InRange to true For Count = 0 To 49 'use centre of planets, not top left corner X2 = picPlanet(Count).Left + (picPlanet(Count).Width / 2) Y2 = picPlanet(Count).Top + (picPlanet(Count).Height / 2) a = Abs(x1 - X2) b = Abs(y1 - Y2) Distance = Int(Sqr(a ^ 2 + b ^ 2)) If Distance >= RangeLow And Distance <= RangeHigh Then 'planet is within range - set value Planet(Count).InRange = True NumPlanetsInRange = NumPlanetsInRange + 1 End If Next Count If NumPlanetsInRange = 0 Then PlaySoundEffect "Quiet" MsgBox "No planets in range this turn", vbOKOnly + vbInformation, "Attempting to Land Ship 1" Exit Sub End If 'if in range, draw circle For Count = 0 To 49 If Planet(Count).InRange And picPlanet(Count).Visible Then 'find center of the picturebox and draw circle xpos = picPlanet(Count).Left + (picPlanet(Count).Width / 2) ypos = picPlanet(Count).Top + (picPlanet(Count).Height / 2) radius = (picPlanet(Count).Width / 2) + 45 picGalaxy.DrawMode = 7 picGalaxy.DrawWidth = 1 picGalaxy.Circle (xpos, ypos), radius, vbYellow End If Next Count 'ship not launched PlaySoundEffect "Quiet" MsgBox "No landing data available", vbInformation + vbOKOnly, "Probe Error" End If End Sub Private Sub cmdPreviewShip1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) txtStatus.Text = "" End Sub Private Sub cmdPreviewShip1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 'redraw the circles to erase them EraseCircles End Sub Private Sub cmdPreviewShip2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'figure out which planets are available for landing Dim NumPlanetsInRange As Integer 'if none, tell player If Player(Current).Ship(1).Launched Then 'figure out which planets are available for landing Dim Count As Integer Dim x1, y1, X2, Y2 Dim a As Integer Dim b As Integer Dim Distance Dim RangeLow, RangeHigh Dim xpos, ypos, radius 'set activeship to appropriate ship number activeship = 1 'clear the board of any inrange settings Dim z For z = 0 To 49 Planet(z).InRange = False Next z 'Check for UltraWarp and set ranges If Player(Current).UltraWarpResearched Then 'increased range RangeLow = Player(Current).Ship(1).WarpPosition * 250 RangeHigh = RangeLow + 700 ElseIf Player(Current).UltraWarpResearched = False Then 'lower ranges RangeLow = Player(Current).Ship(1).WarpPosition * 250 RangeHigh = RangeLow + 350 End If 'ship's starting position - originating planet x1 = Player(Current).Ship(1).CenterX y1 = Player(Current).Ship(1).CenterY 'check distance from home planet to each other planet 'if within the range, set planet's InRange to true For Count = 0 To 49 X2 = picPlanet(Count).Left + (picPlanet(Count).Width / 2) Y2 = picPlanet(Count).Top + (picPlanet(Count).Height / 2) a = Abs(x1 - X2) b = Abs(y1 - Y2) Distance = Int(Sqr(a ^ 2 + b ^ 2)) If Distance >= RangeLow And Distance <= RangeHigh Then 'planet is within range - set value Planet(Count).InRange = True NumPlanetsInRange = NumPlanetsInRange + 1 End If Next Count If NumPlanetsInRange = 0 Then PlaySoundEffect "Quiet" MsgBox "No planets in range this turn", vbOKOnly + vbInformation, "Attempting to Land Ship 2" Exit Sub End If 'if in range, draw circle For Count = 0 To 49 If Planet(Count).InRange And picPlanet(Count).Visible Then 'find center of the picturebox and draw circle xpos = picPlanet(Count).Left + (picPlanet(Count).Width / 2) ypos = picPlanet(Count).Top + (picPlanet(Count).Height / 2) radius = (picPlanet(Count).Width / 2) + 45 picGalaxy.DrawMode = 7 picGalaxy.DrawWidth = 1 picGalaxy.Circle (xpos, ypos), radius, vbYellow End If Next Count PlaySoundEffect "Quiet" MsgBox "No landing data available", vbInformation + vbOKOnly, "Probe Error" End If End Sub Private Sub cmdPreviewShip2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) txtStatus.Text = "" End Sub Private Sub cmdPreviewShip2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 'redraw the circles to erase them EraseCircles End Sub Private Sub cmdRegenerate_Click() 'Regenerate planet after detoxification, after biorocket damage If Planet(ActivePlanet).NukedResources And Player(Current).RegenerationResearched Then 'check if enough money UnitCost = 15 'defined globally in .bas module If Player(Current).NumResources >= UnitCost Then 'continue PlaySoundEffect "Button2" If MsgBox("Regenerate this planet?", vbYesNo, "") = vbYes Then 'deduct cost Player(Current).NumResources = Player(Current).NumResources - UnitCost UpdatePlayerStats Randomize Dim Num Num = Int(Rnd * 3) + 2 Planet(ActivePlanet).Resources = Planet(ActivePlanet).Resources + Num If Planet(ActivePlanet).Resources > 8 Then Planet(ActivePlanet).Resources = 8 End If PlaySoundEffect "Quiet" MsgBox "Resource regeneration successful." + Chr(13) + "Production Capacity Now" + Str(Planet(ActivePlanet).Resources) + " Resources/Turn", , "Regeneration Complete" Planet(ActivePlanet).NukedResources = False End If Else 'insufficient funds PlaySoundEffect "Quiet" MsgBox "Regeneration costs 15 resource units", vbExclamation, "Insufficient Resources" End If End If End Sub Private Sub cmdRegenerate_LostFocus() RegenerateOn = False End Sub Private Sub cmdRegenerate_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) txtStatus.Text = "Regenerate Barren Planet's Resource Capacity" End Sub Private Sub cmdRepairIndustry_Click() 'start by checking for enough money - cost of 10-15 'if not enough, msgbox saying what it costs, then exit sub 'else, do the rest Dim Msg As String 'for msgbox If Planet(ActivePlanet).Damaged Then 'check if enough money UnitCost = 10 'defined globally in .bas module If Player(Current).NumResources >= UnitCost Then 'deduct cost of repairs Player(Current).NumResources = Player(Current).NumResources - UnitCost UpdatePlayerStats 'add 2-3 resources Dim Repairs As Integer Randomize Repairs = Int(Rnd * 1) + 2 'add repairs to planet's resources Planet(ActivePlanet).Resources = Planet(ActivePlanet).Resources + Repairs 'ceiling of 8 resources If Planet(ActivePlanet).Resources > 8 Then Planet(ActivePlanet).Resources = 8 End If If Planet(ActivePlanet).Resources > 3 Then 'msgbox showing amt of improvement, and that further improvements need factory Msg = "Resource Production on " + Planet(ActivePlanet).Name + " increased by" + Str(Repairs) + " to" + Str(Planet(ActivePlanet).Resources) + " units" + Chr(13) Msg = Msg + "Further improvements require an Advanced Resource Production Facility" PlaySoundEffect "Quiet" MsgBox Msg, , "Industry Repair Results" 'set Damaged ppty to false to prevent further repairs Planet(ActivePlanet).Damaged = False cmdRepairIndustry.Enabled = False Else 'msgbox showing amt of improvement, and further repairs are ok Msg = "Resource Production on " + Planet(ActivePlanet).Name + " increased by" + Str(Repairs) + " to" + Str(Planet(ActivePlanet).Resources) + " units" + Chr(13) Msg = Msg + "Further repairs are possible." PlaySoundEffect "Quiet" MsgBox Msg, , "Industry Repair Results" End If Else PlaySoundEffect "Quiet" MsgBox "Repairs cost 10 resource units", vbExclamation, "Insufficient Resources" End If End If End Sub Private Sub cmdScan_Click() 'figure out which planets are in scanner range 'draw red circle, allow full details in mousemove PlaySoundEffect "Button4" Dim Count As Integer Dim x1, y1, X2, Y2 Dim a As Integer Dim b As Integer Dim Distance Dim Range Dim xpos, ypos, radius 'set toggle If ScannerOn = True Then ScannerOn = False ElseIf ScannerOn = False Then ScannerOn = True End If 'if scanner on, turn off buttons that screw things up If ScannerOn Then cmdPreviewShip1.Enabled = False cmdPreviewShip2.Enabled = False cmdPreviewEnemy1.Enabled = False cmdPreviewEnemy2.Enabled = False cmdLandShip1.Enabled = False cmdLandShip2.Enabled = False ElseIf ScannerOn = False Then cmdPreviewShip1.Enabled = True cmdPreviewShip2.Enabled = True cmdPreviewEnemy1.Enabled = True cmdPreviewEnemy2.Enabled = True If Player(Current).Ship(0).Launched Then cmdLandShip1.Enabled = True End If If Player(Current).Ship(1).Launched Then cmdLandShip2.Enabled = True End If End If 'clear the board of any inrange settings Dim z For z = 0 To 49 Planet(z).InScannerRange = False Next z 'set range If Player(Current).DeepScannerResearched Then Range = 1800 Range = 1200 End If 'scanner's centre - originating planet x1 = picPlanet(ActivePlanet).Left + (picPlanet(ActivePlanet).Width / 2) y1 = picPlanet(ActivePlanet).Top + (picPlanet(ActivePlanet).Height / 2) 'check distance from home planet to each other planet 'if within the range, set planet's InRange to true For Count = 0 To 49 X2 = picPlanet(Count).Left + (picPlanet(Count).Width / 2) Y2 = picPlanet(Count).Top + (picPlanet(Count).Height / 2) a = Abs(x1 - X2) b = Abs(y1 - Y2) Distance = Int(Sqr(a ^ 2 + b ^ 2)) If Distance <= Range Then 'check for jammer, or set as in range If Planet(Count).HaveJammer Then Planet(Count).InScannerRange = False ElseIf Planet(Count).HaveJammer = False Then Planet(Count).InScannerRange = True End If End If Next Count 'draw red circle showing range of scanner radius = Range picGalaxy.DrawMode = 7 picGalaxy.Circle (x1, y1), radius, vbRed End Sub Private Sub cmdScan_LostFocus() '**getting rid of this seems to clear up some conflict 'between the scanner and the landing buttons... 'scanner gets turned off when a foreign planet is clicked. 'cmdScan_Click 'clear the board of any inrange settings 'Dim z As Integer 'For z = 0 To 49 ' Planet(z).InScannerRange = False 'Next z End Sub Private Sub cmdViewSend_Click() 'play monitor sound PlaySoundEffect "Button3" '***see if ships being landed, if so, turn them off If ReadyToLand1 Then cmdLandShip1_Click End If If ReadyToLand2 Then cmdLandShip2_Click End If 'bring up the message console form frmMessageConsole.Show Modal 'turn off scanner If ScannerOn Then cmdScan_Click ScannerOn = False cmdScan.Enabled = False End If End Sub Private Sub cmdViewSend_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) txtStatus.Text = "View or Send Messages" End Sub Private Sub Form_Activate() 'set value of cmdland1 and 2 toggles: ReadyToLand1 = False ReadyToLand2 = False 'put player number under owned planets Dim Count As Integer For Count = 0 To 49 If Planet(Count).Owner = Current Then picGalaxy.CurrentX = picPlanet(Count).Left + (picPlanet(Count).Width / 2) - 25 picGalaxy.CurrentY = picPlanet(Count).Top + picPlanet(Count).Height + 15 picGalaxy.ForeColor = vbYellow picGalaxy.Print Str(Current + 1) ElseIf Planet(Count).Owner = Other Then picGalaxy.CurrentX = picPlanet(Count).Left + (picPlanet(Count).Width / 2) - 25 picGalaxy.CurrentY = picPlanet(Count).Top + picPlanet(Count).Height + 15 picGalaxy.ForeColor = vbRed picGalaxy.Print Str(Other + 1) End If Next Count 'put ships on the warp path with coordinates printed below '***** RefreshWarpPath '***** Dim z 'counter Dim j, k 'hold warp positions - easier to type & read For z = 0 To 1 If Player(Other).Ship(z).Launched Then k = Player(Other).Ship(z).WarpPosition If Player(Other).Ship(z).HaveCloakingDevice And CloakingChecked(z) = False Then ' '******see if ship is hidden********* Randomize Dim ChanceOfHiding As Integer Dim Result ChanceOfHiding = 98 'set base chance of being hidden 'chance lowered if current player has the warp scanner If Player(Current).WarpScannerResearched Then ChanceOfHiding = 75 ChanceOfHiding = ChanceOfHiding + Int(Rnd * 5) ChanceOfHiding = ChanceOfHiding - Int(Rnd * 5) End If Result = Int(Rnd * 100) + 1 If Result <= ChanceOfHiding Then 'don't show picture on path Debug.Print "Chance of hiding: ", ChanceOfHiding, "greater than/equal to Result: ", Result, "therefore, NOT showing" Player(Other).Ship(z).Hidden = True CloakingChecked(z) = True Else 'ship is not hidden this turn Player(Other).Ship(z).Hidden = False Debug.Print "Chance: ", ChanceOfHiding, "Result: ", Result, "NOT HIDDEN!" 'show picture picEnemyPath(k - 1).Picture = picTemp.Picture 'set cursor at bottom right corner picEnemyPath(k - 1).CurrentX = 290 picEnemyPath(k - 1).CurrentY = 425 picEnemyPath(k - 1).Print Player(Other).Ship(z).Coordinate CloakingChecked(z) = True End If Else 'put picture on enemy path - IF NOT HIDDEN!! If Player(Other).Ship(z).Hidden = False Then picEnemyPath(k - 1).Picture = picTemp.Picture 'set cursor at bottom right corner picEnemyPath(k - 1).CurrentX = 290 picEnemyPath(k - 1).CurrentY = 425 picEnemyPath(k - 1).Print Player(Other).Ship(z).Coordinate End If End If End If Next z 'enable the landing frame if either ship is in warp If Player(Current).Ship(0).Launched Or Player(Current).Ship(1).Launched Then fraLanding.Enabled = True End If 'enable the landing buttons if ships are launched If Player(Current).Ship(0).Launched Then cmdLandShip1.Enabled = True End If If Player(Current).Ship(1).Launched Then cmdLandShip2.Enabled = True End If 'enable the preview buttons cmdPreviewShip1.Enabled = True cmdPreviewShip2.Enabled = True cmdPreviewEnemy1.Enabled = True cmdPreviewEnemy2.Enabled = True '******************************** 'check for contamination - set picture Dim h For h = 0 To 49 If Planet(h).Contaminated Then picPlanet(h).Cls picPlanet(h).Picture = picNuclear.Picture End If Next h 'Check for Contaminated Planets - damage done every turn humans on planet Dim X As Integer If ContaminationWarningGiven = False Then For X = 0 To 49 If Planet(X).Owner = Current And Planet(X).Contaminated Then 'figure out damage BioDamage (X) ContaminationWarningGiven = True End If Next X End If 'unload cover form Unload frmCover End Sub Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) 'trap the function keys Select Case KeyCode Case vbKeyEscape 'show quick help screen PlaySoundEffect "Button3" 'call sub from Declare.bas ShowQuickHelp Case vbKeyF2 'Save game and exit cmdEndTurn.Value = True Case vbKeyF3 'Exit without saving cmdAbort.Value = True Case vbKeyF4 'toggle grid lines If GridLinesOn = False Then DrawGridLines GridLinesOn = True ElseIf GridLinesOn = True Then EraseGridLines GridLinesOn = False End If Case vbKeyF5 'toggle sound If SoundOn = False Then SoundOn = True ElseIf SoundOn = True Then SoundOn = False End If Case vbKeyF6 PlaySoundEffect "Button3" If ReadyToLand1 Then cmdLandShip1_Click End If If ReadyToLand2 Then cmdLandShip2_Click End If 'bring up the message console form frmConfigure.Show Modal 'turn off scanner If ScannerOn Then cmdScan_Click ScannerOn = False cmdScan.Enabled = False End If End Select End Sub Private Sub Form_Load() 'test 'Player(Current).NumResources = 666 'Planet(8).Owner = Current 'Planet(8).Sabotaged = True 'Planet(8).SabotageReduction = 0 'Player(Other).NumPlanets = 10 'Player(Other).WasBig = True 'refresh this variable NumPlanetsCaptured = 0 'for messages to players in frmAnnounce 'to set a random 3rd line Dim alternate1 As String Dim alternate2 As String Dim alternate3 As String Dim choice As Integer Me.WindowState = DefaultGameSize SetAppHelp (Me.hWnd) 'register help file with win engine Call DisableX(Me) 'disable the X button on the control box 'turn off the planets that aren't in play 'due to galaxy size Select Case GalaxySize Case 30 '20 planets turned off picPlanet(2).Visible = False picPlanet(5).Visible = False picPlanet(7).Visible = False picPlanet(10).Visible = False picPlanet(12).Visible = False picPlanet(14).Visible = False picPlanet(16).Visible = False picPlanet(19).Visible = False picPlanet(21).Visible = False picPlanet(22).Visible = False picPlanet(26).Visible = False picPlanet(28).Visible = False picPlanet(31).Visible = False picPlanet(33).Visible = False picPlanet(34).Visible = False picPlanet(37).Visible = False picPlanet(38).Visible = False picPlanet(43).Visible = False picPlanet(45).Visible = False picPlanet(46).Visible = False picPlanet(49).Visible = False 'adjust location of some planets, to even them out picPlanet(0).Top = 600 picPlanet(0).Left = 300 picPlanet(9).Top = 400 picPlanet(9).Left = 5200 Case 40 '10 planets turned off picPlanet(4).Visible = False picPlanet(11).Visible = False picPlanet(16).Visible = False picPlanet(20).Visible = False picPlanet(22).Visible = False picPlanet(28).Visible = False 'picPlanet(31).Visible = False picPlanet(35).Visible = False picPlanet(37).Visible = False picPlanet(39).Visible = False picPlanet(44).Visible = False End Select 'to trap the function keys: KeyPreview = True 'reset justlanded to false - not necessary, but just in case... Dim v For v = 0 To 49 Planet(v).JustLanded = False Next v DrawGalaxy 'set the form caption with current player's number 'and set player's name in name box Personalize 'print message in message box If IncomingMessage = "" Then txtMessages.FontBold = False txtMessages.ForeColor = vbGreen txtMessages.Text = "No Messages at this time" txtMessages.ForeColor = vbYellow txtMessages.FontBold = True txtMessages.Text = "Incoming Message..." frmMessageConsole.txtMessageBox.Text = IncomingMessage 'Beep End If 'fill in turn number box txtTurnNumber.Text = "Turn " & Str(TurnNumber) '******BioRocket******* '** I moved the part that checks for contaminated planets & calls BioDamage procedure '** to the form_activate event - seems to work, showing msgbox on top of gamescreen '** instead of on space background...with flag to only show it once/turn Dim X As Integer 'see if biohazard rockets landed For X = 0 To 49 If Planet(X).BioRocketETA = TurnNumber Then Detonation (X) End If Next X '********End BioRocket********* '******Aliens******** CheckForAliens 'update troops on alien planets UpdateAliens 'check for expansion to neutral planets AlienExpansion '******************** 'Update players resources UpdateResources 'fill in planet, troop and resources text boxes UpdatePlayerStats 'initialize the colours for the status text box Dim yellow, red, Green yellow = &HFFFF& 'for player 1 red = &HFF& 'for player 2 Green = &HFF00& 'for neutral 'enable the landing frame if either ship is in warp If Player(Current).Ship(0).Launched Or Player(Current).Ship(1).Launched Then fraLanding.Enabled = True End If 'enable the landing buttons if ships are launched If Player(Current).Ship(0).Launched Then cmdLandShip1.Enabled = True End If If Player(Current).Ship(1).Launched Then cmdLandShip2.Enabled = True End If '******************************************** '***********MULTI-TURN RESEARCH************** If Player(Current).MechResearchDone = TurnNumber Then 'MsgBox "Turnnumber=" + Str(TurnNumber) + "player(current).mechresearchdone=" + Str(Player(Current).MechResearchDone) TechLevel = 1 'techlevel set in module declare.bas Player(Current).MechResearched = True frmTechDone.Show Modal End If If Player(Current).ShieldResearchDone = TurnNumber Then TechLevel = 2 Player(Current).ShieldResearched = True frmTechDone.Show Modal End If If Player(Current).ResourceResearchDone = TurnNumber Then TechLevel = 3 Player(Current).ResourcesResearched = True frmTechDone.Show Modal End If If Player(Current).ScannerResearchDone = TurnNumber Then TechLevel = 5 Player(Current).ScannerResearched = True frmTechDone.Show Modal End If If Player(Current).BigShipResearchDone = TurnNumber Then TechLevel = 6 Player(Current).BigShipResearched = True frmTechDone.Show Modal End If If Player(Current).UltraWarpResearchDone = TurnNumber Then TechLevel = 7 Player(Current).UltraWarpResearched = True frmTechDone.Show Modal End If If Player(Current).DeepScannerResearchDone = TurnNumber Then TechLevel = 8 Player(Current).DeepScannerResearched = True frmTechDone.Show Modal End If If Player(Current).JammerResearchDone = TurnNumber Then TechLevel = 9 Player(Current).JammerResearched = True frmTechDone.Show Modal End If If Player(Current).CloakingResearchDone = TurnNumber Then TechLevel = 10 Player(Current).CloakingResearched = True frmTechDone.Show Modal End If If Player(Current).Missile1ResearchDone = TurnNumber Then TechLevel = 11 Player(Current).Missile1Researched = True frmTechDone.Show Modal End If If Player(Current).Missile2ResearchDone = TurnNumber Then TechLevel = 12 Player(Current).Missile2Researched = True frmTechDone.Show Modal End If If Player(Current).LaserResearchDone = TurnNumber Then TechLevel = 13 Player(Current).LaserResearched = True 'recalculate all player's planet's combatstrengths 'but not the troops on ships... Dim Q For Q = 0 To 49 If Planet(Q).Owner = Current Then SetCombatStrength (Q) End If Next Q frmTechDone.Show Modal End If If Player(Current).PlasmaResearchDone = TurnNumber Then TechLevel = 14 Player(Current).PlasmaResearched = True 'reset CS for all troops - except those on ships For Q = 0 To 49 If Planet(Q).Owner = Current Then SetCombatStrength (Q) End If Next Q frmTechDone.Show Modal End If If Player(Current).BioRocketResearchDone = TurnNumber Then TechLevel = 15 Player(Current).BioRocketResearched = True frmTechDone.Show Modal End If If Player(Current).LongBioResearchDone = TurnNumber Then TechLevel = 16 Player(Current).LongBioResearched = True frmTechDone.Show Modal End If If Player(Current).ShipShield1ResearchDone = TurnNumber Then TechLevel = 17 Player(Current).ShipShield1Researched = True frmTechDone.Show Modal End If If Player(Current).ShipShield2ResearchDone = TurnNumber Then TechLevel = 18 Player(Current).ShipShield2Researched = True frmTechDone.Show Modal End If If Player(Current).BioCleanupResearchDone = TurnNumber Then TechLevel = 19 Player(Current).BioCleanupResearched = True frmTechDone.Show Modal End If If Player(Current).RegenerationResearchDone = TurnNumber Then TechLevel = 20 Player(Current).RegenerationResearched = True frmTechDone.Show Modal End If If Player(Current).WarpScannerResearchDone = TurnNumber Then TechLevel = 21 Player(Current).WarpScannerResearched = True frmTechDone.Show Modal End If '********************************** '******ANNOUNCEMENTS*********** 'warn player when enemy has more than 10 planets If Player(Other).NumPlanets > 9 And Player(Current).Message1Given = False Then MessageType = "Expanding" Announceline1 = "Reports Show " + Player(Other).Name + "'s Reach" Announceline2 = "Has Extended Across" + Str(Player(Other).NumPlanets) + " Systems." Announceline3 = "" frmAnnounce.Show Modal Player(Current).Message1Given = True End If 'second warning when more than 20 planets If Player(Other).NumPlanets > 19 And Player(Current).Message2Given = False Then MessageType = "Expanding" Announceline1 = Player(Other).Name + "'s Empire Now Spans" + Str(Player(Other).NumPlanets) + " Systems." Announceline2 = "Your People Demand Action!" Announceline3 = "" frmAnnounce.Show Modal Player(Current).Message2Given = True Player(Other).WasBig = True End If 'message if enemy's empire is shrinking If Player(Other).NumPlanets < 12 And Player(Other).WasBig Then MessageType = "Expanding" Announceline1 = Player(Other).Name + "'s Empire is Crumbling -" Announceline2 = "Fewer Than 15 Systems Remain..." Announceline3 = "Victory Is At Hand!" frmAnnounce.Show Modal Player(Other).WasBig = False End If 'message if planet captured by opponent For X = 0 To 49 If Planet(X).Owner = Other And Planet(X).Captured = True Then 'tell player which planet is lost MessageType = "Captured" Announceline1 = Player(Other).Name + " has triumphed over our forces" Announceline2 = "stationed on " + Planet(X).Name + " ---" '***set a random third line Randomize choice = Int(Rnd * 3) + 1 alternate1 = "We must avenge them!" alternate2 = "This humiliation cannot be accepted..." alternate3 = "We must reclaim this world for the Empire!" Select Case choice Case 1 Announceline3 = alternate1 Case 2 Announceline3 = alternate2 Case 3 Announceline3 = alternate3 End Select frmAnnounce.Show Modal 'reset captured variable Planet(X).Captured = False End If Next X 'message that other player's invasion failed For X = 0 To 49 If Planet(X).Owner = Current And Planet(X).FailedInvasion = True Then MessageType = "Failed Invasion" '***set a random FIRST line Randomize choice = Int(Rnd * 3) + 1 alternate1 = "Our Forces on " + Planet(X).Name + " have stopped an invasion!" alternate2 = Planet(X).Name + " reports a failed invasion!" alternate3 = Player(Other).Name + " was turned back at " + Planet(X).Name + "!" Select Case choice Case 1 Announceline1 = alternate1 Case 2 Announceline1 = alternate2 Case 3 Announceline1 = alternate3 End Select 'Announceline1 = "Our Forces on " + Planet(X).Name + " have repelled an invasion!" Announceline2 = "Troop Losses: " + Str(Planet(X).FailedInvasionTroopLosses) If Player(Current).MechResearched = True Then Announceline3 = "Mech Losses: " + Str(Planet(X).FailedInvasionMechLosses) Else Announceline3 = "" End If frmAnnounce.Show Modal 'reset values to prevent repeat messages Planet(X).FailedInvasion = False Planet(X).FailedInvasionTroopLosses = 0 Planet(X).FailedInvasionMechLosses = 0 End If Next X 'message if biorocket did not detonate - warn player that enemy tried 'to use biorocket on them... For X = 0 To 49 If Planet(X).Owner = Current And Planet(X).BioFailed Then 'warn player that enemy tried to use biorocket MessageType = "BioFailed" Announceline1 = "Leaders on " + Planet(X).Name + " confirm the destruction" Announceline2 = "of an incoming BioChemical Rocket" '***set a random third line Randomize choice = Int(Rnd * 3) + 1 alternate1 = "A catastrophe has been narrowly avoided!" alternate2 = "A swift reprisal is demanded!" alternate3 = "The planet is saved!" Select Case choice Case 1 Announceline3 = alternate1 Case 2 Announceline3 = alternate2 Case 3 Announceline3 = alternate3 End Select frmAnnounce.Show Modal 'reset biofailure stuff to avoid repeat messages Planet(X).BioFailed = False End If Next X 'Message if planet was sabotaged - successful or not For X = 0 To 49 If Planet(X).Owner = Current And Planet(X).Sabotaged Then 'MessageType = "Sabotage" If Planet(X).SabotageReduction = 0 Then 'mission was a FAILURE MessageType = "Sabotage Failed" '**this should be in frmAnnounce as well, not just a msgbox... Announceline1 = "Reports from " + Planet(X).Name + " confirm that enemy" Announceline2 = "forces tried to sabotage its resource production --" Announceline3 = "The cowards were destroyed!" frmAnnounce.Show Modal 'Dim msg1 As String 'Dim msg2 As String 'Dim msg3 As String 'msg1 = "Reports from " + Planet(X).Name + " confirm that enemy" 'msg2 = "forces tried to sabotage its resource production --" 'msg3 = "The cowards were destroyed!" 'PlaySoundEffect "Warning" 'MsgBox msg1 + Chr(13) + msg2 + Chr(13) + msg3, vbExclamation, "Sabotage Alert!" 'don't repeat this message every turn!!! Planet(X).Sabotaged = False Planet(X).SabotageReduction = 0 Planet(X).SabotagedFactory = False ElseIf Planet(X).SabotageReduction > 0 Or Planet(X).SabotageReduction = -1 Then 'NOTE: variable can be -1 if the planet already had 0 resources when sabotaged... 'mission was a SUCCESS MessageType = "Sabotage" Announceline1 = "Reports from " + Planet(X).Name + " confirm that saboteurs" If Planet(X).SabotagedFactory Then Announceline2 = "have destroyed their resource production!" Else Announceline2 = "have breached the security perimeter!" End If Announceline3 = "Resource production reduced to " + Str(Planet(X).Resources) frmAnnounce.Show Modal 'reset sabotage attributes, to avoid the message coming up every turn 'and to allow the planet to be sabotaged again... Planet(X).Sabotaged = False Planet(X).SabotageReduction = 0 Planet(X).SabotagedFactory = False 'ElseIf Planet(X).SabotageReduction = -1 Then 'do nothing - sabotaged a planet already at 0 resources 'reset sabotage attributes, to avoid the message coming up every turn 'and to allow the planet to be sabotaged again... ' Planet(X).Sabotaged = False ' Planet(X).SabotageReduction = 0 ' Planet(X).SabotagedFactory = False End If End If Next X End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) txtStatus.ForeColor = vbGreen txtStatus.Text = "" End Sub Private Sub Form_Resize() RefreshWarpPath End Sub Private Sub fraEnemyWarpPath_DragDrop(Source As Control, X As Single, Y As Single) txtStatus.ForeColor = vbGreen End Sub Private Sub fraLanding_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) txtStatus.Text = "" End Sub Private Sub fraOptions_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) txtStatus.Text = "" txtStatus.ForeColor = vbGreen End Sub Private Sub fraPlayerStats_DragDrop(Source As Control, X As Single, Y As Single) txtStatus.ForeColor = vbGreen txtStatus.Text = "Player Stats" End Sub Private Sub fraTactical_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) txtStatus.Text = "" End Sub Private Sub fraUpgrade_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) txtStatus.ForeColor = vbGreen txtStatus.Text = "" End Sub Private Sub fraWarpPath_DragDrop(Source As Control, X As Single, Y As Single) txtStatus.ForeColor = vbGreen End Sub Private Sub fraWarpPath_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) txtStatus.Text = "" End Sub Private Sub hsbQuantity_Change() 'update the quantity label and projected cost lblQuantity.Caption = Str(hsbQuantity.Value) Quantity = hsbQuantity.Value PurchasePrice = Quantity * UnitCost txtTotal.Text = Str(PurchasePrice) End Sub Private Sub hsbQuantity_Scroll() 'update the quantity label and projected cost lblQuantity.Caption = Str(hsbQuantity.Value) Quantity = hsbQuantity.Value PurchasePrice = Quantity * UnitCost txtTotal.Text = Str(PurchasePrice) End Sub Private Sub lblTitle_DblClick() 'runs code under lblTitle2 lblTitle2_DblClick End Sub Private Sub lblTitle2_DblClick() 'displays the About box Dim Msg As String Dim title, dialogtype dialogtype = vbOKOnly + vbInformation title = "About 4000 A.D." Msg = "4000 A.D. - version 2.5 " + Chr(13) Msg = Msg + "c. 1997-1999 Gordon Stewart - All Rights Reserved " + Chr(13) + Chr(13) Msg = Msg + "Visit 4000 A.D. on the internet at:" + Chr(13) Msg = Msg + "http://www.interlog.com/~gordons/4000ad.html" + Chr(13) + Chr(13) Msg = Msg + "Free source code now available" PlaySoundEffect "Quiet" MsgBox Msg, dialogtype, title End Sub Private Sub picGalaxy_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) txtStatus.Text = "" End Sub Private Sub picPlanet_Click(Index As Integer) 'match the right ship number - with activeship Dim CurrentPlayer, Enemy CurrentPlayer = Current Enemy = Other Dim RandomLosses 'for calculating losses in battles... 'placeholders for troop numbers Dim a, b a = Player(Current).Ship(activeship).Troops b = Player(Current).Ship(activeship).AssaultTroops '****biorocket 'this bit seems to fix a problem with clicking your other planets If Planet(Index).LaunchSite = False And Planet(Index).InBioRange = False And BioRocketOn Then EraseLines End If If Planet(Index).InBioRange And BioRocketOn Then PlaySoundEffect "Button2" If MsgBox("Target this planet?", vbYesNo + vbQuestion, "BioHazard Launch") = vbYes Then If Planet(Index).BioRocketETA > 0 Then PlaySoundEffect "Quiet" MsgBox "This planet has already been targeted", , "BioHazard Launch Aborted" 'erase lines and exit sub EraseLines 'erase circles if necessary If ReadyToLand1 Or ReadyToLand2 Then EraseCircles End If Else 'if planet inbiorange, and not targeted previously... TargetBioRocket (Index) End If Else 'erase lines and exit sub EraseLines 'erase circles if necessary If ReadyToLand1 Or ReadyToLand2 Then EraseCircles End If End If Exit Sub End If '**end biorocket If (ReadyToLand1 = True Or ReadyToLand2 = True) And Planet(Index).InRange And Player(Current).Ship(activeship).Launched Then PlaySoundEffect "Quiet" If MsgBox("Do you want to land here?", vbYesNo + vbQuestion, "Landing") = vbYes Then 'get rid of the circles EraseCircles '*****SABOTAGE***** If Player(Current).Ship(activeship).Sabotage Then 'goto sabotage routine Call SabotageLanding(Index, activeship) ReInitializeShip (activeship) Exit Sub End If '****END OF SABOTAGE ***** 'select type of landing - friendly, neutral or attack Select Case Planet(Index).Owner Case CurrentPlayer 'landing on planet player owns PlaySoundEffect "Quiet" MsgBox "Landing successful", , " " 'update planet, ship stats, player stats UpdateNumPlanets UpdatePlayerStats 'disable the landing button and remove from warp path If activeship = 0 Then cmdLandShip1.Enabled = False 'get rid of the ship picture picPlayerPath(Player(Current).Ship(activeship).WarpPosition - 1).Picture = LoadPicture() End If If activeship = 1 Then cmdLandShip2.Enabled = False 'get rid of the ship picture picPlayerPath(Player(Current).Ship(activeship).WarpPosition - 1).Picture = LoadPicture() End If 'set ship values to unlaunched and empty ReInitializeShip (activeship) RefreshWarpPath 'add the players stuff to the planet Planet(Index).Troops = Planet(Index).Troops + a Planet(Index).AssaultTroops = Planet(Index).AssaultTroops + b SetCombatStrength (Index) 'set ship values to unlaunched and empty ReInitializeShip (activeship) 'clear the management frame ClearFrame cmdPreviewShip1.Enabled = True cmdPreviewShip2.Enabled = True cmdPreviewEnemy1.Enabled = True cmdPreviewEnemy2.Enabled = True Case Enemy 'landing on other player's planet PlaySoundEffect "Attack" Randomize 'set placeholder for current player's combat strength AttackStrength = Player(Current).Ship(activeship).CombatStrength DefenceStrength = Planet(Index).CombatStrength 'set placeholders for troops on the planet Dim c, d c = Planet(Index).Troops d = Planet(Index).AssaultTroops 'compare the strengths If AttackStrength > DefenceStrength Then 'ATTACKER WINS NumPlanetsCaptured = NumPlanetsCaptured + 1 Planet(Index).Captured = True 'don't allow player to launch from this planet this turn Planet(Index).JustLanded = True 'winner loses % of troops based on defensive CS 'initial value TroopLosses = 0 If a > 0 And DefenceStrength > 0 Then Select Case DefenceStrength Case 0 'no losses TroopLosses = 0 Case 1 To 2 '0-10% losses TroopLosses = Int(Rnd * 10) Case 3 To 4 '5-15% losses TroopLosses = Int(Rnd * 10) + 5 Case 5 To 7 '10-20% TroopLosses = Int(Rnd * 10) + 10 Case 8 To 10 '15-25% TroopLosses = Int(Rnd * 10) + 15 Case 11 To 15 '15-30% TroopLosses = Int(Rnd * 15) + 15 Case 16 To 200 '20-35% TroopLosses = Int(Rnd * 15) + 20 Case Else '20-45% TroopLosses = Int(Rnd * 25) + 20 End Select a = a - (a * (TroopLosses / 100)) Debug.Print "**Troop Losses = " & Str(TroopLosses) & "%" End If 'winner loses % of assault troops 'initial value AssaultLosses = 0 If b > 0 And DefenceStrength > 0 Then Select Case DefenceStrength Case 0 '0% losses AssaultLosses = 0 Case 1 To 3 '0-10% AssaultLosses = Int(Rnd * 10) Case 4 To 7 '0-15% AssaultLosses = Int(Rnd * 15) Case 8 To 12 '5-15% AssaultLosses = Int(Rnd * 10) + 5 Case 13 To 17 '10-20% AssaultLosses = Int(Rnd * 10) + 10 Case 18 To 250 '15-25% AssaultLosses = Int(Rnd * 10) + 15 Case Else '15-35% AssaultLosses = Int(Rnd * 20) + 15 End Select b = b - (b * (AssaultLosses / 100)) End If 'planet troops, combatstrength changes Planet(Index).Troops = a Planet(Index).AssaultTroops = b 'update other player's stats with c & d (above) Player(Other).NumTroops = Player(Other).NumTroops - Planet(Index).Troops Player(Other).NumAssaultTroops = Player(Other).NumAssaultTroops - d Player(Other).NumPlanets = Player(Other).NumPlanets - 1 'set this variable for frmlandscape: ActivePlanet = Index 'show the results of the battle 'owner of planet not changed yet, to show results of battle - see right below frmLandscape.Show Modal 'planet changes owners Planet(Index).Owner = Current 'set planet's combat strength SetCombatStrength (Index) 'update player: resources, numplanets UpdateNumPlanets UpdatePlayerStats 'clear the management frame ClearFrame cmdPreviewShip1.Enabled = True cmdPreviewShip2.Enabled = True cmdPreviewEnemy1.Enabled = True cmdPreviewEnemy2.Enabled = True '************************************ ElseIf AttackStrength <= Planet(Index).CombatStrength Then 'DEFENDER WINS, and tie goes to the defender 'notify other player next turn Planet(Index).FailedInvasion = True 'lose all your troops Player(Current).NumTroops = Player(Current).NumTroops - a Player(Current).NumAssaultTroops = Player(Current).NumAssaultTroops - b If Planet(Index).Troops > 0 Then 'defender wins, but loses % of troops based on attacker's CS 'initial value TroopLosses = 0 Select Case AttackStrength Case 0 'no losses TroopLosses = 0 Case 1 To 2 '0-10% losses TroopLosses = Int(Rnd * 10) Case 3 To 4 '0-15% losses TroopLosses = Int(Rnd * 15) Case 5 To 8 '5-15% TroopLosses = Int(Rnd * 10) + 5 Case 9 To 12 '10-20% TroopLosses = Int(Rnd * 10) + 10 Case 13 To 15 '10-30% TroopLosses = Int(Rnd * 20) + 10 Case 16 To 20 '15-35% TroopLosses = Int(Rnd * 20) + 15 Case 21 To 25 '15-40% TroopLosses = Int(Rnd * 25) + 15 Case 26 To 35 '20-45% TroopLosses = Int(Rnd * 25) + 20 Case 36 To 45 '25-40% TroopLosses = Int(Rnd * 15) + 25 Case Else '25-50% TroopLosses = Int(Rnd * 25) + 25 End Select 'for next turn's notification of failed invasion Planet(Index).FailedInvasionTroopLosses = Int(c * (TroopLosses / 100)) c = c - (c * (TroopLosses / 100)) Planet(Index).Troops = c End If If Planet(Index).AssaultTroops > 0 Then 'defender/winner loses % of assault troops 'initial value 0 AssaultLosses = 0 Select Case AttackStrength Case 0 To 5 '0% losses AssaultLosses = 0 Case 6 To 10 '0-10% AssaultLosses = Int(Rnd * 10) Debug.Print "Arrgh! Attackstrength:" + Str(AttackStrength), "Assaultlosses:" + Str(AssaultLosses) Case 11 To 15 '0-15% AssaultLosses = Int(Rnd * 15) Case 16 To 25 '5-20% AssaultLosses = Int(Rnd * 15) + 5 Case 26 To 40 '10-20% AssaultLosses = Int(Rnd * 10) + 10 Case 41 To 60 '15-30% AssaultLosses = Int(Rnd * 15) + 15 Case 61 To 80 '20-35% AssaultLosses = Int(Rnd * 15) + 20 Case Else '20-40% AssaultLosses = Int(Rnd * 20) + 20 End Select Planet(Index).FailedInvasionMechLosses = Int(d * (AssaultLosses / 100)) d = d - (d * (AssaultLosses / 100)) Planet(Index).AssaultTroops = d End If 'update planet's combat strength SetCombatStrength (Index) UpdateNumPlanets UpdatePlayerStats 'clear management frame ClearFrame cmdPreviewShip1.Enabled = True cmdPreviewShip2.Enabled = True cmdPreviewEnemy1.Enabled = True cmdPreviewEnemy2.Enabled = True 'set this variable for frmlandscape: ActivePlanet = Index 'show the results of the battle frmLandscape.Show Modal End If 'disable the landing button and remove from warp path If activeship = 0 Then cmdLandShip1.Enabled = False 'get rid of the ship picture picPlayerPath(Player(Current).Ship(activeship).WarpPosition - 1).Picture = LoadPicture() ElseIf activeship = 1 Then cmdLandShip2.Enabled = False 'get rid of the ship picture picPlayerPath(Player(Current).Ship(activeship).WarpPosition - 1).Picture = LoadPicture() End If 'set ship values to unlaunched and empty ReInitializeShip (activeship) RefreshWarpPath Case 2 'landing on UNOWNED planet PlaySoundEffect "Quiet" MsgBox "A new planet for you!", , " " Planet(Index).Owner = Current Planet(Index).JustLanded = True 'so you can't take off again this turn 'add the players stuff to the planet Planet(Index).Troops = a Planet(Index).AssaultTroops = b SetCombatStrength (Index) 'update player: resources, numplanets UpdateNumPlanets UpdatePlayerStats 'clear management frame ClearFrame cmdPreviewShip1.Enabled = True cmdPreviewShip2.Enabled = True cmdPreviewEnemy1.Enabled = True cmdPreviewEnemy2.Enabled = True 'deal with the landing button and warp path picture If activeship = 0 Then cmdLandShip1.Enabled = False 'get rid of the ship picture picPlayerPath(Player(Current).Ship(activeship).WarpPosition - 1).Picture = LoadPicture() ElseIf activeship = 1 Then cmdLandShip2.Enabled = False 'get rid of the ship picture picPlayerPath(Player(Current).Ship(activeship).WarpPosition - 1).Picture = LoadPicture() End If 'set ship values to unlaunched and empty ReInitializeShip (activeship) RefreshWarpPath 'show the landscape screen with troop stats ActivePlanet = Index frmLandscape.Show Modal Case 3 AttackAliens (Index) End Select Else 'answered NO to msgbox - turn off circles, set rtl false EraseCircles ReadyToLand1 = False ReadyToLand2 = False cmdPreviewShip1.Enabled = True cmdPreviewShip2.Enabled = True cmdPreviewEnemy1.Enabled = True cmdPreviewEnemy2.Enabled = True If Player(Current).Ship(0).Launched Then cmdLandShip1.Enabled = True End If If Player(Current).Ship(1).Launched Then cmdLandShip2.Enabled = True End If Exit Sub End If 'quit without showing "Hey! Not your planet box" Exit Sub End If '****************************** '*****Planet Management******** '****************************** If Planet(Index).Owner = Current Then On Error Resume Next PlaySoundEffect "Ambient3" 'PlayRandomSound On Error GoTo 0 'clear frame first ClearFrame 'enable the management box and the ship box fraUpgrade.Enabled = True cmdOK.Enabled = True hsbQuantity.Enabled = False txtTotal.Text = "" fraLanding.Enabled = True fraTactical.Enabled = True 'show what planet is active, set it to active ActivePlanet = Index cmdPlanetName.Caption = Planet(Index).Name '********turn on buttons as available: 'launch button enabled if at least one ship available If Player(Current).Ship(0).Launched And Player(Current).Ship(1).Launched Then cmdLaunch.Enabled = False Else cmdLaunch.Enabled = True End If 'scanner button enabled if planet has a scanner If Planet(Index).HaveScanner Then cmdScan.Enabled = True ElseIf Planet(Index).HaveScanner = False Then cmdScan.Enabled = False End If 'RepairIndustry button enabled if planet is damaged If Planet(Index).Damaged Then cmdRepairIndustry.Enabled = True End If 'Biohazard button enabled if tech researched If Player(Current).BioRocketResearched Then cmdLaunchBioRocket.Enabled = True End If 'regenerate button enabled if tech researched and if needed If Player(Current).RegenerationResearched And Planet(Index).NukedResources Then cmdRegenerate.Enabled = True End If 'detoxify button enabled if tech researched and if needed If Player(Current).BioCleanupResearched And Planet(Index).Contaminated Then cmdCleanup.Enabled = True End If Else 'planet not owned by current player PlaySoundEffect "Access" MsgBox "Hey! Not your planet", vbOKOnly + vbExclamation, "Access Denied" 'disable mgmt frame, erase circles, set rtl to false ClearFrame 'should only erase circles if part of a landing scenario... If ReadyToLand1 = True Or ReadyToLand2 = True Then EraseCircles ReadyToLand1 = False ReadyToLand2 = False End If 'clear the board of any inrange scanner settings Dim z As Integer For z = 0 To 49 Planet(z).InScannerRange = False Next z Dim Count For Count = 0 To 49 If Planet(Count).LaunchSite = True Then EraseLines End If Next Count cmdPreviewShip1.Enabled = True cmdPreviewShip2.Enabled = True cmdPreviewEnemy1.Enabled = True cmdPreviewEnemy2.Enabled = True If Player(Current).Ship(0).Launched Then cmdLandShip1.Enabled = True End If If Player(Current).Ship(1).Launched Then cmdLandShip2.Enabled = True End If End If End Sub Private Sub picPlanet_DblClick(Index As Integer) 'go to planet view screen cmdPlanetName_Click End Sub Private Sub picPlanet_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) 'public const neutral and alien in .bas module 'Neutral = 2 'Alien = 3 If ScannerOn Then 'show full stats if in range If Planet(Index).Owner = Current Then txtStatus.ForeColor = vbYellow 'show full stats txtStatus.Text = Planet(Index).Name & ": Resources:" & Planet(Index).Resources & " Troops:" & Planet(Index).Troops _ & " Mechs: " & Planet(Index).AssaultTroops & _ " CS:" & Planet(Index).CombatStrength ElseIf Planet(Index).Owner = Neutral Then 'show basic stats in green txtStatus.ForeColor = vbGreen txtStatus.Text = Planet(Index).Name & ": Resources:" & Planet(Index).Resources ElseIf Planet(Index).Owner = Alien And Planet(Index).InScannerRange Then 'show full stats in blue txtStatus.ForeColor = vbBlue txtStatus.Text = Planet(Index).Name & ": Resources:" & Planet(Index).Resources & " Troops:" & Planet(Index).Troops _ & " Mechs:" & Planet(Index).AssaultTroops & _ " CS:" & Planet(Index).CombatStrength ElseIf Planet(Index).Owner = Other And Planet(Index).InScannerRange Then 'show full stats in red txtStatus.ForeColor = vbRed txtStatus.Text = Planet(Index).Name & ": Resources:" & Planet(Index).Resources & " Troops:" & Planet(Index).Troops _ & " Mechs:" & Planet(Index).AssaultTroops & _ " CS:" & Planet(Index).CombatStrength ElseIf Planet(Index).Owner = Alien Then 'show basic stats in blue txtStatus.ForeColor = vbBlue txtStatus.Text = Planet(Index).Name & ": Resources:" & Planet(Index).Resources ElseIf Planet(Index).Owner = Other Then 'show basic stats in red txtStatus.ForeColor = vbRed txtStatus.Text = Planet(Index).Name & ": Resources:" & Planet(Index).Resources End If ElseIf ScannerOn = False Then 'full stats for owned planets, basic for everything else Select Case Planet(Index).Owner Case Current txtStatus.ForeColor = vbYellow 'show full stats txtStatus.Text = Planet(Index).Name & ": Resources:" & Planet(Index).Resources & " Troops:" & Planet(Index).Troops _ & " Mechs:" & Planet(Index).AssaultTroops & _ " CS:" & Planet(Index).CombatStrength Case Neutral 'show basic stats in green txtStatus.ForeColor = vbGreen txtStatus.Text = Planet(Index).Name & ": Resources:" & Planet(Index).Resources Case Alien 'show full stats in blue txtStatus.ForeColor = vbBlue txtStatus.Text = Planet(Index).Name & ": Resources:" & Planet(Index).Resources Case Other 'show full stats in red txtStatus.ForeColor = vbRed txtStatus.Text = Planet(Index).Name & ": Resources:" & Planet(Index).Resources End Select End If End Sub Private Sub picUpgrade_DblClick(Index As Integer) 'turn off scanner if it's on If ScannerOn Then cmdScan_Click ScannerOn = False End If 'start buying procedure 'see what is being bought/researched txtStatus.ForeColor = vbGreen Select Case Index Case 0 'missile defences for planet 'fixed price of 10/planet '***moving Unitcost into the 'if tech researched' part 'UnitCost = 10 'exit sub if planet already has missiles If Planet(ActivePlanet).HaveMissiles Then PlaySoundEffect "Quiet" MsgBox "This planet is already equipped with missiles", vbInformation, "Transaction Cancelled" Exit Sub End If 'check if technology researched If Player(Current).Missile1Researched Then 'check if enough money! UnitCost = 10 If Player(Current).NumResources >= UnitCost Then 'first, enable the scrollbar hsbQuantity.Enabled = True hsbQuantity.Value = 0 lblItemName = "Missile Defences" lblQuantity = Str(hsbQuantity.Value) txtTotal.Text = Str(hsbQuantity.Value) 'get max value for scroll bar hsbQuantity.Max = 1 Else PlaySoundEffect "Quiet" MsgBox "Insufficient resources", vbExclamation, "Transaction Denied" End If Else PlaySoundEffect "Quiet" MsgBox "You do not have this technology", vbExclamation, "Access Denied" End If Case 1 'Planetary shield - fixed cost/planet '****testing moving this into 'if tech researched' 'UnitCost = 15 'exit sub if planet already has a shield If Planet(ActivePlanet).HaveShields Then PlaySoundEffect "Quiet" MsgBox "This planet is already protected by a planetary shield", vbInformation, "Transaction Cancelled" Exit Sub End If If Player(Current).ShieldResearched Then 'check if enough money! UnitCost = 15 If Player(Current).NumResources >= UnitCost Then 'enable the scrollbar hsbQuantity.Enabled = True hsbQuantity.Value = 0 lblItemName = "Planetary Shield" lblQuantity = Str(hsbQuantity.Value) txtTotal.Text = Str(hsbQuantity.Value) 'get max value for scroll bar hsbQuantity.Max = 1 Else PlaySoundEffect "Quiet" MsgBox "Insufficient resources", vbExclamation, "Transaction Denied" End If Else PlaySoundEffect "Quiet" MsgBox "You do not have this technology", vbExclamation, "Access Denied" End If Case 2 'improved resource production - fixed cost/planet 'unitcost moved into 'if tech researched' part 'UnitCost = 15 'check for resources already high enough - ie 5 If Planet(ActivePlanet).ImprovedResources Or Planet(ActivePlanet).Resources > 5 Then PlaySoundEffect "Quiet" MsgBox "This planet has already maximized its production capacity", vbInformation, "Transaction Cancelled" Exit Sub End If 'check if player has researched this item If Player(Current).ResourcesResearched Then 'check if enough money! UnitCost = 15 If Player(Current).NumResources >= UnitCost Then 'first, enable the scrollbar hsbQuantity.Enabled = True hsbQuantity.Value = 0 lblItemName = "Improved Resource Production" lblQuantity = Str(hsbQuantity.Value) txtTotal.Text = Str(hsbQuantity.Value) 'get max value for scroll bar hsbQuantity.Max = 1 Else PlaySoundEffect "Quiet" MsgBox "Insufficient resources", vbExclamation, "Transaction Denied" End If Else PlaySoundEffect "Quiet" MsgBox "You do not have this technology", vbExclamation, "Access Denied" End If Case 3 'regular troops UnitCost = 1 'check if enough money! If Player(Current).NumResources >= UnitCost Then 'first, enable the scrollbar hsbQuantity.Enabled = True hsbQuantity.Value = 0 lblItemName = "Troops" lblQuantity = Str(hsbQuantity.Value) txtTotal.Text = Str(hsbQuantity.Value) 'get max value for scroll bar hsbQuantity.Max = Int(Player(Current).NumResources / UnitCost) Else PlaySoundEffect "Quiet" MsgBox "Insufficient resources", vbExclamation, "Transaction Denied" End If Case 4 'buying assault troops 'UnitCost = 4 'check if player has researched this item If Player(Current).MechResearched Then UnitCost = 4 'check if enough money If Player(Current).NumResources >= UnitCost Then 'enable the scrollbar hsbQuantity.Enabled = True hsbQuantity.Value = 0 lblItemName = "Assault Mechs" lblQuantity = Str(hsbQuantity.Value) txtTotal.Text = Str(hsbQuantity.Value) 'get max value for scroll bar hsbQuantity.Max = Int(Player(Current).NumResources / UnitCost) Else PlaySoundEffect "Quiet" MsgBox "Insufficient resources", vbExclamation, "Transaction Denied" End If Else PlaySoundEffect "Quiet" MsgBox "You do not have this technology", vbExclamation, "Access Denied" End If Case 5 'here is where I load a tech research form 'with buttons for assault troops, ship tech, resource tech, and planet defenses frmResearch.Show Modal Case 6 'scanners 'UnitCost = 25 'exit sub if planet already has a shield If Planet(ActivePlanet).HaveScanner Then PlaySoundEffect "Quiet" MsgBox "This planet already has a scanner", vbInformation, "Transaction Cancelled" Exit Sub End If If Player(Current).ScannerResearched Then UnitCost = 25 'check if enough money! If Player(Current).NumResources >= UnitCost Then 'enable the scrollbar hsbQuantity.Enabled = True hsbQuantity.Value = 0 lblItemName = "Scanner" lblQuantity = Str(hsbQuantity.Value) txtTotal.Text = Str(hsbQuantity.Value) 'get max value for scroll bar hsbQuantity.Max = 1 Else PlaySoundEffect "Quiet" MsgBox "Insufficient resources", vbExclamation, "Transaction Denied" End If Else PlaySoundEffect "Quiet" MsgBox "You do not have this technology", vbExclamation, "Access Denied" End If Case 7 'jammers 'UnitCost = 15 'exit sub if planet already has a shield If Planet(ActivePlanet).HaveJammer Then PlaySoundEffect "Quiet" MsgBox "This planet already has a jamming device", vbInformation, "Transaction Cancelled" Exit Sub End If If Player(Current).JammerResearched Then 'check if enough money! UnitCost = 15 If Player(Current).NumResources >= UnitCost Then 'enable the scrollbar hsbQuantity.Enabled = True hsbQuantity.Value = 0 lblItemName = "Scanner Jamming Device" lblQuantity = Str(hsbQuantity.Value) txtTotal.Text = Str(hsbQuantity.Value) 'get max value for scroll bar hsbQuantity.Max = 1 Else PlaySoundEffect "Quiet" MsgBox "Insufficient resources", vbExclamation, "Transaction Denied" End If Else PlaySoundEffect "Quiet" MsgBox "You do not have this technology", vbExclamation, "Access Denied" End If End Select End Sub Private Sub picUpgrade_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) txtStatus.ForeColor = vbGreen 'show text describing each of the upgrade icons Select Case Index Case 0 txtStatus.Text = "Planetary Missile Defences" Case 1 txtStatus.Text = "Planetary Shield Defenses" Case 2 txtStatus.Text = "Improved Resource Production Facility" Case 3 txtStatus.Text = "Recruit Troops" Case 4 txtStatus.Text = "Recruit Assault Troops" Case 5 txtStatus.Text = "Research Advanced Technologies" Case 6 txtStatus.Text = "Space Scanner" Case 7 txtStatus.Text = "Anti-Scanning Jammer" End Select End Sub Private Sub tmrRandomSounds_Timer() 'play random sound effect PlayRandomSound End Sub Private Sub tmrUpdateMessageBox_Timer() txtMessages.Text = "No New Messages..." tmrUpdateMessageBox.Enabled = False End Sub Private Sub txtMessages_KeyDown(KeyCode As Integer, Shift As Integer) KeyCode = 0 End Sub Private Sub txtMessages_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub txtMessages_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) txtStatus.Text = "View or Send Messages" End Sub Private Sub txtNumAssaultTroops_KeyDown(KeyCode As Integer, Shift As Integer) KeyCode = 0 End Sub Private Sub txtNumAssaultTroops_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub txtNumPlanets_KeyDown(KeyCode As Integer, Shift As Integer) KeyCode = 0 End Sub Private Sub txtNumPlanets_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub txtNumResources_KeyDown(KeyCode As Integer, Shift As Integer) KeyCode = 0 End Sub Private Sub txtNumResources_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub txtNumTroops_KeyDown(KeyCode As Integer, Shift As Integer) KeyCode = 0 End Sub Private Sub txtNumTroops_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub txtPlayerName_KeyDown(KeyCode As Integer, Shift As Integer) KeyCode = 0 End Sub Private Sub txtPlayerName_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub txtPlayerName_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) txtStatus.Text = "" End Sub Private Sub txtProduction_KeyDown(KeyCode As Integer, Shift As Integer) KeyCode = 0 End Sub Private Sub txtProduction_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub txtStatus_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub txtStatus_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) txtStatus.Text = "" End Sub Public Sub DrawGalaxy() Randomize 'Called by the form_Activate procedure 'draw white stars on the playing field Dim a, X, Y For a = 1 To 700 X = Int(Rnd * picGalaxy.ScaleWidth) Y = Int(Rnd * picGalaxy.ScaleHeight) picGalaxy.PSet (X, Y) Next a 'draw darker stars for depth Dim grey grey = &H808080 For a = 1 To 1000 X = Int(Rnd * picGalaxy.ScaleWidth) Y = Int(Rnd * picGalaxy.ScaleHeight) picGalaxy.PSet (X, Y), grey Next a 'drawing grid lines moved to its own proc End Sub Private Sub txtTurnNumber_KeyDown(KeyCode As Integer, Shift As Integer) KeyCode = 0 End Sub Private Sub txtTurnNumber_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Public Sub UpdatePlayerStats() 'fill in values for player stats box txtNumPlanets.Text = Str(Player(Current).NumPlanets) txtNumTroops.Text = Str(Player(Current).NumTroops) txtNumResources.Text = Str(Player(Current).NumResources) txtNumAssaultTroops.Text = Str(Player(Current).NumAssaultTroops) 'redo resources/turn box Dim h, i i = 0 For h = 0 To 49 If Planet(h).Owner = Current Then i = i + Planet(h).Resources End If Next h txtProduction.Text = Str(i) End Sub Public Sub Personalize() 'set caption and player name to current player If Current = 0 Then frmGameScreen.Caption = " 4000 A.D. (Player 1) " ElseIf Current = 1 Then frmGameScreen.Caption = " 4000 A.D. (Player 2) " End If If Player(1).Name = "" Then Player(1).Name = "?" End If frmGameScreen.Caption = frmGameScreen.Caption + " " + Player(0).Name + " vs. " + Player(1).Name If Player(1).Name = "?" Then Player(1).Name = "" End If 'set the current player's name in the name box txtPlayerName.Text = Player(Current).Name End Sub Public Sub UpdateResources() 'at start of each turn, add up resources 'current plus resources of each owned planet Dim i For i = 0 To 49 If Planet(i).Owner = Current Then Player(Current).NumResources = Player(Current).NumResources + Planet(i).Resources End If Next i End Sub Public Sub UpdateNumPlanets() 'at start of each turn - and after getting new planets, 'and after battles, add up number of planets owned 'and total troops/assault troops 'first, set numplanet to zero to avoid recounting Player(Current).NumPlanets = 0 Player(Current).NumTroops = 0 Player(Current).NumAssaultTroops = 0 Dim i For i = 0 To 49 If Planet(i).Owner = Current Then Player(Current).NumPlanets = Player(Current).NumPlanets + 1 Player(Current).NumTroops = Player(Current).NumTroops + Planet(i).Troops Player(Current).NumAssaultTroops = Player(Current).NumAssaultTroops + Planet(i).AssaultTroops End If Next i End Sub Public Sub ReInitializeShip(activeship As Integer) 'set all the values to zero, not launched, etc 'using ActiveShip as the indicator With Player(Current).Ship(activeship) .Launched = False .Troops = 0 .AssaultTroops = 0 .CombatStrength = 0 .HaveShields = False .HaveWeapons = False .HaveCloakingDevice = False .Sabotage = False .WarpPosition = 0 .Coordinate = "" .CenterX = 0 .CenterY = 0 End With End Sub Public Sub ReInitializePlanet(Index As Integer) 'add the players stuff to the planet Planet(Index).Troops = Player(Current).Ship(activeship).Troops Planet(Index).AssaultTroops = Player(Current).Ship(activeship).AssaultTroops End Sub Public Sub EraseCircles() 'redraw the circles to erase them '***Only erases yellow circles!!! Dim xpos, ypos, radius Dim z For z = 0 To 49 If Planet(z).InRange And picPlanet(z).Visible Then 'find center of the picturebox and draw circle xpos = picPlanet(z).Left + (picPlanet(z).Width / 2) ypos = picPlanet(z).Top + (picPlanet(z).Height / 2) radius = (picPlanet(z).Width / 2) + 45 'set drawmode picGalaxy.DrawMode = 7 picGalaxy.DrawWidth = 1 picGalaxy.Circle (xpos, ypos), radius, vbYellow End If Next z 'reset the inrange value to false to prevent screwy drawing For z = 0 To 49 Planet(z).InRange = False Next z 'set the readytoland value to false to prevent screwy drawing... ReadyToLand1 = False ReadyToLand2 = False End Sub Private Sub txtTurnNumber_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) txtStatus.Text = " " End Sub Public Sub ClearFrame() 'clear up the management frame - set everything to zero etc. 'reset the scroll bar and labels hsbQuantity.Enabled = False lblItemName.Caption = "" lblQuantity.Caption = "" txtTotal.Text = "" 'reset the purchase price to zero '**this is used to initialize txtTotal.text PurchasePrice = 0 'disable the management and ship frames again cmdPlanetName.Caption = "" fraUpgrade.Enabled = False cmdOK.Enabled = False 'turn off scanner If ScannerOn Then cmdScan_Click ScannerOn = False cmdScan.Enabled = False End If If RegenerateOn Then RegenerateOn = False cmdRegenerate.Enabled = False End If If BioRocketOn Then BioRocketOn = False End If 'turn off all the buttons cmdRepairIndustry.Enabled = False cmdLaunchBioRocket.Enabled = False cmdRegenerate.Enabled = False cmdCleanup.Enabled = False 'deal with landing buttons - conflict with scanner button If ReadyToLand1 Then cmdLandShip1_Click End If If ReadyToLand2 Then cmdLandShip2_Click End If End Sub Public Sub CheckForAliens() 'see if weak planet is attacked by aliens Dim ChanceOfInvasion Dim Result As Integer Dim X As Integer Dim PlanetCS As Integer Dim AlienCS As Integer '***************** '**Experimented with increasing minimums as game went on, '**but decided it would affect play balance too much 'Dim MinTroops As Integer 'threshold # for invasion test 'Dim MinMechs As Integer 'calculate the strength of planet that is weak enough for invasion 'MinTroops = Int(Rnd * (TurnNumber / 5)) + 2 'MinMechs = Int(Rnd * (TurnNumber / 8)) + 1 '****************** Randomize For X = 0 To 49 If Planet(X).Owner = Current Then If Planet(X).Troops < 4 And Planet(X).AssaultTroops < 2 Then '5-15% chance ChanceOfInvasion = Int(Rnd * 10) + 5 Result = Int(Rnd * 100) + 1 If Result <= ChanceOfInvasion Then 'planet attacked 'compare combatstrengths '***Alien strength builds with turn number! AlienCS = Int(Rnd * 10) + Int(TurnNumber / 3) If AlienCS > Planet(X).CombatStrength Then 'Aliens Win With Planet(X) .Owner = Alien .Troops = AlienCS - Planet(X).CombatStrength .Resources = Int(Rnd * 6) + 1 End With SetCombatStrength (X) 'MsgBox Planet(X).Name + " Overrun By The Melnikons!", vbOKOnly + vbExclamation, "Alien Invasion!" '****** 'Set various messages for overrun Dim alternate1 As String Dim alternate2 As String Dim alternate3 As String Dim alternate4 As String Dim choice As Integer Randomize choice = Int(Rnd * 4) + 1 alternate1 = "Defenses Breached...Casualties Mounting..." alternate2 = "Security Perimeter Down...Shields Failed" alternate3 = "Warning Systems Sabotaged...Need Help!..." alternate4 = "They're Everywhere! If we can just--" MessageType = "Overrun" Announceline1 = "Melnikon Invasion Reported On " + Planet(X).Name + "!" Select Case choice Case 1 Announceline2 = alternate1 Case 2 Announceline2 = alternate2 Case 3 Announceline2 = alternate3 Case 4 Announceline2 = alternate4 End Select Announceline3 = "<End Of Transmission>" frmAnnounce.Show Modal ElseIf AlienCS <= Planet(X).CombatStrength Then 'Player Wins Dim Msg As String Msg = "Melnikon Invasion Force Destroyed!" AlienCS = Int(AlienCS / 2) 'lose troops if any If Planet(X).Troops > 0 Then Planet(X).Troops = Planet(X).Troops - AlienCS If Planet(X).Troops < 0 Then Planet(X).Troops = 0 End If End If 'lose some mechs if any If Planet(X).AssaultTroops > 0 Then Planet(X).AssaultTroops = Planet(X).AssaultTroops - Int(AlienCS / 2) If Planet(X).AssaultTroops < 0 Then Planet(X).AssaultTroops = 0 End If End If SetCombatStrength (X) MessageType = "Victorious" Announceline1 = "Melnikon Invasion of " + Planet(X).Name + " Defeated!" If Planet(X).Owner = Current Then Announceline2 = "Troop Losses:" + Str(AlienCS) Announceline3 = "Mech Losses:" + Str(Int(AlienCS / 2)) Else Announceline2 = "" Announceline3 = "" End If frmAnnounce.Show Modal 'MsgBox Msg, vbOKOnly + vbExclamation, "Report From " + Planet(X).Name 'Debug.Print "AlienCS/2:" + Str(AlienCS) End If End If End If End If Next X End Sub Public Sub AttackAliens(Index As Integer) 'attack procedure when landing on alien planets Dim RandomLosses Dim a, b 'set random number generator Randomize 'set placeholder for current player's combat strength AttackStrength = Player(Current).Ship(activeship).CombatStrength DefenceStrength = Planet(Index).CombatStrength a = Player(Current).Ship(activeship).Troops b = Player(Current).Ship(activeship).AssaultTroops 'set placeholders for troops on the planet Dim c, d c = Planet(Index).Troops d = Planet(Index).AssaultTroops PlaySoundEffect "Attack" 'MsgBox "Attack!", , " " 'compare the strengths If AttackStrength > DefenceStrength Then 'ATTACKER WINS 'don't allow player to launch from this planet this turn Planet(Index).JustLanded = True If a > 0 And DefenceStrength > 0 Then 'winner loses 10-50% of troops RandomLosses = Int(Rnd * 4) + 1 RandomLosses = RandomLosses / 10 a = a - (a * RandomLosses) TroopLosses = RandomLosses * 100 End If If b > 0 And DefenceStrength > 0 Then 'winner loses 10-30% of assault troops RandomLosses = Int(Rnd * 3) + 1 RandomLosses = RandomLosses / 10 b = b - (b * RandomLosses) AssaultLosses = RandomLosses * 100 End If 'planet troops, combatstrength changes Planet(Index).Troops = a Planet(Index).AssaultTroops = b 'set this variable for frmlandscape: ActivePlanet = Index 'show the results of the battle frmLandscape.Show Modal 'planet changes owners Planet(Index).Owner = Current 'set planet's combat strength SetCombatStrength (Index) 'update player: resources, numplanets UpdateNumPlanets UpdatePlayerStats 'clear the management frame ClearFrame cmdPreviewShip1.Enabled = True cmdPreviewShip2.Enabled = True cmdPreviewEnemy1.Enabled = True cmdPreviewEnemy2.Enabled = True '************************************ ElseIf AttackStrength <= Planet(Index).CombatStrength Then 'defender wins, and tie goes to the defender 'current player loses all troops Player(Current).NumTroops = Player(Current).NumTroops - a Player(Current).NumAssaultTroops = Player(Current).NumAssaultTroops - b If Planet(Index).Troops > 0 Then 'winner loses 10-50% of troops RandomLosses = Int(Rnd * 4) + 1 RandomLosses = RandomLosses / 10 c = c - (c * RandomLosses) TroopLosses = RandomLosses * 100 Planet(Index).Troops = c End If If Planet(Index).AssaultTroops > 0 Then 'winner loses 10-40% of assault troops RandomLosses = Int(Rnd * 4) + 1 RandomLosses = RandomLosses / 10 d = d - (d * RandomLosses) AssaultLosses = RandomLosses * 100 Planet(Index).AssaultTroops = d End If 'update planet's combat strength SetCombatStrength (Index) UpdateNumPlanets UpdatePlayerStats 'clear management frame ClearFrame cmdPreviewShip1.Enabled = True cmdPreviewShip2.Enabled = True cmdPreviewEnemy1.Enabled = True cmdPreviewEnemy2.Enabled = True 'set this variable for frmlandscape: ActivePlanet = Index 'show the results of the battle frmLandscape.Show Modal End If 'disable the landing button and remove from warp path If activeship = 0 Then cmdLandShip1.Enabled = False 'get rid of the ship picture picPlayerPath(Player(Current).Ship(activeship).WarpPosition - 1).Picture = LoadPicture() ElseIf activeship = 1 Then cmdLandShip2.Enabled = False 'get rid of the ship picture picPlayerPath(Player(Current).Ship(activeship).WarpPosition - 1).Picture = LoadPicture() End If 'set ship values to unlaunched and empty ReInitializeShip (activeship) RefreshWarpPath End Sub Public Sub SabotageLanding(Index As Integer, activeship As Integer) 'determine results of sabotage mission Dim CurrentPlayer, Enemy CurrentPlayer = Current Enemy = Other Select Case Planet(Index).Owner Case CurrentPlayer 'do nothing, mission wasted by landing on player's own planet PlaySoundEffect "Quiet" MsgBox "Mission aborted", vbOKOnly, " " Case Enemy Dim Success As Integer Dim Result As Integer Success = 95 'success varies with number of troops, mechs and technology on planet Select Case Planet(Index).Troops Case 0 To 5 Success = Success - 1 Case 6 To 10 Success = Success - 2 Case 11 To 15 Success = Success - 4 Case Else Success = Success - 6 End Select 'mechs Select Case Planet(Index).AssaultTroops Case 0 To 1 Success = Success - 1 Case 2 To 5 Success = Success - 3 Case Else Success = Success - 5 End Select 'missiles If Planet(Index).HaveMissiles Then 'check what level of missiles other player has researched If Player(Other).Missile2Researched Then Success = Success - 4 Else Success = Success - 2 End If End If If Planet(Index).HaveShields Then Success = Success - 3 End If If Planet(Index).HaveScanner Then Success = Success - 5 End If Result = Int(Rnd * 100) Debug.Print "Result: ", Result, " Success: ", Success If Result <= Success Then 'mission successful Dim Damage As Integer Dim Reduction Dim FactoryFlag As Boolean Dim msg1 As String Dim msg2 As String msg1 = "Advanced production facilities destroyed!" msg2 = "Planet's resource production eliminated!" Damage = Int(Rnd * 4) + 2 '2-6 damage If Planet(Index).ImprovedResources Then 'factory destroyed Planet(Index).ImprovedResources = False FactoryFlag = True 'tell other player his factory destroyed Planet(Index).SabotagedFactory = True End If 'Fixes divide by zero error!! If Planet(Index).Resources < 1 Then Reduction = -1 'NOTE: if the same planet is sabotaged twice in 1 turn 'there may not be a message to the other player if the 'first sabotage reduced resources to zero Else Reduction = Damage / Planet(Index).Resources Reduction = Int(Reduction * 100) End If Planet(Index).Resources = Planet(Index).Resources - Damage If Planet(Index).Resources < 0 Then Planet(Index).Resources = 0 End If If Planet(Index).Resources > 0 And FactoryFlag Then PlaySoundEffect "Quiet" MsgBox "Mission accomplished!" + Chr(13) + msg1 + Chr(13) + "Resource production reduced by " + Str(Reduction) + "%", vbOKOnly, "Sabotage Mission Results" ElseIf Planet(Index).Resources > 0 And Not FactoryFlag Then PlaySoundEffect "Quiet" MsgBox "Resource production on " + Planet(Index).Name + " crippled!" + Chr(13) + "Resource production reduced by" + Str(Reduction) + "%", vbOKOnly, "Sabotage Mission Results" ElseIf Planet(Index).Resources <= 0 Then PlaySoundEffect "Quiet" MsgBox msg2, , "Sabotage Mission Results" End If '***should set flag to give other player message at startup Planet(Index).Sabotaged = True Planet(Index).SabotageReduction = Reduction 'set flag to enable cmdRepairIndustry Planet(Index).Damaged = True ElseIf Result > Success Then 'MISSION FAILED PlaySoundEffect "Quiet" MsgBox "Mission failed - ship destroyed in orbit around " + Planet(Index).Name, vbOKOnly, "Sabotage Mission Results" 'set flag to tell other player next turn Planet(Index).Sabotaged = True Planet(Index).SabotageReduction = 0 'this will show that mission failed, show different message Planet(Index).SabotagedFactory = False 'factory not destroyed End If Case Neutral 'do nothing PlaySoundEffect "Quiet" MsgBox "Mission failed - neutral planet", vbOKOnly, "Sabotage Mission Results" Case Alien 'reduce resources to 0 Planet(Index).Resources = 0 PlaySoundEffect "Quiet" MsgBox "Alien resource production facilities destroyed", vbOKOnly + vbExclamation, "Sabotage Mission Results" End Select EraseShip: 'disable the landing button and remove from warp path If activeship = 0 Then cmdLandShip1.Enabled = False 'get rid of the ship picture picPlayerPath(Player(Current).Ship(activeship).WarpPosition - 1).Picture = LoadPicture() End If If activeship = 1 Then cmdLandShip2.Enabled = False 'get rid of the ship picture picPlayerPath(Player(Current).Ship(activeship).WarpPosition - 1).Picture = LoadPicture() End If 'set ship values to unlaunched and empty ReInitializeShip (activeship) RefreshWarpPath End Sub Public Sub BioDamage(X As Integer) 'this happens every turn on contaminated planets Randomize If Planet(X).Troops = 0 Or Planet(X).BioRocketETA = TurnNumber Then Exit Sub End If If Planet(X).Troops <= 2 Then Planet(X).Troops = Planet(X).Troops - 1 If Planet(X).Troops <= 0 Then PlaySoundEffect "Quiet" MsgBox "Contamination warning: all troops dead.", vbOKOnly + vbExclamation, "Report From: " + Planet(X).Name Planet(X).Troops = 0 Exit Sub End If 'don't show msgbox if it's the same turn the rocket hits If Planet(X).BioRocketETA = TurnNumber Then 'do nothing Else PlaySoundEffect "Warning" MsgBox "Contamination warning: 1 troop dead.", vbOKOnly + vbExclamation, "Report From: " + Planet(X).Name End If ElseIf Planet(X).Troops > 2 Then Dim Damage As Integer Dim Dead As Integer 'kill of 25-50% of troops Damage = Int(Rnd * 25) + 25 'Damage = Damage / 100 Dead = Int(Planet(X).Troops * Damage) Dead = Int(Dead / 100) 'should be at least 1 dead per turn If Dead < 1 Then Dead = 1 End If Planet(X).Troops = Planet(X).Troops - Dead Dim msg1 As String If Dead = 1 Then msg1 = " troop dead." Else msg1 = " troops dead." End If If Planet(X).BioRocketETA = TurnNumber Then 'do nothing Else PlaySoundEffect "Warning" MsgBox "Contamination warning: " + Str(Dead) + msg1, vbOKOnly + vbExclamation, "Report From: " + Planet(X).Name End If End If End Sub Public Sub EraseLines() 'redraw the lines to erase them Dim x1, y1 Dim z As Integer For z = 0 To 49 If Planet(z).LaunchSite Then x1 = picPlanet(z).Left + (picPlanet(z).Width / 2) y1 = picPlanet(z).Top + (picPlanet(z).Height / 2) Exit For End If Next z Dim X2, Y2 For z = 0 To 49 If Planet(z).InBioRange Then 'find center of the picturebox and draw line X2 = picPlanet(z).Left + (picPlanet(z).Width / 2) Y2 = picPlanet(z).Top + (picPlanet(z).Height / 2) 'set drawmode picGalaxy.DrawMode = 7 picGalaxy.DrawWidth = 2 picGalaxy.Line (x1, y1)-(X2, Y2), vbMagenta End If Next z 'reset the inbiorange value to false to prevent screwy drawing For z = 0 To 49 Planet(z).InBioRange = False Next z 'reset the launchsite to false For z = 0 To 49 If Planet(z).LaunchSite Then Planet(z).LaunchSite = False Exit For End If Next z 'reset biorocketon to false BioRocketOn = False End Sub Public Sub TargetBioRocket(Index As Integer) 'let player know how long it will take for biorocket to reach target Dim ETA As Integer Dim RocketCost As Integer RocketCost = 30 'final cost check If BioRocketOn Then 'continue with sub ETA = Int(Planet(Index).BioDistance / 300) Planet(Index).BioRocketETA = TurnNumber + ETA If SoundOn Then 'select which turn# sound file to play Select Case ETA Case 1 Sound = App.Path + "\1turn.wav" sndPlaySound Sound, 3 Case 2 Sound = App.Path + "\2turns.wav" sndPlaySound Sound, 3 Case 3 Sound = App.Path + "\3turns.wav" sndPlaySound Sound, 3 Case 4 Sound = App.Path + "\4turns.wav" sndPlaySound Sound, 3 Case 5 Sound = App.Path + "\5turns.wav" sndPlaySound Sound, 3 Case 6 Sound = App.Path + "\6turns.wav" sndPlaySound Sound, 3 Case 7 Sound = App.Path + "\7turns.wav" sndPlaySound Sound, 3 End Select End If PlaySoundEffect "Button3" MsgBox "Planet " + Planet(Index).Name + " targeted." + Chr(13) + Chr(13) + "BioHazard Rocket ETA:" + Str(ETA) + " Turns.", , " " 'deduct funds Player(Current).NumResources = Player(Current).NumResources - RocketCost UpdatePlayerStats 'erase lines and reset launchsite to false EraseLines 'clear frame ClearFrame Exit Sub End If End Sub Public Sub WriteBigFile() 'save all the general info - message to other player... Dim Filename As String Dim ShortName As String ShortName = "\gameinfo.txt" Filename = App.Path & ShortName 'get a free file number gFileNum = FreeFile 'create the file Open Filename For Output As gFileNum 'write galaxysize Write #gFileNum, GalaxySize 'write the planet data Dim i For i = 0 To 49 Write #gFileNum, Planet(i).Name, Planet(i).Owner, Planet(i).Troops, _ Planet(i).AssaultTroops, Planet(i).CombatStrength, Planet(i).Coordinate, _ Planet(i).Resources, Planet(i).HaveMissiles, Planet(i).HaveShields, _ Planet(i).ImprovedResources, Planet(i).HaveScanner, Planet(i).BackGround, _ Planet(i).HaveJammer, Planet(i).BioRocketETA, Planet(i).Contaminated, Planet(i).NukedResources, _ Planet(i).Sabotaged, Planet(i).SabotageReduction, Planet(i).SabotagedFactory, Planet(i).Damaged, _ Planet(i).BioFailed 'write the player data For i = 0 To 1 Write #gFileNum, Current, TurnNumber, Player(i).Name, Player(i).NumTroops, Player(i).NumAssaultTroops, Player(i).NumPlanets, Player(i).NumResources, _ Player(i).HomePlanet, Player(i).Message1Given, Player(i).Message2Given, Player(i).WasBig, Player(i).Missile1ResearchDone, Player(i).Missile1Researched, _ Player(i).Missile2ResearchDone, Player(i).Missile2Researched, Player(i).ShieldResearchDone, Player(i).ShieldResearched, _ Player(i).LaserResearchDone, Player(i).LaserResearched, Player(i).PlasmaResearchDone, Player(i).PlasmaResearched, Player(i).MechResearchDone, Player(i).MechResearched, _ Player(i).BioRocketResearchDone, Player(i).BioRocketResearched, Player(i).LongBioResearchDone, Player(i).LongBioResearched, Player(i).ShipShield1ResearchDone, Player(i).ShipShield1Researched, _ Player(i).ShipShield2ResearchDone, Player(i).ShipShield2Researched, Player(i).BigShipResearchDone, Player(i).BigShipResearched, Player(i).UltraWarpResearchDone, Player(i).UltraWarpResearched, _ Player(i).CloakingResearchDone, Player(i).CloakingResearched, Player(i).ResourceResearchDone, Player(i).ResourcesResearched, Player(i).BioCleanupResearchDone, Player(i).BioCleanupResearched, _ Player(i).RegenerationResearchDone, Player(i).RegenerationResearched, Player(i).ScannerResearchDone, Player(i).ScannerResearched, Player(i).DeepScannerResearchDone, Player(i).DeepScannerResearched, _ Player(i).JammerResearchDone, Player(i).JammerResearched, Player(i).WarpScannerResearchDone, Player(i).WarpScannerResearched 'write the ship data For i = 0 To 1 Write #gFileNum, Player(0).Ship(i).Launched, Player(0).Ship(i).HaveCloakingDevice, _ Player(0).Ship(i).Troops, Player(0).Ship(i).AssaultTroops, _ Player(0).Ship(i).CombatStrength, Player(0).Ship(i).WarpPosition, _ Player(0).Ship(i).Coordinate, Player(0).Ship(i).CenterX, _ Player(0).Ship(i).CenterY, Player(0).Ship(i).ShipNumber, Player(0).Ship(i).Sabotage, _ Player(1).Ship(i).Launched, Player(1).Ship(i).HaveCloakingDevice, _ Player(1).Ship(i).Troops, Player(1).Ship(i).AssaultTroops, _ Player(1).Ship(i).CombatStrength, Player(1).Ship(i).WarpPosition, _ Player(1).Ship(i).Coordinate, Player(1).Ship(i).CenterX, _ Player(1).Ship(i).CenterY, Player(1).Ship(i).ShipNumber, Player(1).Ship(i).Sabotage 'write the general data Write #gFileNum, OutgoingMessage, Player(Current).WasBig 'captured planet data Write #gFileNum, NumPlanetsCaptured For i = 0 To 49 Write #gFileNum, Planet(i).Captured Next i 'failed invasion data Write #gFileNum, NumFailedInvasions For i = 0 To 49 Write #gFileNum, Planet(i).FailedInvasion, Planet(i).FailedInvasionTroopLosses, Planet(i).FailedInvasionMechLosses Next i 'close the file Close gFileNum End Sub Public Sub Detonation(X As Integer) Randomize 'see if rocket hits, or is shot down by planet defenses Dim Success As Integer Dim Result As Integer 'set base chance of success Success = 100 'success varies with technology on planet If Planet(X).HaveMissiles Then If Player(Current).Missile1Researched Then Success = Success - 2 End If If Player(Current).Missile2Researched Then Success = Success - 3 End If End If If Planet(X).HaveShields Then Success = Success - 7 End If If Planet(X).HaveScanner Then Success = Success - 2 End If Result = Int(Rnd * 100) If Result <= Success Then 'rocket hits 'explosion - kills troops and drastically reduces resource production If Planet(X).Owner = Current Then 'duh! 'tally the damage to troops and resources If Planet(X).Troops > 0 Then Randomize Dim Damage As Integer Dim Dead As Integer 'kill of 25-50% of troops Damage = Int(Rnd * 25) + 25 Dead = Int(Planet(X).Troops * Damage) Dead = Int(Dead / 100) 'should be at least 1 killed/turn If Dead < 1 Then Dead = 1 End If Planet(X).Troops = Planet(X).Troops - Dead End If 'resource production hurt bad Dim ProductionDamage '3-8 damage to resources ProductionDamage = Int(Rnd * 5) + 3 Planet(X).Resources = Planet(X).Resources - ProductionDamage If Planet(X).Resources < 0 Then Planet(X).Resources = 0 End If 'reset improved resource production to false, let them build again Planet(X).ImprovedResources = False End If 'end of if planet.owner=current loop 'Announcement screen MessageType = "Explosion" If Planet(X).Owner = Current Then Announceline1 = "A Massive Explosion On " + Planet(X).Name + "!" Announceline2 = "Troop Losses: " + Str(Dead) Announceline3 = "Resource Production Reduced To:" + Str(Planet(X).Resources) Else Announceline1 = "Successful BioRocket Detonation On " + Planet(X).Name + "!" Announceline2 = "" Announceline3 = "" End If frmAnnounce.Show Modal Planet(X).Contaminated = True Planet(X).NukedResources = True 'result > success, therefore the missile didn't detonate! PlaySoundEffect "Quiet" MsgBox "BioRocket destroyed by defensive systems on " + Planet(X).Name + "!" 'Debug.Print "Result:"; Result, "Success:"; Success 'set warning to show other player on their next turn Planet(X).BioFailed = True End If End Sub Public Sub RefreshWarpPath() 'put ships on the warp path with coordinates printed below Dim z 'counter Dim j, k 'hold warp positions - easier to type & read j = Player(Current).Ship(0).WarpPosition k = Player(Current).Ship(1).WarpPosition If Player(Current).Ship(0).Launched And Player(Current).Ship(1).Launched And j = k Then 'both ships on same warp box 'check if in 2nd to last box If j = 7 And Warp7WarningGiven = False Then Dim Msg As String Msg = "Your ships must land next turn. Be advised" + Chr(13) Msg = Msg + "of the risk that no suitable planet will be" + Chr(13) Msg = Msg + "in range before the warp path disintegrates." 'play warning and show message PlaySoundEffect "Disintegrate" MsgBox Msg, vbOKOnly + vbExclamation, "Warp Path Warning" Warp7WarningGiven = True End If 'check if in last warp box If j = 8 And Warp8WarningGiven = False Then PlaySoundEffect "Disintegrate" LostInSpace If NumPlanets1 = 0 Then PlaySoundEffect "Warning" MsgBox "Ship 1 Destroyed", vbCritical, "Warp Path Disintegration" ReInitializeShip (0) End If If NumPlanets2 = 0 Then PlaySoundEffect "Warning" MsgBox "Ship 2 Destroyed", vbCritical, "Warp Path Disintegration" ReInitializeShip (1) End If If NumPlanets1 > 0 And NumPlanets2 > 0 Then PlaySoundEffect "Warning" MsgBox "Your ships must land this turn", vbOKOnly + vbCritical, "Warp Path Disintegrating!" End If Warp8WarningGiven = True 'this is a flag to only show this warning once at the start 'and once at the end of the turn End If picPlayerPath(j - 1).Picture = picTiny.Picture 'set ship 1 coordinate on top left picPlayerPath(j - 1).CurrentX = 0 picPlayerPath(j - 1).CurrentY = 0 picPlayerPath(j - 1).Print Player(Current).Ship(0).Coordinate '***Put an S instead of CS if a sabotage mission If Player(Current).Ship(0).Sabotage Then picPlayerPath(j - 1).CurrentX = 450 picPlayerPath(j - 1).CurrentY = 0 picPlayerPath(j - 1).FontBold = True picPlayerPath(j - 1).Print "S" picPlayerPath(j - 1).FontBold = False Else 'ship 1 CS on top right '***change currentx depending on value of CS If Player(Current).Ship(0).CombatStrength > 99 Then picPlayerPath(j - 1).CurrentX = 300 ElseIf Player(Current).Ship(0).CombatStrength > 9 Then picPlayerPath(j - 1).CurrentX = 360 Else picPlayerPath(j - 1).CurrentX = 440 End If '*** picPlayerPath(j - 1).CurrentY = 0 picPlayerPath(j - 1).Print Player(Current).Ship(0).CombatStrength End If 'set ship 2 coordinate at bottom left corner picPlayerPath(j - 1).CurrentX = 0 picPlayerPath(j - 1).CurrentY = 465 picPlayerPath(j - 1).Print Player(Current).Ship(1).Coordinate '***print S if a sabotage mission If Player(Current).Ship(1).Sabotage Then picPlayerPath(j - 1).CurrentX = 450 picPlayerPath(j - 1).CurrentY = 465 picPlayerPath(j - 1).FontBold = True picPlayerPath(j - 1).Print "S" picPlayerPath(j - 1).FontBold = False Else 'set ship 2 CS at bottom right corner '***change currentx depending on value of CS If Player(Current).Ship(1).CombatStrength > 99 Then picPlayerPath(j - 1).CurrentX = 300 ElseIf Player(Current).Ship(1).CombatStrength > 9 Then picPlayerPath(j - 1).CurrentX = 360 Else picPlayerPath(j - 1).CurrentX = 440 End If '*** picPlayerPath(j - 1).CurrentY = 465 picPlayerPath(j - 1).Print Player(Current).Ship(1).CombatStrength End If 'ships not in same box For z = 0 To 1 If Player(Current).Ship(z).Launched Then j = Player(Current).Ship(z).WarpPosition 'check if in 2nd to last box If j = 7 And Warp7WarningGiven = False Then Dim message As String message = "Your ship must land next turn. Be advised" + Chr(13) message = message + "of the risk that no suitable planet will be" + Chr(13) message = message + "in range before the warp path disintegrates." PlaySoundEffect "Warning" MsgBox message, vbOKOnly + vbExclamation, "Warp Path Warning" Warp7WarningGiven = True End If 'check if in last warp box If j = 8 And Warp8WarningGiven = False Then PlaySoundEffect "Disintegrate" LostInSpace If NumPlanets1 = 0 Then PlaySoundEffect "Warning" MsgBox "Ship 1 Destroyed", vbCritical, "Warp Path Disintegration" ReInitializeShip (0) End If If NumPlanets2 = 0 Then PlaySoundEffect "Warning" MsgBox "Ship 2 Destroyed", vbCritical, "Warp Path Disintegration" ReInitializeShip (1) End If If NumPlanets1 > 0 And NumPlanets2 > 0 Then PlaySoundEffect "Warning" MsgBox "Your ship must land this turn", vbOKOnly + vbCritical, "Warp Path Disintegrating!" End If Warp8WarningGiven = True End If picPlayerPath(j - 1).Picture = picTemp.Picture 'set shipnumber at top right picPlayerPath(j - 1).CurrentX = 435 picPlayerPath(j - 1).CurrentY = 0 picPlayerPath(j - 1).Print Player(Current).Ship(z).ShipNumber + 1 'set coordinate at bottom left corner picPlayerPath(j - 1).CurrentX = 50 picPlayerPath(j - 1).CurrentY = 465 picPlayerPath(j - 1).Print Player(Current).Ship(z).Coordinate 'set cursor at bottom right corner '**print S if sabotage mission If Player(Current).Ship(z).Sabotage Then picPlayerPath(j - 1).CurrentX = 450 picPlayerPath(j - 1).CurrentY = 465 picPlayerPath(j - 1).FontBold = True picPlayerPath(j - 1).Print "S" picPlayerPath(j - 1).FontBold = False Else '***change currentx depending on value of CS If Player(Current).Ship(z).CombatStrength > 99 Then picPlayerPath(j - 1).CurrentX = 300 ElseIf Player(Current).Ship(z).CombatStrength > 9 Then picPlayerPath(j - 1).CurrentX = 360 Else picPlayerPath(j - 1).CurrentX = 440 End If '*** picPlayerPath(j - 1).CurrentY = 465 picPlayerPath(j - 1).Print Player(Current).Ship(z).CombatStrength End If End If Next z End If If Player(Current).Ship(0).Launched Then cmdLandShip1.Enabled = True ElseIf Player(Current).Ship(1).Launched Then cmdLandShip2.Enabled = True End If 'put player number under owned planets Dim Count As Integer For Count = 0 To 49 If Planet(Count).Owner = Current Then picGalaxy.CurrentX = picPlanet(Count).Left + (picPlanet(Count).Width / 2) - 25 picGalaxy.CurrentY = picPlanet(Count).Top + picPlanet(Count).Height + 15 picGalaxy.ForeColor = vbYellow picGalaxy.Print Str(Current + 1) ElseIf Planet(Count).Owner = Other Then picGalaxy.CurrentX = picPlanet(Count).Left + (picPlanet(Count).Width / 2) - 25 picGalaxy.CurrentY = picPlanet(Count).Top + picPlanet(Count).Height + 15 picGalaxy.ForeColor = vbRed picGalaxy.Print Str(Other + 1) End If Next Count End Sub Public Sub UpdateAliens() 'set alien planet troop levels 'increase as game progresses Randomize Dim i For i = 0 To 49 If Planet(i).Owner = Alien Then Planet(i).Troops = Planet(i).Troops + Int(Rnd * (Int(TurnNumber / 4))) + 1 'upper limit of troops tied to resources on planet Dim UpperLimit As Integer UpperLimit = Planet(i).Resources * 25 If Planet(i).Troops > UpperLimit Then 'vary amount +/- 5 troops Planet(i).Troops = UpperLimit + Int(Rnd * 10) - 5 'MsgBox "resources = " + Str(Planet(i).Resources) + Chr(13) + "troops = " + Str(Planet(i).Troops), , Planet(i).Name End If 'set mechs if enough troops If Planet(i).Troops > 50 Then Planet(i).AssaultTroops = Int(Rnd * 8) + 1 ElseIf Planet(i).Troops > 30 Then Planet(i).AssaultTroops = Int(Rnd * 5) + 1 ElseIf Planet(i).Troops > 20 Then Planet(i).AssaultTroops = Int(Rnd * 3) + 1 End If SetCombatStrength (i) End If Next i End Sub Public Sub LostInSpace() 'count number of planets available for landing 'if count is zero, tell player their ship is lost 'then reinitialize the ship etc. If Player(Current).Ship(0).Launched Then Dim Count As Integer Dim x1, y1, X2, Y2 Dim a As Integer Dim b As Integer Dim Distance Dim RangeLow, RangeHigh Dim xpos, ypos, radius 'set activeship to appropriate ship number activeship = 0 'clear the board of any inrange settings Dim z For z = 0 To 49 Planet(z).InRange = False Next z 'Check for UltraWarp and set ranges If Player(Current).UltraWarpResearched Then 'increased range RangeLow = Player(Current).Ship(0).WarpPosition * 250 RangeHigh = RangeLow + 700 ElseIf Player(Current).UltraWarpResearched = False Then 'lower ranges RangeLow = Player(Current).Ship(0).WarpPosition * 250 RangeHigh = RangeLow + 350 End If 'ship's starting position - originating planet x1 = Player(Current).Ship(0).CenterX y1 = Player(Current).Ship(0).CenterY 'check distance from home planet to each other planet 'if within the range, set planet's InRange to true For Count = 0 To 49 X2 = picPlanet(Count).Left + (picPlanet(Count).Width / 2) Y2 = picPlanet(Count).Top + (picPlanet(Count).Height / 2) a = Abs(x1 - X2) b = Abs(y1 - Y2) Distance = Int(Sqr(a ^ 2 + b ^ 2)) If Distance >= RangeLow And Distance <= RangeHigh And picPlanet(Count).Visible Then 'planet is within range - add to list NumPlanets1 = NumPlanets1 + 1 End If Next Count NumPlanets1 = 999 End If If Player(Current).Ship(1).Launched Then 'set activeship to appropriate ship number activeship = 0 'clear the board of any inrange settings For z = 0 To 49 Planet(z).InRange = False Next z 'Check for UltraWarp and set ranges If Player(Current).UltraWarpResearched Then 'increased range RangeLow = Player(Current).Ship(1).WarpPosition * 250 RangeHigh = RangeLow + 700 ElseIf Player(Current).UltraWarpResearched = False Then 'lower ranges RangeLow = Player(Current).Ship(1).WarpPosition * 250 RangeHigh = RangeLow + 350 End If 'ship's starting position - originating planet x1 = Player(Current).Ship(1).CenterX y1 = Player(Current).Ship(1).CenterY 'check distance from home planet to each other planet 'if within the range, set planet's InRange to true For Count = 0 To 49 X2 = picPlanet(Count).Left + (picPlanet(Count).Width / 2) Y2 = picPlanet(Count).Top + (picPlanet(Count).Height / 2) a = Abs(x1 - X2) b = Abs(y1 - Y2) Distance = Int(Sqr(a ^ 2 + b ^ 2)) If Distance >= RangeLow And Distance <= RangeHigh And picPlanet(Count).Visible Then 'planet is within range - add to list NumPlanets2 = NumPlanets2 + 1 End If Next Count NumPlanets2 = 999 End If 'MsgBox "Number of eligible planets:" + Str(NumPlanets1) End Sub Public Sub DrawGridLines() 'draw grid lines Dim x1, X2, x3, x4 Dim y1, Y2, y3, y4 Dim linecolor, lineheight, linewidth linecolor = &H808080 lineheight = picGalaxy.ScaleHeight linewidth = picGalaxy.ScaleWidth 'vertical lines x1 = picGalaxy.ScaleWidth / 5 picGalaxy.Line (x1, 0)-(x1, lineheight), linecolor X2 = x1 * 2 picGalaxy.Line (X2, 0)-(X2, lineheight), linecolor x3 = x1 * 3 picGalaxy.Line (x3, 0)-(x3, lineheight), linecolor x4 = x1 * 4 picGalaxy.Line (x4, 0)-(x4, lineheight), linecolor 'horizontal lines y1 = picGalaxy.ScaleHeight / 5 picGalaxy.Line (0, y1)-(linewidth, y1), linecolor Y2 = y1 * 2 picGalaxy.Line (0, Y2)-(linewidth, Y2), linecolor y3 = y1 * 3 picGalaxy.Line (0, y3)-(linewidth, y3), linecolor y4 = y1 * 4 picGalaxy.Line (0, y4)-(linewidth, y4), linecolor End Sub Public Sub EraseGridLines() 'draw grid lines Dim x1, X2, x3, x4 Dim y1, Y2, y3, y4 Dim lineheight, linewidth lineheight = picGalaxy.ScaleHeight linewidth = picGalaxy.ScaleWidth 'vertical lines x1 = picGalaxy.ScaleWidth / 5 picGalaxy.Line (x1, 0)-(x1, lineheight), vbBlack X2 = x1 * 2 picGalaxy.Line (X2, 0)-(X2, lineheight), vbBlack x3 = x1 * 3 picGalaxy.Line (x3, 0)-(x3, lineheight), vbBlack x4 = x1 * 4 picGalaxy.Line (x4, 0)-(x4, lineheight), vbBlack 'horizontal lines y1 = picGalaxy.ScaleHeight / 5 picGalaxy.Line (0, y1)-(linewidth, y1), vbBlack Y2 = y1 * 2 picGalaxy.Line (0, Y2)-(linewidth, Y2), vbBlack y3 = y1 * 3 picGalaxy.Line (0, y3)-(linewidth, y3), vbBlack y4 = y1 * 4 picGalaxy.Line (0, y4)-(linewidth, y4), vbBlack End Sub Public Sub AlienExpansion() 'Alien Expansion procedure '***once aliens planets have at least 20 troops, then look at the 3 planets on either side. 'if they're neutral, there is a 5% + 1-TurnNumber chance of expanding Dim X As Integer Randomize For X = 0 To 49 If Planet(X).Owner = Alien And Planet(X).Troops > 20 Then 'look at planets +/- 3 of the alien planet Dim CheckA As Integer Dim CheckZ As Integer Dim Result As Integer Dim Y As Integer Dim ChanceOfExpansion As Integer ChanceOfExpansion = 5 + (Int(Rnd * TurnNumber) + 1) CheckA = X - 3 If CheckA < 0 Then CheckA = 0 'prevent error 9 - subscript out of range CheckZ = X + 3 If CheckZ > 49 Then CheckZ = 49 'ditto for error 9 For Y = CheckA To CheckZ If Planet(Y).Owner = Neutral Then Result = Int(Rnd * 100) + 1 If Result <= ChanceOfExpansion Then 'aliens take planet Dim Force As Integer 'how many aliens invade Force = Int(Rnd * 5) + 5 Planet(Y).Owner = 3 Planet(Y).Troops = Force Planet(X).Troops = Planet(X).Troops - Force Exit Sub End If End If Next Y End If Next X End Sub