form1.frm

本人自己制作的的小游戏：种蘑菇V1.1 种蘑菇 V1.1更新： 1.提供4种不同方阵

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "种蘑菇-V1.1-by-BZ3ZWY-2008.12.1"
   ClientHeight    =   5655
   ClientLeft      =   150
   ClientTop       =   720
   ClientWidth     =   7305
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5655
   ScaleWidth      =   7305
   StartUpPosition =   3  '窗口缺省
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Height          =   240
      Left            =   3360
      TabIndex        =   0
      Top             =   0
      Width           =   850
   End
   Begin VB.Image Image1 
      Height          =   750
      Index           =   0
      Left            =   2415
      Top             =   4095
      Visible         =   0   'False
      Width           =   750
   End
   Begin VB.Line Line2 
      Index           =   0
      X1              =   1920
      X2              =   1920
      Y1              =   345
      Y2              =   4095
   End
   Begin VB.Line Line1 
      Index           =   0
      X1              =   1920
      X2              =   5670
      Y1              =   345
      Y2              =   345
   End
   Begin VB.Shape Shape2 
      BorderWidth     =   3
      Height          =   750
      Left            =   240
      Top             =   345
      Width           =   750
   End
   Begin VB.Shape Shape1 
      BorderWidth     =   3
      Height          =   750
      Index           =   0
      Left            =   1920
      Top             =   345
      Visible         =   0   'False
      Width           =   750
   End
   Begin VB.Image Image2 
      Height          =   750
      Index           =   4
      Left            =   240
      Picture         =   "Form1.frx":0CCA
      Top             =   4095
      Width           =   750
   End
   Begin VB.Image Image2 
      Height          =   750
      Index           =   3
      Left            =   240
      Picture         =   "Form1.frx":15BE
      Top             =   3150
      Width           =   750
   End
   Begin VB.Image Image2 
      Height          =   750
      Index           =   2
      Left            =   240
      Picture         =   "Form1.frx":1EBD
      Top             =   2220
      Width           =   750
   End
   Begin VB.Image Image2 
      Height          =   750
      Index           =   1
      Left            =   240
      Picture         =   "Form1.frx":27AC
      Top             =   1275
      Width           =   750
   End
   Begin VB.Image Image2 
      Height          =   750
      Index           =   0
      Left            =   240
      Picture         =   "Form1.frx":30B7
      Top             =   345
      Width           =   750
   End
   Begin VB.Menu MnuGame 
      Caption         =   "游戏"
      Begin VB.Menu MnuStart 
         Caption         =   "开局"
      End
      Begin VB.Menu MnuHero 
         Caption         =   "英雄榜"
      End
      Begin VB.Menu MnuQuit 
         Caption         =   "退出"
      End
   End
   Begin VB.Menu MnuWf 
      Caption         =   "游戏玩法"
      Begin VB.Menu MnuNormal 
         Caption         =   "普通玩法"
      End
      Begin VB.Menu MnuDiejia 
         Caption         =   "叠加玩法"
      End
   End
   Begin VB.Menu MnuKind 
      Caption         =   "游戏类型"
      Begin VB.Menu Mnu33 
         Caption         =   "3X3"
      End
      Begin VB.Menu Mnu44 
         Caption         =   "4X4"
      End
      Begin VB.Menu Mnu55 
         Caption         =   "5X5"
      End
      Begin VB.Menu Mnu66 
         Caption         =   "6X6"
      End
   End
   Begin VB.Menu MnuSel 
      Caption         =   "选项"
      Begin VB.Menu MnuDestroy 
         Caption         =   "摧毁功能"
      End
   End
   Begin VB.Menu MnuHelp 
      Caption         =   "帮助"
      Begin VB.Menu MnuJianjie 
         Caption         =   "游戏简介"
      End
      Begin VB.Menu MnuAbout 
         Caption         =   "关于"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'####################################################
