برنامه بازی منچ با قابليت بازي 2 تا 4 نفره

[ahmadfononi]

اين برنامه منچ ميتواند به صورت 2 و3 ويا 4 نفره بازي را انجام دهد.گرافيك بازي در فتوشاپ انجام گرفته و چنانچه علاقه مند باشيد گرافيك و فرمهاي آن را برايتان ارسال مي كنم .اين برنامه داراي 3 فرم مي باشد و برنامه اصلي درون frmmain قرار دارد .
با تشكر از توجه شما پريسا زارعي
' **** frm result ****از اين فرم براي نمايش نتيجه كمك گرفته ام
کد:

Private Sub Form_activate()
For i = 1 To 4
If finish(i) <> "" Then a = True
Next i
If a = True Then
For i = 1 To 4
Label1(i).Caption = finish(i)
Next i
Else
Label2.Caption = "there is not result"
End If
End Sub

Private Sub Label2_Click()

End Sub
'*******frmstart *****از اين فرم در شروع براي تعيين چند نفره بودن بازي كمك گرفته ام
Public i As Byte
Private Sub Command1_Click()
Unload Me
Load frmmain
'2 nafare
For j = 1 To 4
frmmain.mander(j).Tag = "r"
frmmain.mandey(j).Tag = "y"
Next j
'taeen tedad
Select Case i
Case 0
cont = 2
For j = 1 To 4
frmmain.mandeg(j).Tag = ""
frmmain.mandeb(j).Tag = ""
Next j
Case 1
cont = 3
For j = 1 To 4
frmmain.mandeg(j).Tag = "g"
Next j
For j = 1 To 4
frmmain.mandeb(j).Tag = ""
Next j
Case 2
cont = 4
For j = 1 To 4
frmmain.mandeg(j).Tag = "g"
frmmain.mandeb(j).Tag = "b"
Next j
End Select
frmmain.Show
End Sub​

 

[ahmadfononi]

Private Sub Command2_Click()
'exit
Unload Me
End Sub

Private Sub Form_Load()

End Sub

Private Sub Option1_Click(Index As Integer)
i = Index
End Sub
'***** frmmain***** سورس اصلي بازي در اين فرم قرار دارد
Public a As Boolean

Private Sub Command1_Click() 'tas
Randomize Timer
tas = Round(Rnd() * 5) + 1 'andakhtane tas
Label1.Caption = "tas= " & tas ' namayesh tas




If previusetas <> 6 Then 'jabejayee focus dar soorat lozoom
Select Case cont
Case 2
If focus = 2 Then focus = 1 Else focus = focus + 1
Case 3
If focus = 3 Then focus = 1 Else focus = focus + 1
Case 4
If focus = 4 Then focus = 1 Else focus = focus + 1
End Select
End If





Unload frmresult
previusetas = tas
For i = 1 To 4 ' namayesh focus
shape(i).Visible = False
Next i
shape(focus).Visible = True
If tas = 6 Then six (focus) 'if tas=6
End Sub

Private Sub Command2_Click()
Load frmresult
frmresult.Show
End Sub
​

 

[ahmadfononi]

Private Sub Form_activate()
focus = 0 'dadan focus be red
For j = 1 To 4 ' taeen tedad
If mander(j).Tag <> "" Then mander(j).Picture = LoadPicture(App.Path + "\r.gif")
If mandey(j).Tag <> "" Then mandey(j).Picture = LoadPicture(App.Path + "\y.gif")
If mandeg(j).Tag <> "" Then mandeg(j).Picture = LoadPicture(App.Path + "\g.gif")
If mandeb(j).Tag <> "" Then mandeb(j).Picture = LoadPicture(App.Path + "\b.gif")
Next j
End Sub

Private Sub six(focus As Byte) 'true kardane enable manedeha
For j = 1 To 4
mandey(j).Enabled = False
mandeg(j).Enabled = False
mandeb(j).Enabled = False
mander(j).Enabled = False
Next j
If tas = 6 Then
Select Case focus
Case 1
For j = 1 To 4
mander(j).Enabled = True
Next j
Case 2
For j = 1 To 4
mandey(j).Enabled = True
Next j
Case 3
For j = 1 To 4
mandeg(j).Enabled = True
Next j
Case 4
For j = 1 To 4
mandeb(j).Enabled = True
Next j
End Select
End If
End Sub
​

 

