Tic Tac Teo:
' Program for tic tac toe Human vs human
Dim cross(8) As Boolean
Dim ball(8) As Boolean
Dim m As Integer
Dim player As Integer
Sub check_status()
If ball(0) = True And ball(1) = True And ball(2) = True Then
Line10.Visible = True
End If
If ball(3) = True And ball(4) = True And ball(5) = True Then
Line9.Visible = True
End If
If ball(6) = True And ball(7) = True And ball(8) = True Then
Line8.Visible = True
End If
If ball(0) = True And ball(3) = True And ball(6) = True Then
Line5.Visible = True
End If
If ball(1) = True And ball(4) = True And ball(7) = True Then
Line6.Visible = True
End If
If ball(2) = True And ball(5) = True And ball(8) = True Then
Line7.Visible = True
End If
If ball(0) = True And ball(4) = True And ball(8) = True Then
Line12.Visible = True
End If
If ball(2) = True And ball(4) = True And ball(6) = True Then
Line11.Visible = True
End If
If cross(0) = True And cross(1) = True And cross(2) = True Then
Line10.Visible = True
End If
If cross(3) = True And cross(4) = True And cross(5) = True Then
Line9.Visible = True
End If
If cross(6) = True And cross(7) = True And cross(8) = True Then
Line8.Visible = True
End If
If cross(0) = True And cross(3) = True And cross(6) = True Then
Line5.Visible = True
End If
If cross(1) = True And cross(4) = True And cross(7) = True Then
Line6.Visible = True
End If
If cross(2) = True And cross(5) = True And cross(8) = True Then
Line7.Visible = True
End If
If cross(0) = True And cross(4) = True And cross(8) = True Then
Line12.Visible = True
End If
If cross(2) = True And cross(4) = True And cross(6) = True Then
Line11.Visible = True
End If
End Sub
Sub check_position()
For m = 0 To 8
If Image1(m).Picture = Image2.Picture Then
ball(m) = True
Else: ball(m) = False
End If
If Image1(m).Picture = Image3.Picture Then
cross(m) = True
Else
cross(m) = False
End If
Next
End Sub
Private Sub Image1_Click(Index As Integer)
check_position
If player = 1 And cross(Index) = False And ball(Index) = False Then
Image1(Index).Picture = Image2.Picture
End If
If player = 2 And cross(Index) = False And ball(Index) = False Then
Image1(Index).Picture = Image3.Picture
End If
check_position
check_status
End Sub
Private Sub Image2_Click()
player = 1
End Sub
Private Sub Image3_Click()
player = 2
End Sub
Private Sub mnuNew_Click()
For m = 0 To 8
Image1(m).Picture = LoadPicture("")
Next
Line5.Visible = False
Line6.Visible = False
Line7.Visible = False
Line8.Visible = False
Line9.Visible = False
Line10.Visible = False
Line11.Visible = False
Line12.Visible = False
End SubSub
Output:
Snake and Ladder:
'Snake and ladder program
Option Base 1
Dim c(10) As Variant
Dim r(10) As Variant
Dim x As Integer
Dim m As Integer
Dim n As Integer
Dim num As Integer
Dim totalnum As Single
Dim totalnum1 As Single
Dim player As Integer
Dim t As Integer
Private Sub Command2_Click()
'To move the chess pieces to the original position
Image1(0).Move 10200, 5520
Image1(1).Move 10200, 6480
totalnum = 0
totalnum1 = 0
Label2.Caption = ""
MMControl1.Command = "close"
End Sub
Private Sub Command3_Click()
End
End Sub
Private Sub Form_Load()
' To assign the column and row coordinates to all the boxes
c(1) = 600
r(1) = 8200
For i = 1 To 9
c(i + 1) = c(i) + 800
Next
For j = 1 To 9
r(j + 1) = r(j) - 800
Next
End Sub
'To initiate the rolling of dice
Private Sub roll()
x = x + 10
Randomize Timer
n = Int(1 + Rnd * 6)
For i = 0 To 6
Shape1(i).Visible = False
Next
If n = 1 Then
Shape1(3).Visible = True
Shape2.FillColor = &HC0C0C0
End If
If n = 2 Then
Shape1(2).Visible = True
Shape1(4).Visible = True
Shape2.FillColor = &H8080FF
End If
If n = 3 Then
Shape1(2).Visible = True
Shape1(3).Visible = True
Shape1(4).Visible = True
Shape2.FillColor = &H80FF&
End If
If n = 4 Then
Shape1(0).Visible = True
Shape1(2).Visible = True
Shape1(4).Visible = True
Shape1(6).Visible = True
Shape2.FillColor = &HFFFF00
End If
If n = 5 Then
Shape1(0).Visible = True
Shape1(2).Visible = True
Shape1(3).Visible = True
Shape1(4).Visible = True
Shape1(6).Visible = True
Shape2.FillColor = &HFFFF&
End If
If n = 6 Then
Shape1(0).Visible = True
Shape1(1).Visible = True
Shape1(2).Visible = True
Shape1(4).Visible = True
Shape1(5).Visible = True
Shape1(6).Visible = True
Shape2.FillColor = &HFF00FF
End If
End Sub
Private Sub Command1_Click(Index As Integer)
'To indentify which player click the roll dice command
If Index = 0 Then
player = 1
End If
If Index = 1 Then
player = 2
End If
Timer1.Enabled = True
x = 0
End Sub
Private Sub Timer1_Timer()
If x < 100 Then
Call roll
Else
Timer1.Enabled = False
'To check the number on the dice
If Shape1(3).Visible = True Then
num = 1
End If
If (Shape1(2).Visible = True) And (Shape1(4).Visible = True) Then
num = 2
End If
If (Shape1(2).Visible = True) And (Shape1(3).Visible = True) And (Shape1(4).Visible = True) Then
num = 3
End If
If (Shape1(0).Visible = True) And (Shape1(2).Visible = True) And (Shape1(4).Visible = True) And (Shape1(6).Visible = True) Then
num = 4
End If
If (Shape1(0).Visible = True) And (Shape1(2).Visible = True) And (Shape1(3).Visible = True) And (Shape1(4).Visible = True) And (Shape1(6).Visible = True) Then
num = 5
End If
If (Shape1(0).Visible = True) And (Shape1(1).Visible = True) And (Shape1(2).Visible = True) And (Shape1(4).Visible = True) And (Shape1(5).Visible = True) Then
num = 6
End If
'To move player 1 according to the total score of the dice
'Movement across colum1 to column 10 and row 1 to row 10
If player = 1 Then
totalnum = totalnum + num
If totalnum < 11 Then
Image1(0).Move c(totalnum), r(1)
If totalnum = 10 Then
Image1(0).Move c(8), r(3)
totalnum = 28
End If
End If
If totalnum > 10 And totalnum < 21 Then
Image1(0).Move c(21 - totalnum), r(2)
If totalnum = 17 Then
Image1(0).Move c(4), r(4)
totalnum = 37
End If
End If
If totalnum > 20 And totalnum < 31 Then
Image1(0).Move c(totalnum - 20), r(3)
End If
If totalnum > 30 And totalnum < 41 Then
Image1(0).Move c(41 - totalnum), r(4)
If totalnum = 34 Then
Image1(0).Move c(5), r(2)
totalnum = 16
End If
If totalnum = 31 Then
Image1(0).Move c(10), r(7)
totalnum = 70
End If
End If
If totalnum > 40 And totalnum < 51 Then
Image1(0).Move c(totalnum - 40), r(5)
If totalnum = 45 Then
Image1(0).Move c(4), r(9)
totalnum = 84
End If
If totalnum = 44 Then
Image1(0).Move c(1), r(3)
totalnum = 21
End If
End If
If totalnum > 50 And totalnum < 61 Then
Image1(0).Move c(61 - totalnum), r(6)
End If
If totalnum > 60 And totalnum < 71 Then
Image1(0).Move c(totalnum - 60), r(7)
If totalnum = 68 Then
Image1(0).Move c(8), r(5)
totalnum = 48
End If
End If
Iftotalnum1 > 70 And totalnum1 < 81 Then
Image1(1).Move c(81 - totalnum1), r(8)
If totalnum1 = 79 Then
Image1(1).Move c(2), r(6)
totalnum1 = 59
End If
If totalnum1 = 78 Then
Image1(1).Move c(4), r(10)
totalnum1 = 97
End If
End If
If totalnum1 > 80 And totalnum1 < 91 Then
Image1(1).Move c(totalnum1 - 80), r(9)
End If
If totalnum1 > 90 And totalnum1 < 101 Then
Image1(1).Move c(101 - totalnum1), r(10)
If totalnum1 = 95 Then
Image1(1).Move c(8), r(8)
totalnum1 = 73
End If
End If
If totalnum1 > 100 Or totalnum1 = 100 Then
Image1(1).Move c(1), r(10)
End If
End If
'To play the applause sound when any one player reach 100
If (totalnum > 100 Or totalnum = 100) And totalnum1 < 100 Then
Label2.Caption = "Player 1 Wins"
MMControl1.Notify = False
MMControl1.Wait = True
MMControl1.Shareable = False
MMControl1.DeviceType = "WaveAudio"
MMControl1.FileName = "D:\Liew Folder\VB program\audio\applause.wav"
MMControl1.Command = "Open"
MMControl1.Command = "Play"
End If
If (totalnum1 > 100 Or totalnum1 = 100) And totalnum < 100 Then
Label2.Caption = "Player 2 Wins"
MMControl1.Notify = False
MMControl1.Wait = True
MMControl1.Shareable = False
MMControl1.DeviceType = "WaveAudio"
MMControl1.FileName = "D:\Liew Folder\VB program\audio\applause.wav"
MMControl1.Command = "Open"
MMControl1.Command = "Play"
End If
End If
End Sub
Private Sub Timer2_Timer()
delay
If t < 1000 Then
Else
Timer2.Enabled = False
End If
End Sub
Sub delay()
t = t + 1
End Sub
Output:
