Turn on thread page Beta

AS Computing Student watch

    • Thread Starter
    Offline

    1
    ReputationRep:
    Hey Could tell me what i could do to keep my code up on the screen. it closes as soon as i try to run it.

    Module Module1


    ' maximum number of players and scores
    ' Possible question
    ' What is the purpose of this constant?
    'Program readability
    Const NoOfRecentScores As Integer = 3
    ' Creating or defining structure
    'called Tcard (this the structure type)
    'Tcard is a structure type
    Structure TCard
    Dim Suit As Integer
    Dim Rank As Integer
    End Structure
    'Creating a structure called TRecentScore
    Structure TRecentScore
    Dim Name As String
    Dim Score As Integer
    End Structure


    Sub Main()
    Dim Choice As Char
    'Declaring an array of record of 53 element,
    'but will not use record 0
    Dim Deck(52) As TCard
    'Declaring an array of record of 4 element,
    'but will not use record 0
    Dim RecentScores(NoOfRecentScores) As TRecentScore
    'Is a function that is used in conjunction
    'with Rnd() function
    Randomize()
    Do
    'Sub procedure DisplayMenu() call
    DisplayMenu()
    'The right hand side is the Function call
    ' The left value takes what the function retuns
    Choice = GetMenuChoice()
    'In the following selection block, lines of
    'code are executed
    'depending on the value of variable choice
    Select Case Choice
    Case "1"
    'Sub prosedure call that accepts
    'the array of record
    LoadDeck(Deck)
    'Sub prosedure call that accepts
    'the array of record with data
    ShuffleDeck(Deck)
    PlayGame(Deck, RecentScores)
    Case "2"
    LoadDeck(Deck)
    PlayGame(Deck, RecentScores)
    Case "3"
    DisplayRecentScores(RecentScores )
    Case "4"
    ResetRecentScores(RecentScores)
    End Select
    console.readline()
    Loop Until Choice = "q"


    End Sub


    Function GetRank(ByVal RankNo As Integer) As String
    Dim Rank As String = ""
    ' This function accepts the code for the card picked
    'and return the name of the card
    Select Case RankNo
    Case 1 : Rank = "Ace"
    Case 2 : Rank = "Two"
    Case 3 : Rank = "Three"
    Case 4 : Rank = "Four"
    Case 5 : Rank = "Five"
    Case 6 : Rank = "Six"
    Case 7 : Rank = "Seven"
    Case 8 : Rank = "Eight"
    Case 9 : Rank = "Nine"
    Case 10 : Rank = "Ten"
    Case 11 : Rank = "Jack"
    Case 12 : Rank = "Queen"
    Case 13 : Rank = "King"
    End Select
    Return Rank
    End Function


    Function GetSuit(ByVal SuitNo As Integer) As String
    Dim Suit As String = ""


    ' this function accepts the code for the suit and return the name
    Select Case SuitNo
    Case 1 : Suit = "Clubs"
    Case 2 : Suit = "Diamonds"
    Case 3 : Suit = "Hearts"
    Case 4 : Suit = "Spades"
    End Select
    Return Suit
    End Function


    Sub DisplayMenu()
    ' subprocedure definition or code
    ' When executed will desplay the items of the menu
    Console.WriteLine()
    Console.WriteLine("MAIN MENU")
    Console.WriteLine()
    Console.WriteLine("1. Play game (with shuffle)")
    Console.WriteLine("2. Play game (without shuffle)")
    Console.WriteLine("3. Display recent scores")
    Console.WriteLine("4. Reset recent scores")
    Console.WriteLine()
    Console.Write("Select an option from the menu (or enter q to quit): ")
    console.readline()
    End Sub


    Function GetMenuChoice() As Char
    Dim Choice As Char
    Choice = Console.ReadLine
    Console.WriteLine()
    Return Choice
    End Function
    ' Call ByRef means accessing or processing
    'records in the main program
    Sub LoadDeck(ByRef Deck() As TCard)
    Dim Count As Integer
    ' it opens deck.text for input or reading
    'operations()
    FileOpen(1, "deck.txt", OpenMode.Input)
    Count = 1
    ' Read the file one line at a time into
    'elements of deck of cards
    While Not EOF(1)
    Deck(Count).Suit = CInt(LineInput(1))
    Deck(Count).Rank = CInt(LineInput(1))
    ' Increment counter so it reads all the
    'records one at a time
    Count = Count + 1
    End While
    '
    FileClose(1)
    End Sub


    Sub ShuffleDeck(ByRef Deck() As TCard)
    Dim NoOfSwaps As Integer
    Dim Position1 As Integer
    Dim Position2 As Integer
    Dim SwapSpace As TCard
    Dim NoOfSwapsMadeSoFar As Integer
    ' The following variable is set to 1000
    'so it will swap records 1000 times
    'It does so, by generating two random
    'numbers, use them as index for records
    'and then swap the contents
    NoOfSwaps = 1000
    For NoOfSwapsMadeSoFar = 1 To NoOfSwaps
    ' Generate random number between 1 and 52
    'convert into integer
    ' and assign to varaible position 1
    Position1 = Int(Rnd() * 52) + 1
    ' Generate random number between 1 and 52
    'convert into integer
    ' and assign to varaible position 2
    Position2 = Int(Rnd() * 52) + 1
    ' copy card type and number to a record
    ' called SwapSpace
    SwapSpace = Deck(Position1)
    Deck(Position1) = Deck(Position2)
    Deck(Position2) = SwapSpace
    Next
    End Sub








    Sub DisplayCard(ByVal ThisCard As TCard)
    Console.WriteLine()
    Console.WriteLine("Card is the " & GetRank(ThisCard.Rank) & " of " & GetSuit(ThisCard.Suit))
    Console.WriteLine()
    End Sub


    Sub GetCard(ByRef ThisCard As TCard, ByRef Deck() As TCard, ByVal NoOfCardsTurnedOver As Integer)
    Dim Count As Integer
    ThisCard = Deck(1)
    For Count = 1 To (51 - NoOfCardsTurnedOver)
    Deck(Count) = Deck(Count + 1)
    Next
    Deck(52 - NoOfCardsTurnedOver).Suit = 0
    Deck(52 - NoOfCardsTurnedOver).Rank = 0
    End Sub


    Function IsNextCardHigher(ByVal LastCard As TCard, ByVal NextCard As TCard) As Boolean
    Dim Higher As Boolean
    Higher = False
    If NextCard.Rank > LastCard.Rank Then
    Higher = True
    End If
    Return Higher
    End Function


    Function GetPlayerName() As String
    Dim PlayerName As String
    Console.WriteLine()
    Console.Write("Please enter your name: ")
    PlayerName = Console.ReadLine
    Console.WriteLine()
    Return PlayerName
    End Function


    Function GetChoiceFromUser() As Char
    Dim Choice As Char
    Console.Write("Do you think the next card will be higher than the last card (enter y or n)? ")
    Choice = Console.ReadLine
    Return Choice
    End Function


    Sub DisplayEndOfGameMessage(ByVal Score As Integer)
    Console.WriteLine()
    Console.WriteLine("GAME OVER!")
    Console.WriteLine("Your score was " & Score)
    If Score = 51 Then
    Console.WriteLine("WOW! You completed a perfect game.")
    End If
    Console.WriteLine()
    End Sub


    Sub DisplayCorrectGuessMessage(ByVal Score As Integer)
    Console.WriteLine()
    Console.WriteLine("Well done! You guessed correctly.")
    Console.WriteLine("Your score is now " & Score & ".")
    console.writeline()
    Console.Readline()
    End Sub




    Sub ResetRecentScores(ByRef RecentScores() As TRecentScore)
    Dim Count As Integer
    For Count = 1 To NoOfRecentScores
    RecentScores(Count).Name = ""
    RecentScores(Count).Score = 0
    Next
    console.readline()
    End Sub


    Sub DisplayRecentScores(ByVal RecentScores() As TRecentScore)
    Dim Count As Integer
    Console.WriteLine()
    Console.WriteLine("Recent scores:")
    Console.WriteLine()
    For Count = 1 To NoOfRecentScores
    Console.WriteLine(RecentScores(C ount).Name & " got a score of " & RecentScores(Count).Score)
    Next
    Console.WriteLine()
    Console.WriteLine("Press the Enter key to return to the main menu")
    Console.WriteLine()
    Console.ReadLine()
    End Sub


    Sub UpdateRecentScores(ByRef RecentScores() As TRecentScore, ByVal Score As Integer)
    Dim PlayerName As String
    Dim Count As Integer
    Dim FoundSpace As Boolean
    PlayerName = GetPlayerName()
    FoundSpace = False
    Count = 1
    While Not FoundSpace And Count <= NoOfRecentScores
    If RecentScores(Count).Name = "" Then
    FoundSpace = True
    Else
    Count = Count + 1
    End If
    End While
    If Not FoundSpace Then
    For Count = 1 To NoOfRecentScores - 1
    RecentScores(Count) = RecentScores(Count + 1)
    Next
    Count = NoOfRecentScores
    End If
    RecentScores(Count).Name = PlayerName
    RecentScores(Count).Score = Score
    console.readline()
    End Sub


    Sub PlayGame(ByVal Deck() As TCard, ByRef RecentScores() As TRecentScore)
    Dim NoOfCardsTurnedOver As Integer
    Dim GameOver As Boolean
    Dim NextCard As TCard
    Dim LastCard As TCard
    Dim Higher As Boolean
    Dim Choice As Char
    GameOver = False
    GetCard(LastCard, Deck, 0)
    DisplayCard(LastCard)
    NoOfCardsTurnedOver = 1
    While NoOfCardsTurnedOver < 52 And Not GameOver
    GetCard(NextCard, Deck, NoOfCardsTurnedOver)
    Do
    Choice = GetChoiceFromUser()
    Loop Until Choice = "y" Or Choice = "n"
    DisplayCard(NextCard)
    NoOfCardsTurnedOver = NoOfCardsTurnedOver + 1
    Higher = IsNextCardHigher(LastCard, NextCard)
    If Higher And Choice = "y" Or Not Higher And Choice = "n" Then
    DisplayCorrectGuessMessage(NoOfC ardsTurnedOver - 1)
    LastCard = NextCard
    Else
    GameOver = True
    End If
    End While
    If GameOver Then
    DisplayEndOfGameMessage(NoOfCard sTurnedOver - 2)
    UpdateRecentScores(RecentScores, NoOfCardsTurnedOver - 2)
    Else
    DisplayEndOfGameMessage(51)
    UpdateRecentScores(RecentScores, 51)
    End If
    console.readline()
    End Sub
    End Module
    •  Official Rep
    Offline

    16
    ReputationRep:
     Official Rep
    Sorry you've not had any responses about this. Are you sure you’ve posted in the right place? Posting in the specific Study Help forum should help get responses.

    I'm going to quote in Puddles the Monkey now so she can move your thread to the right place if it's needed. :yy:

    Spoiler:
    Show
    (Original post by Puddles the Monkey)
    x
 
 
 

University open days

  • University of East Anglia
    All Departments Open 13:00-17:00. Find out more about our diverse range of subject areas and career progression in the Arts & Humanities, Social Sciences, Medicine & Health Sciences, and the Sciences. Postgraduate
    Wed, 30 Jan '19
  • Aston University
    Postgraduate Open Day Postgraduate
    Wed, 30 Jan '19
  • Solent University
    Careers in maritime Undergraduate
    Sat, 2 Feb '19
Poll
Brexit: Given the chance now, would you vote leave or remain?
Help with your A-levels

All the essentials

The adventure begins mug

Student life: what to expect

What it's really like going to uni

Rosette

Essay expert

Learn to write like a pro with our ultimate essay guide.

Uni match

Uni match

Our tool will help you find the perfect course for you

Study planner

Create a study plan

Get your head around what you need to do and when with the study planner tool.

Study planner

Resources by subject

Everything from mind maps to class notes.

Hands typing

Degrees without fees

Discover more about degree-level apprenticeships.

A student doing homework

Study tips from A* students

Students who got top grades in their A-levels share their secrets

Study help links and info

Can you help? Study help unanswered threadsRules and posting guidelines

Groups associated with this forum:

View associated groups

The Student Room, Get Revising and Marked by Teachers are trading names of The Student Room Group Ltd.

Register Number: 04666380 (England and Wales), VAT No. 806 8067 22 Registered Office: International House, Queens Road, Brighton, BN1 3XE

Write a reply...
Reply
Hide
Reputation gems: You get these gems as you gain rep from other members for making good contributions and giving helpful advice.