?? form1.frm
字號:
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:bz3zwy@qq.com
'作者：亳州三中教科處王宇
'####################################################
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:bz3zwy@qq.com" & 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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -