Option Explicit



Private Sub cmdEnterStellarData_Click()

    Call Gen_Stellar_Data(False)

End Sub



Private Sub cmdEUWP_Click()

    Call Gen_Extended_UWP(False)

End Sub



Private Sub cmdGenSystem_Click()

'This general sub will generate the uwp, extended uwp and basic system information used by

'Traveller

'Initialize

    frmUWP!lstWorldDisplay.Clear

    frmUWP!lstWorldDisplay.Visible = False

    

'Generate the UWP

    Call Gen_UWP(True)

    

'Generate the Extended UWP

    Call Gen_Extended_UWP(True)

    

'Create Stellar Data

    Call Gen_Stellar_Data(True)

    

End Sub



Private Sub cmdManualEntry_Click()

'Initialize

    frmUWP!lstWorldDisplay.Clear

    frmUWP!lstWorldDisplay.Visible = False

    

    Call Gen_UWP(False)

End Sub



Private Sub Form_Load()

'Initialize label boxes

    Call Set_Labels

End Sub



Private Sub CmdExit_Click()

    End

End Sub



Option Explicit

Option Compare Text



Public Starport As Variant

Public Size As Variant

Public Atmosphere As Variant

Public Hydrosphere As Variant

Public Population As Variant

Public Government As Variant

Public LawLevel As Variant

Public TechLevel As Variant

Public Hex As Variant



Sub Main()

'Initalize Program

    Randomize

    

'Initialize arrays

    Starport = Array("Excellent Quality Installation", "Good Quality Installation", "Routine Quality Installation", "Poor Quality Installation", "Frontier Installation", "No Reported Starport")

    Size = Array("Asteroid/Planetoid Belt", "1000 mile/dia", "2000 mile/dia", "3000 mile/dia", "4000 mile/dia", "5000 mile/dia", "6000 mile/dia", "7000 mile/dia", "8000 mile/dia", "9000 mile/dia", "10,000 mile/dia")

    Atmosphere = Array("Vacuum", "Trace", "Very thin, tainted", "Very thin", "Thin, tainted", "Thin", "Standard", "Standard, tainted", "Dense", "Dense, tainted", "Exotic", "Corrosive", "Insidious")

    Hydrosphere = Array("No free water", "10%", "20%", "30%", "40%", "50%", "60%", "70%", "80%", "90%", "No land masses")

    Population = Array("0-9", "10-99", "100-999", "1,000-9,999", "10,000-99,999", "100,000-999,999", "1,000,000-9,999,999", "10,000,000-99,999,999", "100,000,000-999,999,999", "Tens of Billions", "Hundreds of Billions")

    Government = Array("No Government Structure", "Company/Corporation", "Participating Democracy", "Self-perpetuating Oligarchy", "Representative Democracy", "Fuedal Technocracy", "Captive Government", "Balkinization", "Civil Service", "Impersonal Bureaucracy", "Charismatic Dictator", "Non-charismatic Dictator", "Charismatic Oligarchy", "Religious Dictatorship")

    LawLevel = Array("No prohibitions", "Body pistols,explosives,poison gas prohibited", "Portable energy weapons prohibited", "Military weapons prohibited", "Light assault weapons prohibited", "Personal concealable weapons prohibited", "Most firearms (except shotgun)prohibited", "Shotguns prohibited", "Long bladed weapons controlled", "Possession outside residence prohibited", "Any possessions prohibited")

    TechLevel = Array("Stone Age.  Primitive", "Bronze Age to Middle Age", "c1400-1700", "c1700-1860", "c1860-1900", "c1900-1940", "c1940-1970", "c1970-1980", "c1980-1990", "c1990-2000", "Intersteller Community", "Average Imperial", "Average Imperial", "Above-Average Imperial", "Above-Average Imperial", "Technical Maximum Imperial", "Occaisional non-Imperial")

    Hex = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "A", "B", "C", "D", "E", "F", "G", "H")

    

'Load Form

    Load frmUWP



'Transfer control to form

    frmUWP.Show

    frmSplash.Show

    

End Sub

Public Sub Define_UWP(UWP As String, DataFlag As Boolean)

'Declare Variables

    Dim TempFlag As Boolean

    Dim StarportClass As Variant

    Dim ArrayPos As Integer

    Dim HexArraySize As Integer

    Dim StarportClassArraySize As Integer

    Dim Worldsize As Integer

    Dim Atmos As Integer

    Dim Hydro As Integer

    Dim Pop As Integer

    Dim Gov As Integer

    Dim CorruptedFuel As Boolean

    Dim TimeTo1Dia As Double

    Dim TimeTo10Dia As String

    Dim TimeTo100Dia As String

    

'Define Variables

    StarportClass = Array("A", "B", "C", "D", "E", "X", "F", "G", "H", "Y")

    StarportClassArraySize = 9

    HexArraySize = 17

    TempFlag = False

    CorruptedFuel = False

    

'Run Definition

    Call Data_Selection(TempFlag, UWP, StarportClassArraySize, StarportClass, 1, ArrayPos) 'Call the Subroutine

    If TempFlag = False Then

        frmUWP!txtStarport.Text = Starport(ArrayPos)

        frmUWP!txtStarportClass.Text = StarportClass(ArrayPos)

    Else

        DataFlag = False

    End If

    

    Call Data_Selection(TempFlag, UWP, HexArraySize, Hex, 2, ArrayPos)

    If TempFlag = False Then

        frmUWP!txtSize.Text = Size(ArrayPos)

        frmUWP!txtWorldSize.Text = Hex(ArrayPos)

        Worldsize = ArrayPos



'Evaluate Travel Times

        TimeTo1Dia = (2 * Sqr(ArrayPos * 1000))

        TimeTo10Dia = Travel_Time(TimeTo1Dia * 10)

        TimeTo100Dia = Travel_Time(TimeTo1Dia * 100)

        frmUWP!txtTravelto10diameters.Text = TimeTo10Dia

        frmUWP!txtTravelto100diameters.Text = TimeTo100Dia

    Else

        DataFlag = False

    End If

    

    Call Data_Selection(TempFlag, UWP, HexArraySize, Hex, 3, ArrayPos)

    If TempFlag = False Then

        frmUWP!txtAtm.Text = Atmosphere(ArrayPos)

        frmUWP!txtAtmosphere.Text = Hex(ArrayPos)

        Atmos = ArrayPos



