Προς το περιεχόμενο

Πρόγραμμα σε V.Basic για 31


nick_gr

Προτεινόμενες αναρτήσεις

Δημοσ.

Καλησπέρα ένας φίλος μου έχει σαν εργασία την δημιουργία ενός προγράμματος στην Visual Basic, για να "παίζει" το γνωστο πρωτοχρονιάτικο παιχνίδι "τριανταμία" με αντίπαλο τον Η/Υ.

 

Σας αναφέρω τον κώδικα και το τι προβλήματα έχει συναντήσει..

 

Form Code

 

>
Option Explicit

Private Sub Form_Load()
Randomize
SetUpDeck
clearMessages
End Sub

Private Sub form_activate()
CmdNewGame.SetFocus
End Sub

Public Sub clearMessages()
Image1 = LoadPicture()
Image2 = LoadPicture()
Image3 = LoadPicture()
Image4 = LoadPicture()
TxtCardId = ""
TxtSuit = ""
TxtRank = ""
TxtValue = ""
TxtTotal1 = ""
TxtTotal2 = ""
TxtSuit2 = ""
TxtRank2 = ""
TxtValue2 = ""
TxtcardId2 = ""
End Sub

Private Sub CmdDeal_Click()
Dim c As Card
c = Deal()
TxtCardId = c.Id
TxtSuit = Choose(c.Suit, "σπαθι", "καρο", "μπαστουνι", "κουπα")
Image1 = LoadPicture(c.IconFile)
Image2 = LoadPicture(c.ImageFile)
TxtRank = c.Rank
TxtValue = value(c)
'TxtTotal1 =
End Sub

Private Sub CmdShuffle_Click()
Shuffle
clearMessages
End Sub

Private Sub CmdStart_Click()
SetUpDeck
clearMessages
End Sub

Private Sub CmdNewGame_Click()
Shuffle
clearMessages
Dim c As Card
c = Deal()
TxtCardId = c.Id
TxtSuit = Choose(c.Suit, "Óðáèß", "Êáñü", "Ìðáóôïýíé", "Êïýðá")
Image1 = LoadPicture(c.IconFile)
Image2 = LoadPicture(c.ImageFile)
TxtRank = c.Rank
TxtValue = value(c)
TxtTotal1 = value(c)
TxtcardId2 = c.Id
TxtSuit2 = Choose(c.Suit, "σπαθι", "καρο", "μπαστουνι", "κουπα")
Image3 = LoadPicture(c.IconFile)
Image4 = LoadPicture(c.ImageFile)
TxtRank2 = c.Rank
TxtValue2 = value(c)
TxtTotal2 = value(c)
End Sub

Private Sub CmdEnd_click()
ʽTxtTotal1 = 
CmdDeal.Click.Enabled = False
Dim c As Card
c = Deal()
TxtcardId2 = c.Id
TxtSuit2 = Choose(c.Suit, "σπαθι", "καρο", "μπαστουνι", "κουπα")
Image3 = LoadPicture(c.IconFile)
Image4 = LoadPicture(c.ImageFile)
TxtRank2 = c.Rank
TxtValue2 = value(c)
'TxtTotal2 = 
Do Until Txttotal2 > Txttotal1
If Txttotal2 > 31 Then MsgBox "the user wins the pc"
Loop
ʽTxtTotal2 = 
End Sub

 

Module Code

 

>
Enum CardColour
Club = 1
Diamond
Spade
Heart
End Enum

Public Type Card
Id As Byte
Suit As CardColour
Rank As String
IconFile As String
ImageFile As String
End Type

Dim Deck(1 To 52) As Card
Dim Position1 As Byte
Dim Position2 As Byte

Public Sub SetUpDeck()
Dim c, S, Tmp As Integer
For S = 1 To 4
For c = 1 To 13
Tmp = (S - 1) * 13 + c
With Deck(Tmp)
.Id = Tmp
.Suit = S
.Rank = Switch(c = 1, "ασσος", c = 11, "βαλες", c = 12, "νταμα", c = 13, "ρηγας", (c > 1 And c < 11), c)
.IconFile = App.Path & "\" & Choose(S, "club.ico", "diamond.ico", "spade.ico", "heart.ico")
.ImageFile = App.Path & "\" & "C" & Tmp & ".gif"
End With
Next c
Next S
Position1 = 1
Position2 = 1
End Sub

Public Function Deal() As Card
Deal = Deck(Position1)
Deal = Deck(Position2)
If Position1 = 52 Then Position1 = 1 Else Position1 = Position1 + 1
If Position2 = 52 Then Position2 = 1 Else Position2 = Position2 + 1
End Function

Public Sub Shuffle()
Dim Pos1, Pos2, c
Dim Tmp As Card
For c = 1 To 52
Pos1 = Int(Rnd * 52) + 1
Pos2 = Int(Rnd * 52) + 1
Tmp = Deck(c)
Deck(c) = Deck(Pos1)
Deck(c) = Deck(Pos2)
Deck(Pos1) = Tmp
Deck(Pos2) = Tmp
Next c
Position = 1
Position2 = 1
End Sub

Public Function value(c As Card) As Byte
Select Case c.Rank
Case "βαλες", "νταμα", "ρηγας": value = 10
Case "ασσος": value = 1
Case Else
value = c.Id Mod 13
End Select
End Function

 

1)Me to pou ksekinaei me to koumpi cmdNewGame thelo na moirazei mia tixaia karta se emena kai mia sto pc alla moirazei thn idia.ayto pos tha to ftiakso;

 

2)Meta thelo patontas to koumpi cmdDeal na moirazei mia karta se emena mono kai

ayto to exo petyxei.thelo omos na metraei thn aksia ths proths kartas pou moirase arxika kai na thn prosthetei me thn aksia ths epomenhs kartas oso patao to koumpi

cmdDeal kai to apotelesma na vgainei sto txttotal1.h synarthsh value© upologizei thn aksia.

 

3)me to koumpi cmdEnd thelo me to pou to patao na krataei to apotelesma ths txttotal1 kai na to sigrinei me to apotelesma pou tha kanei to pc kai poy tha fainetai

sto txttotal2.exo grapsei kapoio kodika alla den ton exo teleiosei kai exei kapoia lathi.

 

Αν μπορεί κάποιος ας βοηθήσει..

Ευχαριστώ

Δημοσ.

Για το πρώτο που ρωτάς πρέπει να κάνεις χρήση της συναρτησης Randomize και στο module. Στην συνάρτηση Shuffle. για τα υπόλοιπα θα τα δω όταν έχω περισσότερο χρόνο να υλοποιήσω τον κώδικα που παραθέτεις.

Αρχειοθετημένο

Αυτό το θέμα έχει αρχειοθετηθεί και είναι κλειστό για περαιτέρω απαντήσεις.

  • Δημιουργία νέου...