[ahmadfononi]

Private Sub KHANE_Click(Index As Integer)
Dim sookhtan As String
Dim can As Boolean
Dim newindex As Integer
If tas <> 0 Then
newindex = Index + tas 'taeen khane jadid
Select Case Index 'taeen residan mohre be akhar
Case 25, 26, 27, 28, 29
If KHANE(Index).Tag = "y" And newindex > 29 Then
newindex = newindex - 29
Select Case newindex
Case 1
If finishy(0).Tag = "" Then
finishy(0).Picture = KHANE(Index).Picture
finishy(0).Tag = KHANE(Index).Tag
KHANE(Index).Picture = LoadPicture("")
KHANE(Index).Tag = ""
f = True
End If
Case 2
If finishy(1).Tag = "" Then
finishy(1).Picture = KHANE(Index).Picture
finishy(1).Tag = KHANE(Index).Tag
KHANE(Index).Picture = LoadPicture("")
KHANE(Index).Tag = ""
f = True
End If
Case 3
If finishy(2).Tag = "" Then
finishy(2).Picture = KHANE(Index).Picture
finishy(2).Tag = KHANE(Index).Tag
KHANE(Index).Picture = LoadPicture("")
KHANE(Index).Tag = ""
f = True
End If
Case 4
If finishy(3).Tag = "" Then
finishy(3).Picture = KHANE(Index).Picture
finishy(3).Tag = KHANE(Index).Tag
KHANE(Index).Picture = LoadPicture("")
KHANE(Index).Tag = ""
f = True
End If
End Select
If f = True Then
For i = 0 To 3
If finishy(i).Tag = "y" Then yellow = yellow + 1 'taeen board
Next i
If yellow = 4 Then
​

 

[ahmadfononi]

MsgBox "yellow", , "finish"
For i = 4 To 1 Step -1
If finish(i) = "" Then beh = i
Next i
finish(beh) = "yellow"
End If
End If
r = True
Else
r = False
End If
Case 35, 36, 37, 38, 39
If KHANE(Index).Tag = "r" And newindex > 39 Then
newindex = newindex - 39
Select Case newindex
Case 1
If finishr(0).Tag = "" Then
finishr(0).Picture = KHANE(Index).Picture
finishr(0).Tag = KHANE(Index).Tag
KHANE(Index).Picture = LoadPicture("")
KHANE(Index).Tag = ""
ff = True
End If
Case 2
If finishr(1).Tag = "" Then
finishr(1).Picture = KHANE(Index).Picture
finishr(1).Tag = KHANE(Index).Tag
KHANE(Index).Picture = LoadPicture("")
KHANE(Index).Tag = "": ff = True
End If
Case 3
If finishr(2).Tag = "" Then
finishr(2).Picture = KHANE(Index).Picture
finishr(2).Tag = KHANE(Index).Tag
KHANE(Index).Picture = LoadPicture("")
KHANE(Index).Tag = "": ff = True
End If
Case 4
If finishr(3).Tag = "" Then
finishr(3).Picture = KHANE(Index).Picture
finishr(3).Tag = KHANE(Index).Tag
KHANE(Index).Picture = LoadPicture("")
KHANE(Index).Tag = "": ff = True
End If
End Select
If ff = True Then
For i = 0 To 3
If finishr(i).Tag = "r" Then red = red + 1 'taeen board
Next i
If red = 4 Then
rr = 4
MsgBox "red", , "finish"
For i = 4 To 1 Step -1
If finish(i) = "" Then beh = i
Next i
finish(beh) = "red"
End If
End If
r = True
Else
r = False
End If​

 

[ahmadfononi]

Case 5, 6, 7, 8, 9
If KHANE(Index).Tag = "b" And newindex > 9 Then
newindex = newindex - 9
Select Case newindex
Case 1
If finishb(0).Tag = "" Then
finishb(0).Picture = KHANE(Index).Picture
finishb(0).Tag = KHANE(Index).Tag
KHANE(Index).Picture = LoadPicture("")
KHANE(Index).Tag = ""
End If
Case 2
If finishb(1).Tag = "" Then
finishb(1).Picture = KHANE(Index).Picture
finishb(1).Tag = KHANE(Index).Tag
KHANE(Index).Picture = LoadPicture("")
KHANE(Index).Tag = ""
End If
Case 3
If finishb(2).Tag = "" Then
finishb(2).Picture = KHANE(Index).Picture
finishb(2).Tag = KHANE(Index).Tag
KHANE(Index).Picture = LoadPicture("")
KHANE(Index).Tag = ""
End If
Case 4
If finishb(3).Tag = "" Then
finishb(3).Picture = KHANE(Index).Picture
finishb(3).Tag = KHANE(Index).Tag
KHANE(Index).Picture = LoadPicture("")
KHANE(Index).Tag = ""
End If
End Select
For i = 0 To 3
If finishb(i).Tag = "b" Then blue = blue + 1 'taeen board
Next i
If blue = 4 Then

MsgBox "blue", , "finish"
For i = 4 To 1 Step -1
If finish(i) = "" Then beh = i
Next i
finish(beh) = "blue"
End If
r = True
Else
r = False
End If​

 

[ahmadfononi]

Case 15, 16, 17, 18, 19
If KHANE(Index).Tag = "g" And newindex > 19 Then
newindex = newindex - 19
Select Case newindex
Case 1
If finishg(0).Tag = "" Then
finishg(0).Picture = KHANE(Index).Picture
finishg(0).Tag = KHANE(Index).Tag
KHANE(Index).Picture = LoadPicture("")
KHANE(Index).Tag = ""
End If
Case 2
If finishg(1).Tag = "" Then
finishg(1).Picture = KHANE(Index).Picture
finishg(1).Tag = KHANE(Index).Tag
KHANE(Index).Picture = LoadPicture("")
KHANE(Index).Tag = ""
End If
Case 3
If finishg(2).Tag = "" Then
finishg(2).Picture = KHANE(Index).Picture
finishg(2).Tag = KHANE(Index).Tag
KHANE(Index).Picture = LoadPicture("")
KHANE(Index).Tag = ""
End If
Case 4
If finishg(3).Tag = "" Then
finishg(3).Picture = KHANE(Index).Picture
finishg(3).Tag = KHANE(Index).Tag
KHANE(Index).Picture = LoadPicture("")
KHANE(Index).Tag = ""
End If
End Select
For i = 0 To 3
If finishg(i).Tag = "g" Then green = green + 1 'taeen board
Next i
If green = 4 Then
MsgBox "green", , "finish"​

 

[ahmadfononi]

For i = 4 To 1 Step -1
If finish(i) = "" Then beh = i
Next i
finish(beh) = "green"
End If
r = True
Else
r = False
End If
End Select
'------------------------------------------------
If r = False Then 'taeen can harekat
Select Case focus
Case 1
If KHANE(Index).Tag = "r" Then a = True Else a = False
Case 2
If KHANE(Index).Tag = "y" Then a = True Else a = False
Case 3
If KHANE(Index).Tag = "g" Then a = True Else a = False
Case 4
If KHANE(Index).Tag = "b" Then a = True Else a = False
End Select
If newindex > 39 Then newindex = newindex - 40
Call testnewindex(Index, newindex, sookhtan, can)
If a = True And can = True Then 'taeen harekat
tagnewindex = KHANE(newindex).Tag
KHANE(newindex).Tag = KHANE(Index).Tag
KHANE(newindex).Picture = KHANE(Index).Picture
KHANE(Index).Tag = ""
KHANE(Index).Picture = LoadPicture("")
tas = 0
End If
If sookhtan <> "" Then 'taeen sookhtan
m = 0
Select Case tagnewindex
Case "r"
For i = 1 To 4
If mander(i).Tag = "" Then m = i
Next i
If m <> 0 Then
mander(m).Picture = LoadPicture(App.Path + "\r.gif")
mander(m).Tag = "r"
End If
Case "y"
For i = 1 To 4
If mandey(i).Tag = "" Then m = i
Next i
If m <> 0 Then
mandey(m).Picture = LoadPicture(App.Path + "\y.gif")
mandey(m).Tag = "y"
End If
Case "g"
For i = 1 To 4
If mandeg(i).Tag = "" Then m = i
Next i
If m <> 0 Then
mandeg(m).Picture = LoadPicture(App.Path + "\g.gif")
mandeg(m).Tag = "g"
End If​

 

[ahmadfononi]

Case "b"
For i = 1 To 4
If mandeb(i).Tag = "" Then m = i
Next i
If m <> 0 Then
mandeb(m).Picture = LoadPicture(App.Path + "\b.gif")
mandeb(m).Tag = "b"
End If
End Select
End If
End If
End If
End Sub
Private Sub mandey_Click(Index As Integer)
'taeen khaly boodan fristy
If tas = 6 Then
Call FRISTKHANE
If mandey(Index).Tag = "y" Then 'taeen mikone ke khane mohre darad ya na
indextag = KHANE(fristy).Tag 'jabejayee
KHANE(fristy).Picture = mandey(Index).Picture
mandey(Index).Picture = LoadPicture("")
KHANE(fristy).Tag = "y"
mandey(Index).Tag = ""
tas = 0
End If
Select Case indextag 'agar khane frist por bood vaziyat ra be halat aval bar migardanad
Case "r"
For i = 1 To 4
If mander(i).Tag = "" Then m = i
Next i
If m <> 0 Then
mander(m).Picture = LoadPicture(App.Path + "\r.gif")
mander(m).Tag = "r"
End If
Case "y"
For i = 1 To 4
If mandey(i).Tag = "" Then m = i
Next i
If m <> 0 Then
mandey(m).Picture = LoadPicture(App.Path + "\y.gif")
mandey(m).Tag = "y"
End If
Case "g"
For i = 1 To 4
If mandeg(i).Tag = "" Then m = i
Next i
If m <> 0 Then
mandeg(m).Picture = LoadPicture(App.Path + "\g.gif")
mandeg(m).Tag = "g"
End If
Case "b"
For i = 1 To 4
If mandeb(i).Tag = "" Then m = i
Next i
If m <> 0 Then
mandeb(m).Picture = LoadPicture(App.Path + "\b.gif")
mandeb(m).Tag = "b"
End If
End Select
For j = 1 To 4 'false kardane enable
mandey(j).Enabled = False
Next j
End If
End Sub​

 

[ahmadfononi]

Private Sub mander_Click(Index As Integer)
If tas = 6 Then
Call FRISTKHANE
If mander(Index).Tag = "r" Then
indextag = KHANE(fristr).Tag
KHANE(fristr).Picture = mander(Index).Picture
mander(Index).Picture = LoadPicture("")
KHANE(fristr).Tag = "r"
mander(Index).Tag = ""
tas = 0
End If
Select Case indextag
Case "r"
For i = 1 To 4
If mander(i).Tag = "" Then m = i
Next i
If m <> 0 Then
mander(m).Picture = LoadPicture(App.Path + "\r.gif")
mander(m).Tag = "r"
End If
Case "y"
For i = 1 To 4
If mandey(i).Tag = "" Then m = i
Next i
If m <> 0 Then
mandey(m).Picture = LoadPicture(App.Path + "\y.gif")
mandey(m).Tag = "y"
End If
Case "g"
For i = 1 To 4
If mandeg(i).Tag = "" Then m = i
Next i
If m <> 0 Then
mandeg(m).Picture = LoadPicture(App.Path + "\g.gif")
mandeg(m).Tag = "g"
End If
Case "b"
For i = 1 To 4
If mandeb(i).Tag = "" Then m = i
Next i
If m <> 0 Then
mandeb(m).Picture = LoadPicture(App.Path + "\b.gif")
mandeb(m).Tag = "b"
End If
End Select​

 

[ahmadfononi]

For j = 1 To 4
mandey(j).Enabled = False
Next j