'种蘑菇V1.1-by-BZ3ZWY-2008-12-01
'转载、引用请保留作者信息
'http://hi.baidu.com/bz3zwy/
'E-mail:[e-mail]
'作者：亳州三中教科处王宇
'####################################################
Option Explicit
Const IntX As Integer = 1920    '棋盘顶点初始位置
Const IntY As Integer = 345
Const PicWidth As Integer = 750 '图片宽度
Const OffSet As Integer = 100   '偏移量

Dim color(4)    '边框shape1的颜色

Dim M() As Integer '储存当前蘑菇状态
Dim R() As Integer '辅助判断
Dim Max(3 To 18) As Integer    '得分,因为要记录两种游戏的得分，有冗余
Dim MaxDJ(3 To 6) As Integer
Dim SelMG%  '选中的蘑菇类型

Dim GameType As Integer
Dim GameDJ As Boolean   '叠加方式


Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
'    Case 37 '左
'    Case 39 '右
    Case 38 '上
        SelMG = IIf(SelMG = 0, 3, SelMG - 1)
    Case 40 '下
        SelMG = IIf(SelMG = 3, 0, SelMG + 1)
End Select
Image2_Click (SelMG)
End Sub

Private Sub Form_Load() '初始化一些一般不会变化的变量，并设置游戏缺省模式

color(0) = vbBlue   '颜色常数
color(1) = vbMagenta
color(2) = vbGreen
color(3) = vbYellow
color(4) = vbBlack



MnuNormal_Click

Mnu55_Click


End Sub

Private Sub JieMian(GameType As Integer)    '画界面过程
Dim i%, j%
Line1(0).X2 = IntX + (OffSet + PicWidth) * GameType    '边框长度
Line2(0).Y2 = IntY + (OffSet + PicWidth) * GameType


For i = 1 To GameType   '画棋盘
Load Line1(i)
With Line1(i)
    .Y1 = i * (PicWidth + OffSet) + IntY
    .Y2 = i * (PicWidth + OffSet) + IntY
    .Visible = True
End With
Load Line2(i)
With Line2(i)
    .X1 = i * (PicWidth + OffSet) + IntX
    .X2 = i * (PicWidth + OffSet) + IntX
    .Visible = True
End With
Next i

For i = 1 To GameType * GameType    '图片布局
    Load Image1(i)
    With Image1(i)
          .Move IntX + (OffSet + PicWidth) * ((i - 1) Mod GameType) + OffSet \ 2, IntY + (OffSet + PicWidth) * ((i - 1) \ GameType) + OffSet \ 2
          'Debug.Print PicWidth * ((i - 1) Mod GameType), IntY + PicWidth * ((i - 1) \ GameType)
          .Visible = True
          '.Picture = Image2(0).Picture  '测试用
    End With
    Load Shape1(i)  '画图片边框
    With Shape1(i)
          .Move IntX + (OffSet + PicWidth) * ((i - 1) Mod GameType) + OffSet \ 2, IntY + (OffSet + PicWidth) * ((i - 1) \ GameType) + OffSet \ 2
          '.Visible = True
    End With
Next i

Image2(4).Visible = False   '初始界面隐藏控件
Shape2.Visible = False

'初始化变量数组
ReDim M(GameType + 1, GameType + 1)
ReDim R(GameType + 1, GameType + 1)
'记录蘑菇存放的变量初始化为都不放蘑菇的状态,非0,1,2,3的数;为简化,这里用4
For i = 0 To GameType + 1
    For j = 0 To GameType + 1
        M(i, j) = 4
        R(i, j) = 4
    Next j
Next i

'得分状态
Max((1 - 2 * CLng(GameDJ)) * GameType) = 0
Label1.Left = IntX + (PicWidth + OffSet) * (GameType \ 2)
Label1.Caption = "共" & Max((1 - 2 * CLng(GameDJ)) * GameType) & "分"

End Sub

Private Sub Image1_Click(Index As Integer)
Dim i%, j%, ScoreType%

'1.判断该单元格是否符合条件，若符合条件则在此位置放一蘑菇
i = (Index - 1) \ GameType + 1
j = (Index - 1) Mod GameType + 1
If M(i, j) = 4 Or GameDJ Then
    R(i, j) = SelMG
    If Flag(i, j) Then
        Image1(Index).Picture = Image2(SelMG).Picture
        M(i, j) = SelMG
        Image2_Click (SelMG)
    End If

'2.如果使用摧毁功能，则摧毁已存在的蘑菇
    If SelMG = 4 Then
        Image1(Index).Picture = Nothing
        M(i, j) = 4
        Image2_Click (SelMG)
    End If

'3.计算总分
    ScoreType = (1 - 2 * CLng(GameDJ)) * GameType
    Max(ScoreType) = 0
    For i = 1 To GameType
        For j = 1 To GameType
        If M(i, j) < 4 Then Max(ScoreType) = Max(ScoreType) + M(i, j) + 1
        Next j
    Next i
    Label1.Caption = "共" & Max(ScoreType) & "分"
End If

End Sub

Private Sub Image2_Click(Index As Integer)
Dim i%, j%, k%
'1.定位选择框
Shape2.Top = IntY + Index * 930 '定位shape2
Shape2.BorderColor = color(Index)
Shape2.Visible = True

'2.每次单击都要初始化临时数组
For i = 0 To GameType + 1
    For j = 0 To GameType + 1
        R(i, j) = 4
    Next j
Next i


'3.选中相应蘑菇后,棋盘区显示可放置的位置

SelMG = Index

For k = 1 To GameType * GameType
    i = (k - 1) \ GameType + 1
    j = (k - 1) Mod GameType + 1
    'Debug.Print i, j
    Shape1(k).Visible = False   '清除上次显示结果
    R(i, j) = SelMG '假设这个位置可放置该种蘑菇,下面判断是否违背条件
    If Flag(i, j) And (M(i, j) = 4 Or GameDJ) Then
        Shape1(k).BorderColor = color(SelMG)
        Shape1(k).Visible = True
    End If
    R(i, j) = 4 '清除标记
Next k

End Sub


Private Sub ClearJieMian()  '清除界面
Dim i%
For i = 1 To Line1.UBound
    Unload Line1(i)
    Unload Line2(i)
Next i
For i = 1 To Image1.UBound
    Unload Image1(i)
    Unload Shape1(i)
Next i

End Sub

Private Sub Label1_Click()
Dim User(3 To 18) As String, Score(3 To 18) As Integer, i%, ScoreType%
'1.读入所有成绩
If Dir(App.Path & "\zmg.ini") <> "" Then
    Open App.Path & "\zmg.ini" For Input As #1
    i = 3
    Do Until EOF(1)
        Input #1, User(i), Score(i)
        i = i + 1
    Loop
    Close #1
End If

'2.写入所有成绩
ScoreType = (1 - 2 * CLng(GameDJ)) * GameType '当前成绩类型
If Max(ScoreType) = 0 Then
    MsgBox "对不起，您还没有成绩！", , "种蘑菇"
ElseIf Max(ScoreType) > Score(ScoreType) Then
    Score(ScoreType) = Max(ScoreType)
    User(ScoreType) = InputBox("您的成绩是" & Max(ScoreType) & "，请输入尊姓大名,", "输入姓名")
    Open App.Path & "\zmg.ini" For Output As #1
        For i = 3 To 18
            Write #1, User(i), Score(i)
        Next i
    Close #1
Else
    MsgBox "对不起，你的分数没有破纪录，最佳纪录是" & User(ScoreType) & "创造的，" & Score(ScoreType) & "分", , "种蘑菇"
End If
End Sub