'Evaluate potential warnings and display

        Select Case ArrayPos

            Case 0

                If frmUWP!lstWorldDisplay.Visible = False Then

                    frmUWP!lstWorldDisplay.Visible = True

                End If

                

                frmUWP!lstWorldDisplay.AddItem ("Vacuum Warning!  Vac Suits required")

            

            Case 1

                If frmUWP!lstWorldDisplay.Visible = False Then

                    frmUWP!lstWorldDisplay.Visible = True

                End If

                

                frmUWP!lstWorldDisplay.AddItem ("Pressure Warning!  Compressor required")

            

            Case 2

               If frmUWP!lstWorldDisplay.Visible = False Then

                    frmUWP!lstWorldDisplay.Visible = True

                End If

                

                frmUWP!lstWorldDisplay.AddItem ("Pressure Warning!")

                frmUWP!lstWorldDisplay.AddItem ("Tainted Atmosphere Warning!  Combo Mask required")

            Case 4, 7, 9

                If frmUWP!lstWorldDisplay.Visible = False Then

                    frmUWP!lstWorldDisplay.Visible = True

                End If

                

                frmUWP!lstWorldDisplay.AddItem ("Tainted Atmosphere.  Filter Masks required")

            Case 10

                If frmUWP!lstWorldDisplay.Visible = False Then

                    frmUWP!lstWorldDisplay.Visible = True

                End If

                                

                CorruptedFuel = True

                frmUWP!lstWorldDisplay.AddItem ("Corrosive Atmosphere.  Special Suits required")

            Case 11

                If frmUWP!lstWorldDisplay.Visible = False Then

                    frmUWP!lstWorldDisplay.Visible = True

                End If

                

                CorruptedFuel = True

                frmUWP!lstWorldDisplay.AddItem ("Insidious Atmosphere.  Special Suits required")

            Case 12

                If frmUWP!lstWorldDisplay.Visible = False Then

                    frmUWP!lstWorldDisplay.Visible = True

                End If

                

                CorruptedFuel = True

                frmUWP!lstWorldDisplay.AddItem ("Exotic Atmosphere.  Special Requirements required")

        End Select

    Else

        DataFlag = False

    End If

    

    Call Data_Selection(TempFlag, UWP, HexArraySize, Hex, 4, ArrayPos)

    If TempFlag = False Then

        frmUWP!txtHyd.Text = Hydrosphere(ArrayPos)

        frmUWP!txtHydrosphere.Text = Hex(ArrayPos)

        Hydro = ArrayPos

        

'Evaluate potential warnings and display

        If ArrayPos = 0 Then

            If frmUWP!lstWorldDisplay.Visible = False Then

                    frmUWP!lstWorldDisplay.Visible = True

            End If

                

            frmUWP!lstWorldDisplay.AddItem ("No Wilderness Refueling possible on planet.")

        ElseIf ArrayPos > 0 And CorruptedFuel = True Then

            If frmUWP!lstWorldDisplay.Visible = False Then

                    frmUWP!lstWorldDisplay.Visible = True

            End If

                

            frmUWP!lstWorldDisplay.AddItem ("Fluid on planet not refinable into fuel")

        End If

    

    Else

        DataFlag = False

    End If

    

    Call Data_Selection(TempFlag, UWP, HexArraySize, Hex, 5, ArrayPos)

    If TempFlag = False Then

        frmUWP!txtPop.Text = Population(ArrayPos)

        frmUWP!txtPopulation.Text = Hex(ArrayPos)

        Pop = ArrayPos

    Else

        DataFlag = False

    End If

    

    Call Data_Selection(TempFlag, UWP, HexArraySize, Hex, 6, ArrayPos)

    If TempFlag = False Then

        frmUWP!txtGov.Text = Government(ArrayPos)

        frmUWP!txtGovernment.Text = Hex(ArrayPos)

        Gov = ArrayPos

    Else

        DataFlag = False

    End If

    

    Call Data_Selection(TempFlag, UWP, HexArraySize, Hex, 7, ArrayPos)

    If TempFlag = False Then

        frmUWP!txtLL.Text = LawLevel(ArrayPos)

        frmUWP!txtLawLevel.Text = Hex(ArrayPos)

    Else

        DataFlag = False

    End If

    

    Call Data_Selection(TempFlag, UWP, HexArraySize, Hex, 8, ArrayPos)

    If TempFlag = False Then

        frmUWP!txtTL.Text = TechLevel(ArrayPos)

        frmUWP!txtTechLevel.Text = Hex(ArrayPos)

    Else

        DataFlag = False

    End If



End Sub

Public Sub Data_Selection(Flag As Boolean, UserInput As String, B As Integer, DataArray As Variant, StringPos As Long, ReturnValue As Integer)

'This general sub pulls apart the string the user submits, checks it for validity and returns decoded information about

'the UWP.  Parameters passed to this sub will be:

' Flag - this is set to true in the sub, but once the data is validated it is reset to false.  If the flag is passed back as true, it will

'        create a error condition.

' UserInput - this is the string

' DataArray - this will be either the Hex for UWP checking, or the Starport Types

' StringPos, this is the UWP position to be checked (Starport = 1, Worldsize = 2, etc...)

' ReturnValue - this is the position in the array that the data validates to.  It is set to 0 by default



'Declare Variables

    Dim SearchChar As String

    Dim A As Integer

    

'Define Variables

    Flag = True

    ReturnValue = 0

    

'Read User Input

    SearchChar = Mid$(UserInput, StringPos, 1)

    For A = 0 To B

        If SearchChar = DataArray(A) Then

            ReturnValue = A

            Flag = False

        End If

    Next

End Sub

Public Sub Trade_Code_Evaluation()

'Declare Variables

    Dim A As Integer

    Dim Worldsize As Integer

    Dim Atmos As Integer

    Dim Hydro As Integer

    Dim Pop As Integer

    Dim Gov As Integer

    

'Reset all Trade Classifications

    Call Set_Labels



'Convert UWP back to something I can use

    Worldsize = To_Decimal(frmUWP!txtWorldSize.Text)

    Atmos = To_Decimal(frmUWP!txtAtmosphere.Text)

    Hydro = To_Decimal(frmUWP!txtHydrosphere.Text)

    Pop = To_Decimal(frmUWP!txtPopulation.Text)

    Gov = To_Decimal(frmUWP!txtGovernment.Text)

    

'Agricultural/Non-Agricultural

If (Atmos >= 4 And Atmos <= 9) And (Hydro >= 4 And Hydro <= 8) And (Pop >= 5 And Pop <= 7) Then

    frmUWP!lblAg.BackColor = &H80FF80

    frmUWP!lblAg.Visible = True

    frmUWP!lblAg.Caption = "Ag"

ElseIf (Atmos <= 3) And (Hydro <= 3) And (Pop >= 5) Then

    frmUWP!lblAg.BackColor = QBColor(14)

    frmUWP!lblAg.Visible = True

    frmUWP!lblAg.Caption = "N-Ag"

End If



'Industrial/Non-Industrial

If (Atmos <= 2 Or Atmos = 4 Or Atmos = 7 Or Atmos = 9) And (Pop >= 9) Then

    frmUWP!lblInd.BackColor = &H80FF80

    frmUWP!lblInd.Visible = True

    frmUWP!lblInd.Caption = "Ind"

ElseIf (Pop <= 6) Then

    frmUWP!lblInd.BackColor = QBColor(14)

    frmUWP!lblInd.Visible = True

    frmUWP!lblInd.Caption = "N-Ind"

End If



'Rich/Poor

If (Atmos = 6 Or Atmos = 8) And (Pop >= 6 And Pop <= 8) And (Gov >= 4 And Gov <= 9) Then

    frmUWP!lblRich.BackColor = &H80FF80

    frmUWP!lblRich.Visible = True

    frmUWP!lblRich.Caption = "Rich"

ElseIf (Atmos >= 2 And Atmos <= 5) _

And (Hydro <= 3) Then

    frmUWP!lblRich.BackColor = QBColor(14)

    frmUWP!lblRich.Visible = "True"

    frmUWP!lblRich.Caption = "Poor"

End If



'Water/Desert Worlds

If (Hydro >= 11) Then

    frmUWP!lblWater.BackColor = &H80FF80

    frmUWP!lblWater.Visible = True

    frmUWP!lblWater.Caption = "Water"

ElseIf (Hydro = 0) Then

    frmUWP!lblWater.BackColor = QBColor(14)

    frmUWP!lblWater.Visible = True

    frmUWP!lblWater.Caption = "Desert"

End If



'Vacuum

If (Atmos) = 0 Then

    frmUWP!lblVacuum.BackColor = QBColor(13)

    frmUWP!lblVacuum.Visible = True

    frmUWP!lblVacuum.Caption = "Vacuum"

End If



'Ice-Capped

If (Atmos <= 1) And (Hydro >= 1) Then

    frmUWP!lblIce.BackColor = QBColor(13)

    frmUWP!lblIce.Visible = True

    frmUWP!lblIce.Caption = "Ice Cap"

End If



'Hi Pop/Barren

If (Pop >= 11) Then

    frmUWP!lblPop.BackColor = &H80FF80

    frmUWP!lblPop.Visible = True

    frmUWP!lblPop.Caption = "Hi-Pop"

ElseIf (Pop = 0) Then

    frmUWP!lblPop.BackColor = QBColor(14)

    frmUWP!lblPop.Visible = True

    frmUWP!lblPop.Caption = "Barren"

End If



'Asteroid

If (Worldsize = 0) Then

    frmUWP!lblAsteroid.BackColor = QBColor(13)

    frmUWP!lblAsteroid.Visible = True

    frmUWP!lblAsteroid.Caption = "Asteroid"

End If

End Sub

Public Sub Set_Labels()

'Initialize label boxes

    frmUWP!lblAg.Caption = ""

    frmUWP!lblAg.Visible = False

    frmUWP!lblInd.Caption = ""

    frmUWP!lblInd.Visible = False

    frmUWP!lblRich.Caption = ""

    frmUWP!lblRich.Visible = False

    frmUWP!lblWater.Caption = ""

    frmUWP!lblWater.Visible = False

    frmUWP!lblVacuum.Caption = ""

    frmUWP!lblVacuum.Visible = False

    frmUWP!lblIce.Caption = ""

    frmUWP!lblIce.Visible = False

    frmUWP!lblPop.Caption = ""

    frmUWP!lblPop.Visible = False

    frmUWP!lblCapital.Caption = ""

    frmUWP!lblCapital.Visible = False

    frmUWP!lblAsteroid.Caption = ""

    frmUWP!lblAsteroid.Visible = False

End Sub

Public Sub Roll_Starport(Starport As String, TechLevelMod As Integer)

'declare variables

    Dim StarportRoll As Integer

    

'Define variables

    StarportRoll = DieRoll(6) + DieRoll(6)



'Determine Starport

    Select Case StarportRoll

        Case 2, 3, 4

            Starport = "A"

            TechLevelMod = 6

        Case 5, 6

            Starport = "B"

            TechLevelMod = 4

        Case 7, 8

            Starport = "C"

            TechLevelMod = 2

        Case 9

            Starport = "D"

        Case 10, 11

            Starport = "E"

        Case Else

            Starport = "X"

            TechLevelMod = -2

    End Select



End Sub

Public Sub Roll_Worldsize(Worldsize As String, TechLevelMod As Integer, WorldSizeRoll As Integer)

'Define Variables

    WorldSizeRoll = DieRoll(6) + DieRoll(6) - 2

    Worldsize = Hex(WorldSizeRoll)

    

'Evaluate WorldSize

    Select Case WorldSizeRoll                   'Tech Level Modifiers

        Case 0, 1

            TechLevelMod = TechLevelMod + 2

        Case 2, 3, 4

            TechLevelMod = TechLevelMod + 1

        Case Else

            'No mod

    End Select



End Sub

Public Sub Roll_Atmosphere(AtmosphereType As String, TechLevelMod As Integer, WorldSizeRoll As Integer, AtmosphereTypeRoll As Integer)

'Define Variables

    AtmosphereTypeRoll = DieRoll(6) + DieRoll(6) - 7 + WorldSizeRoll

    

'Evaluate Atmosphere Type

    If WorldSizeRoll <= 0 Then                  'Environmental modifiers

        AtmosphereTypeRoll = 0

    End If

    

    If AtmosphereTypeRoll <= 0 Then             'Data Validation - range is 0 to 12

        AtmosphereTypeRoll = 0

    ElseIf AtmosphereTypeRoll > 12 Then

        AtmosphereTypeRoll = 12

    End If

    

    Select Case AtmosphereTypeRoll              'Tech Level Modifiers

        Case 0, 1, 2, 3

            TechLevelMod = TechLevelMod + 1

        Case 10, 11, 12, 13, 14

            TechLevelMod = TechLevelMod + 1

        Case Else

            'No mod

    End Select

        

    AtmosphereType = Hex(AtmosphereTypeRoll)

End Sub

Public Sub Roll_Hydrosphere(HydrosphereType As String, TechLevelMod As Integer, AtmosphereTypeRoll As Integer, WorldSizeRoll As Integer)

'Declare Variables

    Dim HydrosphereTypeRoll As Integer



'define variables

    HydrosphereTypeRoll = DieRoll(6) + DieRoll(6) - 7 + WorldSizeRoll

    

'Evaluate Hydrosphere Roll

    If WorldSizeRoll <= 1 Then                  'Environmental modifiers

        HydrosphereTypeRoll = 0

    End If

    If (AtmosphereTypeRoll <= 1) Or (AtmosphereTypeRoll >= 10) Then

        HydrosphereTypeRoll = HydrosphereTypeRoll - 4

    End If

    

    If HydrosphereTypeRoll <= 0 Then                  'Data Validation - range is 0 to 10

        HydrosphereTypeRoll = 0

    ElseIf HydrosphereTypeRoll > 10 Then

        HydrosphereTypeRoll = 10

    End If

    

    Select Case HydrosphereTypeRoll              'Tech Level Modifiers

        Case 9

            TechLevelMod = TechLevelMod + 1

        Case 10

            TechLevelMod = TechLevelMod + 2

        Case Else

            'No mod

    End Select

        

    HydrosphereType = Hex(HydrosphereTypeRoll)

End Sub

Public Sub Roll_Population(PopulationSize As String, TechLevelMod As Integer, PopulationSizeRoll As Integer)

'Define Variable

    PopulationSizeRoll = DieRoll(6) + DieRoll(6) - 2

    

'Evaluate Population Roll

    Select Case PopulationSizeRoll              'Tech Level Modifiers

        Case 1, 2, 3, 4, 5

            TechLevelMod = TechLevelMod + 1

        Case 9

            TechLevelMod = TechLevelMod + 2

        Case 10

            TechLevelMod = TechLevelMod + 4

        Case Else

            'No mod

    End Select

        

    PopulationSize = Hex(PopulationSizeRoll)



End Sub



Public Sub Roll_Government(GovernmentType As String, TechLevelMod As Integer, PopulationSizeRoll As Integer, GovernmentTypeRoll As Integer)

'Define Variables

    GovernmentTypeRoll = DieRoll(6) + DieRoll(6) - 7 + PopulationSizeRoll

    

'Evaluate Government Type Roll

    If GovernmentTypeRoll <= 0 Then              'Data Validation - range is 0 to 13

        GovernmentTypeRoll = 0

    ElseIf GovernmentTypeRoll > 13 Then

        GovernmentTypeRoll = 13

    End If

    

    Select Case GovernmentTypeRoll               'Tech Level Modifiers

        Case 0, 5

            TechLevelMod = TechLevelMod + 1

        Case 13

            TechLevelMod = TechLevelMod - 2

        Case Else

            'No mod

    End Select

        

    GovernmentType = Hex(GovernmentTypeRoll)



End Sub

Public Sub Roll_LawLevel(LawLevel As String, GovernmentTypeRoll As Integer)

'Declare Variables

    Dim LawLevelRoll As Integer



'Define Variables

    LawLevelRoll = DieRoll(6) + DieRoll(6) - 7 + GovernmentTypeRoll

    

'Evaluate LawLevel Roll

    If LawLevelRoll <= 0 Then                    'Data Validation - range is 0 to 10

        LawLevelRoll = 0

    ElseIf LawLevelRoll > 10 Then

        LawLevelRoll = 10

    End If

    

    LawLevel = Hex(LawLevelRoll)

End Sub

Public Sub Roll_TechLevel(TechLevel As String, TechLevelMod As Integer)

'Declare Variables

    Dim TechLevelRoll As Integer

    

'Define Variables

    TechLevelRoll = DieRoll(6) + TechLevelMod

    

'Evaluate Tech Level Roll

    If TechLevelRoll < 0 Then

        TechLevelRoll = 0

    End If

    

    TechLevel = Hex(TechLevelRoll)



End Sub



Public Sub Roll_Stellar(StarSize As String, StarType As String, StellarDef As String, MaxOrbit As Integer)

'Declare Variables

    Dim SystemTypeRoll As Integer

    Dim SystemSizeRoll As Integer

    Dim DecimalRoll As Integer

    Dim HabitableOrbit As String

        

'Define Variables

    SystemTypeRoll = DieRoll(6) + DieRoll(6)

    SystemSizeRoll = DieRoll(6) + DieRoll(6)

    DecimalRoll = DieRoll(10) - 1

    MaxOrbit = DieRoll(6) + DieRoll(6)

    

'Evaluate System

'These DM's are applied to Primaries being rolled after the planet is rolled (which is the case in this application)

    If ((Val(frmUWP!txtAtmosphere.Text) >= 4) And (Val(frmUWP!txtAtmosphere.Text) <= 9)) Or (((Val(frmUWP!txtPopulation.Text)) >= 8) Or (frmUWP!txtPopulation.Text = "A")) Then

        SystemTypeRoll = SystemTypeRoll + 4

        SystemSizeRoll = SystemSizeRoll + 4

    End If

    

    Select Case SystemTypeRoll                  'This selection process evaluates the exact star type

        Case 0, 1

            StarType = "B"

        Case 2

            StarType = "A"

        Case 3, 4, 5, 6, 7

            StarType = "M"

            MaxOrbit = MaxOrbit - 4

        Case 8

            StarType = "K"

            MaxOrbit = MaxOrbit - 2

        Case 9

            StarType = "G"

    Case Else

            StarType = "F"

    End Select

    

    StarType = StarType & Str(DecimalRoll)      'This statement adds the decimal classification to the startype

    

    Select Case SystemSizeRoll                  'This selection process determines the Star Size

        Case 0

            StarSize = "Ia"

            StellarDef = "Bright SuperGiant"

            MaxOrbit = MaxOrbit + 8

        Case 1

            StarSize = "Ib"

            StellarDef = "Weaker SuperGiant"

            MaxOrbit = MaxOrbit + 8

        Case 2

            StarSize = "II"

            StellarDef = "Bright Giant"

            MaxOrbit = MaxOrbit + 8

        Case 3

            StarSize = "III"

            StellarDef = "Giant"

            MaxOrbit = MaxOrbit + 4

        Case 4

            If (Left(StarType, 1) = "M") Or ((Left(StarType, 1) = "K") And (Val(Right(StarType, 1)) >= 5)) Then

                StarSize = "V"

                StellarDef = "MainSequence"

                If (Left(StarType, 1) = "K") Then

                    MaxOrbit = MaxOrbit + 2

                End If

                

                StarType = "M" & Str(DecimalRoll)

                MaxOrbit = MaxOrbit - 4

                

            Else

                StarSize = "IV"

                StellarDef = "SubGiant"

            End If

        Case 5, 6, 7, 8, 9, 10

            StarSize = "V"

            StellarDef = "Main Sequence"

        Case 11

            If (Left(StarType, 1) = "B") Or (Left(StarType, 1) = "A") Or ((Left(StarType, 1) = "F") And (Val(Right(StarType, 1)) < 5)) Then

                StarSize = "V"

                StellarDef = "Main Sequence"

                StarType = "M" & Str(DecimalRoll)

                MaxOrbit = MaxOrbit - 4

            Else

                StarSize = "VI"

                StellarDef = "Sub Dwarf"

            End If

        Case Else

            StarSize = "D"

            StellarDef = "Dwarf"

    End Select

End Sub

Public Sub Stellar_Definition(StarClass As String, DecimalClass As Integer, StarArray As Variant, ReturnValue As Double)

    Select Case StarClass

         Case "B"

             If DecimalClass < 5 Then

                 ReturnValue = StarArray(0)

             Else

                 ReturnValue = StarArray(1)

             End If

         Case "A"

             If DecimalClass < 5 Then

                 ReturnValue = StarArray(2)

             Else

                 ReturnValue = StarArray(3)

             End If

         Case "F"

             If DecimalClass < 5 Then

                 ReturnValue = StarArray(4)

             Else

                 ReturnValue = StarArray(5)

             End If

         Case "G"

             If DecimalClass < 5 Then

                 ReturnValue = StarArray(6)

             Else

                 ReturnValue = StarArray(7)

             End If

         Case "K"

             If DecimalClass < 5 Then

                 ReturnValue = StarArray(8)

             Else

                 ReturnValue = StarArray(9)

             End If

         Case "M"

             If DecimalClass < 5 Then

                 ReturnValue = StarArray(10)

             ElseIf DecimalClass < 9 Then

                 ReturnValue = StarArray(11)

             Else

                 ReturnValue = StarArray(12)

             End If

                 

     End Select

End Sub

Public Sub Gen_UWP(AutoGen As Boolean)

