Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/tab100/board.frm

Visual Basic Form | 1995-10-23 | 6.5 KB | 233 lines

VERSION 2.00
Begin Form Form1
   BackColor       =   &H0000C000&
   Caption         =   "Cards"
   ClientHeight    =   4605
   ClientLeft      =   855
   ClientTop       =   1785
   ClientWidth     =   7875
   Height          =   5295
   Icon            =   BOARD.FRX:0000
   Left            =   795
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   ScaleHeight     =   4605
   ScaleWidth      =   7875
   Top             =   1155
   Width           =   7995
   Begin TextBox Bet
      BackColor       =   &H0000FFFF&
      ForeColor       =   &H00C00000&
      Height          =   375
      Left            =   3120
      TabIndex        =   6
      Top             =   3600
      Width           =   1575
   End
   Begin CommandButton Deal
      Caption         =   "Deal"
      Height          =   495
      Left            =   1680
      TabIndex        =   0
      Top             =   3480
      Width           =   975
   End
   Begin CommandButton TurnCard
      Caption         =   "Turn Card"
      Height          =   1455
      Left            =   3120
      TabIndex        =   5
      Top             =   1920
      Width           =   1575
   End
   Begin PictureBox Picture1
      AutoSize        =   -1  'True
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   0  'None
      DragMode        =   1  'Automatic
      Height          =   1455
      Index           =   3
      Left            =   1680
      ScaleHeight     =   1455
      ScaleWidth      =   1095
      TabIndex        =   4
      Top             =   1920
      Width           =   1095
   End
   Begin PictureBox Picture1
      AutoSize        =   -1  'True
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   0  'None
      DragMode        =   1  'Automatic
      Height          =   1455
      Index           =   2
      Left            =   3120
      ScaleHeight     =   1455
      ScaleWidth      =   1095
      TabIndex        =   3
      Top             =   120
      Width           =   1095
   End
   Begin PictureBox Picture1
      AutoSize        =   -1  'True
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   0  'None
      DragMode        =   1  'Automatic
      Height          =   1455
      Index           =   1
      Left            =   1680
      ScaleHeight     =   1455
      ScaleWidth      =   1095
      TabIndex        =   2
      Top             =   120
      Width           =   1095
   End
   Begin PictureBox Picture1
      AutoSize        =   -1  'True
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   0  'None
      DragMode        =   1  'Automatic
      Height          =   1455
      Index           =   0
      Left            =   240
      ScaleHeight     =   1455
      ScaleWidth      =   1095
      TabIndex        =   1
      Top             =   120
      Width           =   1095
   End
   Begin Label Pot
      BackColor       =   &H0000FFFF&
      BorderStyle     =   1  'Fixed Single
      ForeColor       =   &H000000FF&
      Height          =   255
      Left            =   5400
      TabIndex        =   7
      Top             =   600
      Width           =   1455
   End
   Begin Label Label1
      BackColor       =   &H0000FFFF&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Pot ($)"
      ForeColor       =   &H000000FF&
      Height          =   255
      Left            =   4680
      TabIndex        =   8
      Top             =   600
      Width           =   735
   End
   Begin Menu File
      Caption         =   "&File"
      Begin Menu FileNew
         Caption         =   "&New Game"
         Shortcut        =   {F2}
      End
      Begin Menu FileExit
         Caption         =   "E&xit"
      End
   End
   Begin Menu Help
      Caption         =   "Help"
      Begin Menu HelpAbout
         Caption         =   "&About"
      End
   End
DefInt A-Z
Dim CardNo As Integer
Sub CheckForWin (Flag As Integer)
    Dim C1 As Integer
    Dim C2 As Integer
    Flag = False
    For i = 0 To 2
        If SameSuit(Cards(Val(Picture1(i).Tag)), Cards(Val(Picture1(3).Tag))) Then
            C1 = CardValue(Cards(Val(Picture1(i).Tag)))
            C2 = CardValue(Cards(Val(Picture1(3).Tag)))
            If C2 > C1 Then
                Flag = True
                Exit Sub
            End If
        End If
    Next i
End Sub
Sub Deal_Click ()
    For i = 0 To 2
        If CardNo > 52 Then
            ShuffleCards
            CardNo = 1
        End If
        GetCard (Cards(CardNo))
        Picture1(i).Picture = ClipBoard.GetData(2)
        Picture1(i).Tag = Str$(CardNo)
        CardNo = CardNo + 1
    Next i
    GetCardBack (1)
    Picture1(3).Picture = ClipBoard.GetData(2)
    Picture1(3).Tag = Str$(CardNo)
    CardNo = CardNo + 1
End Sub
Sub FileExit_Click ()
    End
End Sub
Sub FileNew_Click ()
   ShuffleCards
   CardNo = 1
   Pot.Caption = "100"
   Bet.Text = "0"
   Deal_Click
End Sub
Sub Form_Load ()
    FileNew_Click
    Num = 1
End Sub
Sub HelpAbout_Click ()
'   Form3.Show 1
End Sub
Sub TurnCard_Click ()
Dim i As Integer
Dim Win As Integer
Dim NumPot As Double
Dim NumBet As Double
    NumPot = Val(Pot.Caption)
    NumBet = Val(Bet.Text)
    If NumBet = 0 Then
        MsgBox ("Cannot turn card without a bet")
        Exit Sub
    End If
    If NumBet > NumPot Then
        MsgBox ("You cannot bet more than you have")
        Exit Sub
    End If
    i = Val(Picture1(3).Tag)
    GetCard (Cards(i))
    Picture1(3).Picture = ClipBoard.GetData(2)
    CheckForWin Win
    If Win = True Then
        NumPot = NumPot + (NumBet * 2)
        NumBet = 0
        MsgBox ("You Win -- This Time")
    Else
        NumPot = NumPot - NumBet
        NumBet = 0
        MsgBox ("Lost Again Sucker")
    End If
    If NumPot = 0 Then
        MsgBoxResponse = MsgBox("Sorry You have lost your shirt, Do you wish to Play again (Yes/No)", 19)
        If MsgBoxResponse = 7 Then
            FileNew_Click
            Exit Sub
        Else
            FileExit_Click
            Exit Sub
        End If
    End If
    If NumPot > 1000000 Then
        MsgBoxResponse = MsgBox("The house has taken all your money, and thrown you out -- GoodBye")
        FileExit_Click
        Exit Sub
    End If
    Pot.Caption = Str$(NumPot)
    Bet.Text = "0"
    Deal_Click
End Sub