End If
End Sub
Private Sub mandeb_Click(Index As Integer)
If tas = 6 Then
Call FRISTKHANE
If mandeb(Index).Tag = "b" Then
indextag = KHANE(fristb).Tag
KHANE(fristb).Picture = mandeb(Index).Picture
mandeb(Index).Picture = LoadPicture("")
KHANE(fristb).Tag = "b"
mandeb(Index).Tag = ""
tas = 0
End If
Select Case indextag
Case "r"
For i = 1 To 4
If mander(i).Tag = "" Then m = i
Next i
If m <> 0 Then
mander(m).Picture = LoadPicture(App.Path + "\r.gif")
mander(m).Tag = "r"
End If
Case "y"
For i = 1 To 4
If mandey(i).Tag = "" Then m = i
Next i
If m <> 0 Then
mandey(m).Picture = LoadPicture(App.Path + "\y.gif")
mandey(m).Tag = "y"
End If
Case "g"
For i = 1 To 4
If mandeg(i).Tag = "" Then m = i
Next i
If m <> 0 Then
mandeg(m).Picture = LoadPicture(App.Path + "\g.gif")
mandeg(m).Tag = "g"
End If​

 

[ahmadfononi]

Case "b"
For i = 1 To 4
If mandeb(i).Tag = "" Then m = i
Next i
If m <> 0 Then
mandeb(m).Picture = LoadPicture(App.Path + "\b.gif")
mandeb(m).Tag = "b"
End If
End Select

For j = 1 To 4
mandey(j).Enabled = False
Next j

End If
End Sub
Private Sub mandeg_Click(Index As Integer)
If tas = 6 Then
Call FRISTKHANE
If mandeg(Index).Tag = "g" Then
indextag = KHANE(fristg).Tag
KHANE(fristg).Picture = mandeg(Index).Picture
mandeg(Index).Picture = LoadPicture("")
KHANE(fristg).Tag = "g"
mandeg(Index).Tag = ""
tas = 0
End If
Select Case indextag
Case "r"
For i = 1 To 4
If mander(i).Tag = "" Then m = i
Next i
If m <> 0 Then
mander(m).Picture = LoadPicture(App.Path + "\r.gif")
mander(m).Tag = "r"
End If
Case "y"
For i = 1 To 4
If mandey(i).Tag = "" Then m = i
Next i
If m <> 0 Then
mandey(m).Picture = LoadPicture(App.Path + "\y.gif")
mandey(m).Tag = "y"
End If​

 

[ahmadfononi]

Case "g"
For i = 1 To 4
If mandeg(i).Tag = "" Then m = i
Next i
If m <> 0 Then
mandeg(m).Picture = LoadPicture(App.Path + "\g.gif")
mandeg(m).Tag = "g"
End If
Case "b"
For i = 1 To 4
If mandeb(i).Tag = "" Then m = i
Next i
If m <> 0 Then
mandeb(m).Picture = LoadPicture(App.Path + "\b.gif")
mandeb(m).Tag = "b"
End If
End Select

For j = 1 To 4
mandey(j).Enabled = False
Next j

End If
End Sub
Public Sub testnewindex(Index As Integer, newindex As Integer, ByRef sookhtan As String, ByRef can As Boolean)
If KHANE(Index).Tag = KHANE(newindex).Tag Then 'taeen sookhtan
can = False
Else
can = True
If KHANE(newindex).Tag = "" Then
sookhtan = ""
Else
Select Case KHANE(newindex).Tag
Case "r"
sookhtan = "r"
Case "y"
sookhtan = "y"
Case "g"
sookhtan = "g"
Case "b"
sookhtan = "b"
End Select
End If
End If
End Sub​

 

[ahmadfononi]

Private Sub Timer1_Timer()
On Error GoTo 1
For i = 0 To 3
If finishy(i).Tag = "y" Then yy = yy + 1
If finishb(i).Tag = "b" Then bb = bb + 1
If finishr(i).Tag = "r" Then rr = rr + 1
If finishg(i).Tag = "g" Then gg = gg + 1
Next i
Select Case cont
Case 2
If yy = 4 And rr = 4 Then

Load frmresult
frmresult.Show
Unload Me
End If
Case 3
If yy = 4 And rr = 4 And gg = 4 Then

Load frmresult
frmresult.Show
Unload Me
End If
Case 4

If yy = 4 And rr = 4 And gg = 4 And bb = 4 Then

Load frmresult
frmresult.Show
Unload Me
End If
End Select
1: msgbox " try again "
End Sub​

 

[nariman103]

سلام
اشکال گرافیکی و فرم بازی را چگونه بدست اوریم
اگه میشه به میلم ایمیل کنید
باتشکر مجید
nariman103@gmail.com