'The purpose of this General Sub is to generate the UWP codes, as described by Traveller (version 4)



'This sub routes both the manual (user entry) and automatic (computer generated) entry paths through it, and

'is passed the AutoGen variable to determine which path should be taken by the code.  Once the actual data

'is generated, the sub then processes and displays the data in common code.



'Declare Variables

    Dim UWP As String

    Dim DataFlag As Boolean

    Dim Starport As String

    Dim Worldsize As String

    Dim AtmosphereType As String

    Dim HydrosphereType As String

    Dim PopulationSize As String

    Dim GovernmentType As String

    Dim LawLevel As String

    Dim TechLevel As String

    Dim TechLevelMod As Integer

    Dim WorldSizeRoll As Integer

    Dim PopulationSizeRoll As Integer

    Dim GovernmentTypeRoll As Integer

    Dim AtmosphereTypeRoll As Integer



    

'Define Variables

    DataFlag = False

    Starport = ""

    Worldsize = ""

    HydrosphereType = ""

    PopulationSize = ""

    GovernmentType = ""

    LawLevel = ""

    TechLevelMod = 0



'Determine if the entry point will be for Manual or Automatic Generation

    If Not AutoGen Then                     'Manual Entry

        Do

            UWP = InputBox("Enter UWP without dashes", "Planet Data Input", "X000000")      'Get User Input

            DataFlag = True                 'Set DataFlag to True - If all conditions are ok, then the program will drop out of the loop at the bottom

            

            If (Len(UWP) = 8) Then          'Check for a valid data length

                Define_UWP UWP, DataFlag

            Else

                DataFlag = False

            End If

        Loop Until DataFlag = True

    Else                                    'Automatic Generation

        Call Roll_Starport(Starport, TechLevelMod)                                              'Starport Generation

        Call Roll_Worldsize(Worldsize, TechLevelMod, WorldSizeRoll)                             'Planet Size

        Call Roll_Atmosphere(AtmosphereType, TechLevelMod, WorldSizeRoll, AtmosphereTypeRoll)   'Atmosphere Type

        Call Roll_Hydrosphere(HydrosphereType, TechLevelMod, AtmosphereTypeRoll, WorldSizeRoll) 'Hydrosphere Type

        Call Roll_Population(PopulationSize, TechLevelMod, PopulationSizeRoll)                  'Population

        Call Roll_Government(GovernmentType, TechLevelMod, PopulationSizeRoll, GovernmentTypeRoll)    'Government Type

        Call Roll_LawLevel(LawLevel, GovernmentTypeRoll)    'Law Level Type

        Call Roll_TechLevel(TechLevel, TechLevelMod)        'Tech Level

        

    'Combine the individual UWP components

        UWP = (Starport & Worldsize & AtmosphereType & HydrosphereType & PopulationSize & GovernmentType & LawLevel & TechLevel)

        Define_UWP UWP, DataFlag            'Run the UWP definitions

    End If

    

'Get the Trade Codes

        Trade_Code_Evaluation



End Sub

Public Sub Gen_Extended_UWP(AutoGen As Boolean)

'The purpose of this General Sub is to generate the Extended UWP codes, as described by Traveller (version 4)



'This sub routes both the manual (user entry) and automatic (computer generated) entry paths through it, and

'is passed the AutoGen variable to determine which path should be taken by the code.  Once the actual data

'is generated, the sub then processes and displays the data in common code.



'Declare Variables

    Dim PopulationMod As Integer

    Dim GG As Integer

    Dim PB As Integer

    Dim DataFlag As Boolean

    Dim Population As Double

    Dim PopData As Integer

    

'Manual Entry

    If Not AutoGen Then

        

'I elected to get each value separately from the user.  I don't know why, and may revisit that decision

'in later revisions.



    'Get Population Mod from user

        DataFlag = False



'Again, I use a loop to ensure valid data is passed to the program.  While it is easier for me, as a programmer,

'to validate data in this fashion, I think it may be more aggravating to the users.  I await feedback.



        Do While DataFlag = False

            PopulationMod = Val(InputBox("Enter the Population Modifier", "Population Mod"))

            If (PopulationMod >= 0) And (PopulationMod < 10) Then

                DataFlag = True

            Else

                DataFlag = False

            End If

        Loop

    

    'Get Planetoid Belt Data from user

        DataFlag = False

        Do While DataFlag = False

            PB = Val(InputBox("Enter the number of Planetoid Belts", "Planetoid Belts"))

            If (PB >= 0) And (PB < 10) Then

                DataFlag = True

            Else

                DataFlag = False

            End If

        Loop

    

    'Get Gas Giant data from user

        DataFlag = False

        Do While DataFlag = False

            GG = Val(InputBox("Enter the number of gas giants", "Gas Giants"))

            If (GG >= 0) And (GG < 10) Then

                DataFlag = True

            Else

                DataFlag = False

            End If

        Loop

    

    Else                            'Automatic Generation

    

    PopulationMod = DieRoll(10) - 1

    GG = GasGiant(DieRoll(6) + DieRoll(6))

    PB = PlanetoidBelt(DieRoll(6) + DieRoll(6) + GG)

    

    End If

        

'Decode the UWP code for Population to use in determining the population of the planet

    If frmUWP!txtPopulation.Text = "A" Then

        PopData = 10

    Else

        PopData = Val(frmUWP!txtPopulation.Text)

    End If



'Evaluate potential warnings and display

    If GG = 0 Then

        If frmUWP!lstWorldDisplay.Visible = False Then

            frmUWP!lstWorldDisplay.Visible = True

        End If

    

    frmUWP!lstWorldDisplay.AddItem ("No Gas Giant Refueling Possible.")

    End If



'Write Extended UWP to the form

    frmUWP!txtPopulationMod.Text = PopulationMod

    frmUWP!txtGasGiants.Text = GG

    frmUWP!txtPlanetoidBelts.Text = PB

    

'Because the Population modifier can be zero, it is not possible to do a straight formula

'evaluation of the population total.



    If PopulationMod = 0 Then

        Population = 10 ^ PopData

    Else

        Population = PopulationMod * (10 ^ PopData)

    End If

    

    frmUWP!txtPop.Text = Format(Population, "###,###,###,###,###")

    

End Sub

Public Sub Gen_Stellar_Data(AutoGen As Boolean)

'This General Sub is designed to Generate the Stellar Data used in Traveller.  Because Version

'4 did not include Stellar System Generation, I have elected to use the rules described in Book 6,

'Scouts.  I may alter this at a later date to use the MT rules, but I had Book 6 handy at the time,

'and that is fundementally what decided me.



'This is a dual purpose Sub, meaning that both the manual and automatic generation paths are routed

'through it.  The AutoGen parameter passed to this sub will determine which path to take.  If AutoGen

'is set to TRUE, then it has been passed from the automatic generation side, otherwise it is

'coming from the manual (user entry) side.



'While currently the program only allows for generation of a single (primary) stellar system,

'I am incorporating features into the code which will make upgrading to multiple systems easier.

'To this end, the actual stellar system generation (automatic) is actually contained in another