Private Sub Mnu33_Click()
Mnu33.Checked = True
Mnu44.Checked = False
Mnu55.Checked = False
Mnu66.Checked = False

GameType = 3
MnuStart_Click
End Sub


Private Sub Mnu44_Click()
Mnu33.Checked = False
Mnu44.Checked = True
Mnu55.Checked = False
Mnu66.Checked = False

GameType = 4
MnuStart_Click

End Sub

Private Sub Mnu55_Click()
Mnu33.Checked = False
Mnu44.Checked = False
Mnu55.Checked = True
Mnu66.Checked = False


GameType = 5
MnuStart_Click

End Sub

Private Sub Mnu66_Click()
Mnu33.Checked = False
Mnu44.Checked = False
Mnu55.Checked = False
Mnu66.Checked = True


GameType = 6
MnuStart_Click

End Sub
Function Flag(i As Integer, j As Integer) As Boolean
Flag = True
If R(i, j) > 0 Then
    Dim tmp(4) As Boolean
    Dim k As Integer
    tmp(M(i - 1, j)) = True
    tmp(M(i, j - 1)) = True
    tmp(M(i, j + 1)) = True
    tmp(M(i + 1, j)) = True
    For k = 1 To R(i, j)
        Flag = Flag And tmp(k - 1)
    Next k
    DoEvents
End If
End Function

Private Sub MnuAbout_Click()
MsgBox "作者：亳州三中教科处王宇" & vbCrLf _
& "QQ:84115144  E-mail:[e-mail]" & vbCrLf _
& "更多精彩：http://hi.baidu.com/bz3zwy", , "种蘑菇"
End Sub

Private Sub MnuDestroy_Click()
If GameDJ Then
    Image2(4).Visible = Not Image2(4).Visible
    MnuDestroy.Checked = Image2(4).Visible
End If
End Sub

Private Sub MnuDiejia_Click()
MnuNormal.Checked = False
MnuDiejia.Checked = True
GameDJ = True
MnuDestroy.Enabled = True
End Sub

Private Sub MnuHero_Click()
Dim User(3 To 18) As String, Score(3 To 18) As Integer, i%
If Dir(App.Path & "\zmg.ini") <> "" Then
    Open App.Path & "\zmg.ini" For Input As #1
    i = 3
    Do Until EOF(1)
        Input #1, User(i), Score(i)
        i = i + 1
    Loop
    Close #1
    MsgBox "最佳纪录是:" & vbCrLf & vbCrLf _
    & "普通3阶: " & User(3) & "创造的，" & Score(3) & "分" & vbCrLf _
    & "普通4阶: " & User(4) & "创造的，" & Score(4) & "分" & vbCrLf _
    & "普通5阶: " & User(5) & "创造的，" & Score(5) & "分" & vbCrLf _
    & "普通6阶: " & User(6) & "创造的，" & Score(6) & "分" & vbCrLf _
    & vbCrLf _
    & "叠加3阶: " & User(9) & "创造的，" & Score(9) & "分" & vbCrLf _
    & "叠加4阶: " & User(12) & "创造的，" & Score(12) & "分" & vbCrLf _
    & "叠加5阶: " & User(15) & "创造的，" & Score(15) & "分" & vbCrLf _
    & "叠加6阶: " & User(18) & "创造的，" & Score(18) & "分" & vbCrLf _
    , , "种蘑菇"
Else
    MsgBox "还没有记录，等待您来创造！", , "种蘑菇"
End If
End Sub

Private Sub MnuJianjie_Click()
Shell "explorer ""http://hi.baidu.com/bz3zwy", 1
End Sub

Private Sub MnuNormal_Click()
MnuDiejia.Checked = False
MnuNormal.Checked = True
GameDJ = False
MnuDestroy.Enabled = False
End Sub

Private Sub MnuQuit_Click()
Unload Me
End
End Sub

Private Sub MnuStart_Click()

ClearJieMian

JieMian (GameType)

End Sub