'General Sub, and is called from this sub.



'Declare Variables

    Dim PrimaryStarSize As String

    Dim PrimaryStarType As String

    Dim DataFlag As Boolean

    Dim DecimalClass As String

    Dim MaxOrbit As Integer

    Dim PrimaryStellarDiameter As Double

    Dim StellarExclusionaryZone As Double

    Dim StellarDangerZone As Double

    Dim HabitableOrbit As String

    Dim StellarDef As String

    

'define Variables

    DataFlag = False

    MaxOrbit = DieRoll(6) + DieRoll(6)

    

'Get StarType from User

'This selection determines which path the code should take (False -> Manual or True-> Auto).



    If Not AutoGen Then

    

'The following loop ensures that only valid data is passed to the program.  The data is not case

'sensitive (defined at the top of the code module with the 'Option Text Search' feature.)  The

'Dataflag (already set to false) is the means by which we ensure that only valid data is passed

'to the program.



        Do While DataFlag = False

            PrimaryStarType = InputBox("Enter StarType (B,A,F,G,K,M)", "Star Type")

                    

'Because of the possibility that the user will simply enter both the Star Type and corresponding

'Decimal classification, I check the entered data for that possibility.  If the length is only

'set to 1 (meaning that the user actually *read* my caption), the data is massaged as follows:



            If Len(PrimaryStarType) = 1 Then

                Select Case PrimaryStarType             'This case series validates the user entry _

                                                        and modifies the maximum orbits available to _

                                                        the stellar system

                    Case "B", "A", "F", "G", "K", "M"

                        DataFlag = True

                        

                        If PrimaryStarType = "M" Then

                            MaxOrbit = MaxOrbit - 4

                        ElseIf PrimaryStarType = "K" Then

                            MaxOrbit = MaxOrbit - 2

                        End If

                        

                    Case Else                           'If there are no matches, the selection process _

                                                        falls through to here.  Even though the dataflag _

                                                        should already be set to false, I make sure.

                        DataFlag = False

                End Select



'But if the user just entered the full star type, I wrote a *special* loop to accomodate them.



            ElseIf Len(PrimaryStarType) = 2 Then

                Select Case Left(PrimaryStarType, 1)    'This is basically the same as the case statement _

                                                        above, but modified to take into account that the _

                                                        string is more than one character.

                    Case "B", "A", "F", "G", "K", "M"

                        DataFlag = True

                        

                        If Left(PrimaryStarType, 1) = "M" Then

                            MaxOrbit = MaxOrbit - 4

                        ElseIf Left(PrimaryStarType, 1) = "K" Then

                            MaxOrbit = MaxOrbit - 2

                        End If

                        

                        Select Case Right(PrimaryStarType, 1)   'Then, we need to extract the data from the _

                                                                other side of the string - the decimal number.

                            Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"

                                DecimalClass = Right(PrimaryStarType, 1)

                            Case Else                   'If the user got fancy, and tried to sneak an invalid _

                                                        decimal classification in with a valid StarClass, I _

                                                        catch it here.

                                DataFlag = False

                                DecimalClass = ""

                        End Select

                    Case Else                           'And finally, if the string was invalid, it gets rejected _

                                                        here.

                        DataFlag = False

                End Select

            

'And, of course, there are always the users that just type in any damn thing they want.  I have

'no pity for them, they just drop into this catagory and are rejected.

            

            Else

                DataFlag = False

                DecimalClass = ""

            End If

         

         Loop

        

'Get the Decimal Classification from the user

        DataFlag = False

        

'Now I had to write this to be aware of those 'tricky' users that included both the Star Class and Decimal Classification

'in the last module.  This loop will continue until either the DataFlag is True, or the length of the DecimalClass variable

'is greater than one.  That also means that if the DecimalClass is currently greater than one, it should bypass this section

'of code.



        Do While DataFlag = False Or Len(DecimalClass) = 0

            DecimalClass = InputBox("Enter Decimal classification of Startype", "Decimal Classification")

            Select Case DecimalClass                       'This case statement will verify the validity of the data _

                                                            being passed by the user.

                                                            

                Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"

                    DataFlag = True

                Case Else                                   'And, of course, if the data is not valid the user input _

                                                            will be rejected.  Because the loop is looking for *either* _

                                                            DataFlag or lenger of DecimalClass, both are reset here.

                    DataFlag = False

                    DecimalClass = ""

            End Select

        Loop

        

        PrimaryStarType = UCase(PrimaryStarType)            'Ensure Upper Case

        PrimaryStarType = PrimaryStarType & DecimalClass    'After it's all done, concatenate the two variables into _

                                                            the final result.

    

'Get Star Size from the User

        DataFlag = False

        

'Finally, the Star Size input.  Again, DataFlag is set to false, and the loop will continue until it is reset to True.



        Do While DataFlag = False

            PrimaryStarSize = InputBox("Enter Star Size (Ia, Ib, II, III, IV, V, VI, or D)")

            Select Case PrimaryStarSize                     'This case series again checks for data validity, and ensures _

                                                            that the modifiers for the Maximum allowable Orbits are _

                                                            correctly applied.

                Case "Ia", "Ib", "II", "III", "IV", "V", "VI", "D"

                

                    If PrimaryStarSize = "Ia" Or PrimaryStarSize = "Ib" Or PrimaryStarSize = "II" Then

                        MaxOrbit = MaxOrbit + 8

                    ElseIf PrimaryStarSize = "III" Then

                        MaxOrbit = MaxOrbit + 4

                    End If

                        

                    DataFlag = True

                Case Else                                   'And again, if the user does not supply valid data, he/she is rejected.

                    DataFlag = False

            End Select

        Loop

    

    Else                    'Automatic Generation

        

        Roll_Stellar PrimaryStarSize, PrimaryStarType, StellarDef, MaxOrbit

    

    End If



    PrimaryStarSize = UCase(PrimaryStarSize)                'Ensure Upper Case

    

'Max Orbit Data Validation - make sure that there are not negative orbit values.

    If MaxOrbit < 0 Then

        MaxOrbit = 0

    End If

    

'Determine Habitable Orbit

    HabitableOrbit = Str(Hab_Orbit(PrimaryStarType, PrimaryStarSize))

    If HabitableOrbit = "-1" Then HabitableOrbit = "N/A"



'Write the data to the form

    frmUWP!txtPrimaryType.Text = PrimaryStarType

    frmUWP!txtPrimarySize.Text = PrimaryStarSize

    frmUWP!txtMaximumOrbits.Text = MaxOrbit

    frmUWP!fraStellarClassification.ToolTipText = "Class " & Left(PrimaryStarType, 1) & " " & StellarDef

    frmUWP!txtHabitableOrbit.Text = HabitableOrbit

    

'Calculate the Stellar Radii and convert to diameters for evaluating the Jump Exclusionary and Jump Danger Zones.

'For definition purposes, the Jump Exclusionary Zone is set to 10 diameters or less - where the DM for Jumping the

'ship is really high, and the Jump Danger Zone is set to 100 diameters or less.



    PrimaryStellarDiameter = Calculate_Stellar_Radii(PrimaryStarSize, PrimaryStarType) * 2

    StellarExclusionaryZone = Calculate_Stellar_Orbit(PrimaryStellarDiameter * 10)

    StellarDangerZone = Calculate_Stellar_Orbit(PrimaryStellarDiameter * 100)

    

'This checks to see if the return for the Exclusionary Zone at least reached to orbit 0.  If it did not, the

'text box is marked as 'inside orbit 0'.  Otherwise it is set to the Orbit returned.

    If StellarExclusionaryZone > 0 Then

        frmUWP!txtExclusionaryZone.Text = "Orbit " & Str(StellarExclusionaryZone)

    Else

        frmUWP!txtExclusionaryZone.Text = "Inside Orbit 0"

    End If

    

'This checks to see if the return for the Danger Zone at least reached to orbit 0.  If it did not, the

'text box is marked as 'inside orbit 0'.  Otherwise it is set to the Orbit returned.

    If StellarDangerZone > 0 Then

        frmUWP!txtDangerZone.Text = "Orbit " & Str(StellarDangerZone)

    Else

        frmUWP!txtDangerZone.Text = "Inside Orbit 0"

    End If

    

'Check for Hab Zone encroachment.  This means that if the Habitable zone is within the Jump Danger or Exclusionary Zones,

'a warning is posted.



    If (StellarExclusionaryZone >= Val(frmUWP!txtHabitableOrbit.Text)) And (frmUWP!txtHabitableOrbit.Text <> "N/A") Then

        frmUWP!txtStellarDisplay.Visible = True

        frmUWP!txtStellarDisplay.Text = "Danger! Habitable orbit within J-Drive exclusionary zone"

    ElseIf StellarDangerZone >= Val(frmUWP!txtHabitableOrbit.Text) And (frmUWP!txtHabitableOrbit.Text <> "N/A") Then

        frmUWP!txtStellarDisplay.Visible = True

        frmUWP!txtStellarDisplay.Text = "Warning! Habitable orbit within J-Drive danger zone"

    Else

        frmUWP!txtStellarDisplay.Visible = False

        frmUWP!txtStellarDisplay.Text = ""

    End If

End Sub

Public Function Calculate_Stellar_Orbit(Diameter As Double) As Double

'This function is intended to indicate at how many Stellar_Radii a given distance in space is.  It must be supplied with the point in space, measured in

'Stellar Radii.  The path to changing the data returned to specific distances using AU or kilometers is available, simply by changing the data in the

'Array



'Declare variables

    Dim SolarRadii As Variant

    Dim A As Integer

    

'Define variables

    Calculate_Stellar_Orbit = -1



'I elected to evaluate using Arrays, rather than complex loops.  Fundementally, it is easier to change arrays than

're-logic out the series of nested For/Next loops or Case statements.  I'm hoping this will make upgrading the

'software easier when T-5 is released.

    SolarRadii = Array(40, 80, 140, 200, 320, 560, 1040, 2000, 3920, 7760, 15440, 30800, 61520, 123498, 245836, 491594, 983106, 1966132, 3932184, 7864290)

    

'evaluate and set the return value

    For A = 0 To 19

        If Diameter >= SolarRadii(A) Then

            Calculate_Stellar_Orbit = A

        End If

    Next

End Function

Public Function Calculate_Stellar_Radii(StarSize As String, StarType As String)

'This function will return the Stellar Radii when supplied with the StarSize and StarType.  Currently it returns the

'value in Stellar Radii, but can easily be modified to return the value in AU or kilometers, by changing the contents

'of the arrays.



'Declare Variable

    Dim DecimalClass As Integer

    Dim StarClass As String

    Dim SubDwarf As Variant

    Dim Dwarf As Variant

    Dim SizeIa As Variant

    Dim SizeIb As Variant

    Dim SizeII As Variant

    Dim SizeIII As Variant

    Dim SizeIV As Variant

    Dim SizeV As Variant

    Dim Radius As Double

    

'Define Variables

    DecimalClass = Right(StarType, 1)

    StarClass = Left(StarType, 1)



'I elected to evaluate using Arrays, rather than complex loops.  Fundementally, it is easier to change arrays than

're-logic out the series of nested For/Next loops or Case statements.  I'm hoping this will make upgrading the

'software easier when T-5 is released.

    SubDwarf = Array(-1, -1, -1, -1, -1, 1.14, 1.02, 0.55, 0.4, 0.308, 0.256, 0.104, 0.053)

    Dwarf = Array(0.018, 0.018, 0.017, 0.017, 0.013, 0.013, 0.102, 0.012, 0.009, 0.009, 0.006, 0.006, 0.006)

    SizeIa = Array(52, 75, 135, 149, 174, 204, 298, 454, 654, 1010, 1467, 3020, 3499)

    SizeIb = Array(30, 35, 50, 55, 59, 60, 84, 128, 216, 392, 857, 2073, 2876)

    SizeII = Array(22, 20, 18, 14, 16, 18, 25, 37, 54, 124, 237, 712, 931)

    SizeIII = Array(16, 10, 6.2, 4.6, 4.7, 5.2, 7.1, 11, 16, 42, 63, 228, 360)

    SizeIV = Array(13, 5.3, 4.5, 2.7, 2.7, 2.6, 2.5, 2.8, 3.3, -1, -1, -1, -1)

    SizeV = Array(10, 4.4, 3.2, 1.8, 1.7, 1.4, 1.03, 0.91, 0.908, 0.566, 0.549, 0.358, 0.201)

    

'Evaluate by sending StarClass, DecimalClass and the Array being evaluated to another General Sub.  That General Sub actually

'returns the value (Radius) that is the return value for this function.  The Stellar_Definition Sub is shared with the

'Hab_Orbit Function.

    

    Select Case StarSize

        Case "D"

            Call Stellar_Definition(StarClass, DecimalClass, Dwarf, Radius)

        Case "Ia"

            Call Stellar_Definition(StarClass, DecimalClass, SizeIa, Radius)

        Case "Ib"

            Call Stellar_Definition(StarClass, DecimalClass, SizeIb, Radius)

        Case "II"

            Call Stellar_Definition(StarClass, DecimalClass, SizeII, Radius)

        Case "III"

            Call Stellar_Definition(StarClass, DecimalClass, SizeIII, Radius)

        Case "IV"

            Call Stellar_Definition(StarClass, DecimalClass, SizeIV, Radius)

        Case "V"

            Call Stellar_Definition(StarClass, DecimalClass, SizeV, Radius)

        Case "VI"

            Call Stellar_Definition(StarClass, DecimalClass, SubDwarf, Radius)

    End Select

    

    Calculate_Stellar_Radii = Radius                'Set Return Value

End Function

Public Function Hab_Orbit(StarType, StarSize) As Double

'This function will return the orbit number for a given startype and size.  The data supplied (surpisingly enough)

'is the StarType and StarSize.



'Declare Variables

    Dim DecimalClass As Integer

    Dim StarClass As String

    Dim SubDwarf As Variant

    Dim Dwarf As Variant

    Dim SizeIa As Variant

    Dim SizeIb As Variant

    Dim SizeII As Variant

    Dim SizeIII As Variant

    Dim SizeIV As Variant

    Dim SizeV As Variant

    

'Define Variables

'I elected to evaluate using Arrays, rather than complex loops.  Fundementally, it is easier to change arrays than

're-logic out the series of nested For/Next loops or Case statements.  I'm hoping this will make upgrading the

'software easier when T-5 is released.



    DecimalClass = Val(Right(StarType, 1))

    StarClass = Left(StarType, 1)

    SubDwarf = Array(-1, -1, -1, -1, -1, 3, 2, 1, 1, -1, -1, -1, -1)

    Dwarf = Array(0, 0, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1)

    SizeIa = Array(13, 12, 12, 12, 12, 11, 12, 12, 12, 12, 12, 12, 12)

    SizeIb = Array(12, 11, 11, 10, 10, 10, 10, 10, 10, 11, 11, 12, 12)

    SizeII = Array(12, 11, 9, 8, 8, 8, 8, 8, 9, 9, 10, 11, 11)

    SizeIII = Array(12, 10, 8, 7, 6, 6, 6, 7, 7, 8, 8, 9, 9)

    SizeIV = Array(12, 9, 7, 6, 6, 5, 5, 5, 4, -1, -1, -1, -1)

    SizeV = Array(12, 9, 7, 6, 5, 4, 3, 2, 2, 0, 0, -1, -1)

    

'Evaluate by sending StarClass, DecimalClass and the Array being evaluated to another General Sub.  That General Sub actually

'returns the value (Hab_Orbit) that is the return value for this function.  The Stellar_Definition Sub is shared with the

'Calculate_Stellar_Radii Function



    Select Case StarSize

        Case "D"

            Call Stellar_Definition(StarClass, DecimalClass, Dwarf, Hab_Orbit)

        Case "Ia"

            Call Stellar_Definition(StarClass, DecimalClass, SizeIa, Hab_Orbit)

        Case "Ib"

            Call Stellar_Definition(StarClass, DecimalClass, SizeIb, Hab_Orbit)

        Case "II"

            Call Stellar_Definition(StarClass, DecimalClass, SizeII, Hab_Orbit)

        Case "III"

            Call Stellar_Definition(StarClass, DecimalClass, SizeIII, Hab_Orbit)

        Case "IV"

            Call Stellar_Definition(StarClass, DecimalClass, SizeIV, Hab_Orbit)

        Case "V"

            Call Stellar_Definition(StarClass, DecimalClass, SizeV, Hab_Orbit)

        Case "VI"

            Call Stellar_Definition(StarClass, DecimalClass, SubDwarf, Hab_Orbit)

    End Select



End Function

Public Function DieRoll(DieType As Integer)

'This function will return a simulated die roll.  The data supplied to this function is the die type -

'normally a d6 in traveller, but other types are occasionally used (which is why it is a variable, not

'a constant.



    DieRoll = Int((Rnd * DieType) + 1)



End Function



Public Function GasGiant(GGRoll As Integer)

'This Function will return the number of Gas Giants in a system.  The data supplied to this function is

'the raw die roll (2D6) for the number of Gas Giants in the system.



'Data Validation - ensure that the number evaluated is not less than 2 and not more than 12.



    If GGRoll < 2 Then

        GGRoll = 2

    ElseIf GGRoll > 12 Then

        GGRoll = 12

    End If

    

'Evaluate the data and set the return value.



    Select Case GGRoll

        Case 2, 3, 4

            GasGiant = 0

        Case 5

            GasGiant = 1

        Case 6

            GasGiant = 2

        Case 7, 8

            GasGiant = 3

        Case 9, 10

            GasGiant = 4

        Case 11, 12

            GasGiant = 5

    End Select

End Function

Public Function PlanetoidBelt(PBRoll As Integer)

'This function will return the number of Planetoid Belts in a system.  The data supplied to this function

'is the raw die roll (2D6 with modifiers) for the number of PB's in the system.



'Validate the data.  Ensure the number is not less than 2 (which results in 0 planetoids anyway) and not

'more than 13 (which maxes out the number at 3).



    If PBRoll < 2 Then

        PBRoll = 2

    ElseIf PBRoll > 13 Then

        PBRoll = 13

    End If

    

'Run the selection process and set the return value.



    Select Case PBRoll

        Case 2, 3, 4, 5, 6, 7

            PlanetoidBelt = 0

        Case 8, 9

            PlanetoidBelt = 1

        Case 10, 11, 12

            PlanetoidBelt = 2

        Case 13

            PlanetoidBelt = 3

    End Select

End Function

Public Function To_Decimal(Read As String) As Integer

'The purpose of this function is to decode a hex entry and return the numeric value it refers to.

'Declare Variables

    Dim A As Integer



'Evaluate

    For A = 1 To 17

        If (Read = Hex(A)) Then

            To_Decimal = A

        End If

    Next

End Function


Public Function Travel_Time(TravelTime As Double) As String
'Revised by Jason Kemp (jason.kemp@tdh.state.tx.us)
'Included into the build 12/10/98

'Declare Variables
    Dim A As Integer
    Dim Seconds As Double
    Dim Minutes As Integer
    Dim Hours As Integer
    Dim Days As Integer
    Dim Weeks As Integer
    Dim WeekMult As Double
    Dim DayMult As Double
    Dim HourMult As Double

'Define Variables
    Seconds = 0
    Minutes = 0
    Hours = 0
    Days = 0
    Weeks = 0
    WeekMult = (60 ^ 2) * 24 * 7
    DayMult = (60 ^ 2) * 24
    HourMult = 60 ^ 2

'Evaluate
    Weeks = Int(TravelTime / WeekMult)              'Calculates the number of Weeks
    TravelTime = TravelTime - (Weeks * WeekMult)    'Removes the number of seconds due to weeks
    
    Days = Int(TravelTime / DayMult)                'Calculates the number of Days Left
    TravelTime = TravelTime - (Days * DayMult)      'Removes the number of seconds due to days
    
    Hours = Int(TravelTime / (HourMult)) 'Calculates the number of hours Left
    TravelTime = TravelTime - (Days * HourMult) 'Removes the number of seconds due to hours
    
    Minutes = Int(TravelTime / 60) 'Calculates the number of minutes Left
    TravelTime = TravelTime - (Minutes * 60) 'Removes the number of seconds due to minutes
    
    Seconds = TravelTime 'That's all that's left over.
    
    If Weeks > 0 Then 
	Travel_Time = Str(Weeks) & "w " 
    Else
	Travel_Time = ""
    End If
    
    If Days > 0 Then
	Travel_Time = Travel_Time & Str(Days) & "d "
    End If
    
    If Hours > 0 Then
	Travel_Time = Travel_Time & Str(Hours) & "h "
    End If
    
    If Minutes > 0 Then 
	 Travel_Time = Travel_Time & Str(Minutes) & "m "
    End If
    
    Travel_Time = Travel_Time & Str(Int(Seconds)) & "s"
End Function