纯VBScript版的Web扫雷程序

纯VBScript版的Web扫雷程序

- 中国WEB开发者网络 (http://www.webasp.net)
-- 技术教程 (http://www.webasp.net/article/)
--- 纯VBScript版的Web扫雷程序 (http://www.webasp.net/article/14/13947.htm)

-- 作者：guidy
-- 发布日期： 2004-10-15

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>Guidy的Web扫雷程序 - 纯VBScript版</title>
<style type="text/css">
@charset "gb2312";
body,td {
Font: 12 Px "宋体", Verdana, Arial, Helvetica, sans-serif;
Cursor: default;
}
body{
margin: 0px;
BackGround: buttonface;
}
A:link,A:visited,A:active {
Color:#990000;
Text-Decoration:None;
}
A:hover {
Color:#FF8000;
Text-Decoration:UnderLine;
}
input {
Border-Top-Width: 1 Px;
Padding-Right: 1 Px;
Padding-Left: 1 Px;
Border-Left-Width: 1 Px;
Border-bottom-Width: 1 Px;
Border-Right-Width: 1 Px;
Padding-bottom: 1 Px;
Padding-Top: 1 Px;
Height: 18 Px;
Border-Left-Color: #C0C0C0;
Border-bottom-Color: #C0C0C0;
Border-Top-Color: #C0C0C0;
Border-Right-Color: #C0C0C0;
BackGround-Color: #FFFFFF;
Color: #000000;
Font: 9pt "宋体", Verdana, Arial, Helvetica, sans-serif;
}
.TdOver{
border: 1px outset;

Border-Left-Color: #FFFFFF;
Border-Top-Color: #FFFFFF;
Border-Right-Color: #AAAAAA;
Border-bottom-Color: #AAAAAA;

BackGround-Color: #FFCCFF;
}
.TdOut{
border: 1px outset;

Border-Left-Color: #E5E6E7;
Border-Top-Color: #E5E6E7;
Border-Right-Color: #E5E6E7;
Border-bottom-Color: #E5E6E7;

BackGround-Color: #E5E6E7;
}
.Tm0{BackGround-Color: buttonface;Color: #2E8B57; font-weight:bold;}
.Tm1{BackGround-Color: buttonface;Color: #0000FF; font-weight:bold;}
.Tm2{BackGround-Color: buttonface;Color: #2E8B57; font-weight:bold;}
.Tm3{BackGround-Color: buttonface;Color: #FF0000; font-weight:bold;}
.Tm4{BackGround-Color: buttonface;Color: #FF00FF; font-weight:bold;}
.Tm5{BackGround-Color: buttonface;Color: #00FFFF; font-weight:bold;}
.Tm6{BackGround-Color: buttonface;Color: #FF00FF; font-weight:bold;}
.Tm7{BackGround-Color: buttonface;Color: #FFFF00; font-weight:bold;}
.Tm8{BackGround-Color: buttonface;Color: #000000; font-weight:bold;}

</style>
</head>

<body onselectstart="event.returnValue=false;">
<table align="center"><tr><td>
<fieldset style="background-color:bottonface;"><legend>扫雷控制面板</legend><table border="0" align="center" cellpadding="0" cellspacing="1">
<tr>
<td>宽度：</td>
<td><input name="Tmx" type="text" id="Tmx" size="4" maxlength="4" style="ime-mode: disabled;"></td>
<td><input name="S1" type="button" id="S1" onClick="CreatTable(Tmx.value,Tmy.value);LayMine(MNum.value);" value=" 开始 "></td>
</tr>
<tr>
<td>高度：</td>
<td><input name="Tmy" type="text" id="Tmy" size="4" maxlength="4" style="ime-mode: disabled;"></td>
<td rowspan="2" align="center" valign="middle" id="BnNum" style="font-weight:800; color:#FF0000; font-size:36px;" title="当前标记个数，为负表明超过雷数！"> </td>
</tr>
<tr>
<td>雷数：</td>
<td><input name="MNum" type="text" id="MNum" size="4" maxlength="4" style="ime-mode: disabled;"></td>
</tr>
</table>
</fieldset></td></tr>
</table>
<hr size="1">
<table border="3" align="center" cellpadding="1" cellspacing="1" bordercolor="threedshadow">
<tr>
<td><div align="center" id="MineView"><div align="left"><br>
<ul>
<li><strong><font color="#FF0000">请设定后点击『开始』按钮，即可进入游戏！</font></strong></li>
<li>“扫雷”游戏的目标是尽快找到雷区中的所有地雷，而不许踩到地雷。如果挖开的是地雷，您将输掉游戏。</li>
<li>通过单击即可挖开方块。如果挖开的是地雷，则您输掉游戏。</li>
<li>如果方块上出现数字，则表示在其周围的八个方块中共有多少颗地雷。</li>
<li>要标记您认为可能有地雷的方块，请右键单击它。 </li>
<li>要标记您认为不确定的方块，请右键单击它两次。 </li>
</ul>
</div></div></td>
</tr>
</table>
<hr size="1">
<script language="vbscript">
Rem =========================================================
Rem 文件：WebMine.asp
Rem 功能：Guidy的Web扫雷程序 - 纯VBScript版
Rem 版本：Ver1.0.0
Rem 全称：Guidy的Web扫雷程序 Ver1.0.0
Rem 时间：2004-10-15
Rem 作者：Guidy
Rem 版权：iXuEr Studio
Rem =========================================================
Rem Copyright (C) 2004-2006 114XP.CN All rights reserved.
Rem 官方网站：http://www.114xp.cn
Rem 技术论坛：http://bbs.114xp.cn
Rem 电子信箱：Guidy@qq.com , Guidy@psysch.com
Rem =========================================================
Option Explicit

Public i,o
Public x,y,z
Public MineArr,LayStr,LayTmpStr
Public Ri,Rn,Rm
Public WinMsg,LoseMsg,BnedMsg

Function CreatTable(Tx,Ty)
''//初始化雷区并将雷区标识符保存在数组中
Dim TmpStr,TmpStr1

WinMsg = "恭喜！你赢了！！！"
LoseMsg = "踩到地雷了，哈哈！去死吧！~~"

''//因为编程上的不足，只有在长宽相等的时候才能正确游戏
''//希望有高手帮助我更正这个问题
If Tx <> Ty And Tx > Ty Then
Ty = Tx
Else
Tx = Ty
End If
''//如果雷区参数过小就强制使用默认值
If Tx = "" Or IsNull(Tx) Then Tx = 9 : Tmx.Value = 9
If Ty = "" Or IsNull(Ty) Then Ty = 9 : Tmy.Value = 9

''//如果雷区参数过大就强制使用默认值
If Tx >= 24 Then Tx = 24 : Tmx.Value = 24
If Ty >= 24 Then Ty = 24 : Tmy.Value = 24

''//创建雷区表格
TmpStr = "<table border=""0"" align=""center"" cellpadding=""0"" cellspacing=""0"" bordercolor=""threeddarkshadow"" bgcolor=""#990000"">"
For x = 1 To Ty
TmpStr = TmpStr & " <tr>"

For y = 1 To Tx
TmpStr = TmpStr & " <td onClick=""ShowTMN(this.id);"" onContextMenu=""PutBn(this.id);event.returnValue=false;"" align=""center"" class=""TdOut"" width=""24"" height=""24"" id=""T_" & x &"_"& y &""" MineNum=""0"" MBN="""" Disable=""False""> </td>"
TmpStr1 = TmpStr1 & " T_" & x &"_"& y
Next
TmpStr = TmpStr & " </tr>"
Next
TmpStr = TmpStr & "</table>"

''//显示表格
MineView.innerHTML = TmpStr
''//整理雷区标识符字符串便于转换
TmpStr1 = Trim(TmpStr1)

''//将雷区标识符字符串转换撑数组
MineArr = Split(TmpStr1)
''//将雷区总数
Rn = UBound(MineArr) + 1

End Function

Function LayMine(MNumber)
''//放雷
Dim ii
Dim Lx,Ly

''//如果检测到雷区未初始化，则强制执行初始化
If IsArray(MineArr) = False Then Call CreatTable(100,100)

''//获取雷区参数
x = Int(Tmx.Value)
y = Int(Tmy.Value)

If MNumber = "" Or MNumber <= "0" Then MNumber = 10 : MNum.value = MNumber

''//获取雷数
z = MNum.Value
''//如果雷数超过了雷区总数则强制设置
If Int(MNumber) >= Int(x * y) Then
MNumber = Int(x * y) - 50
MNum.value = MNumber
z = MNum.Value
End If

Rm = z

''//初始化雷标识字符串
LayStr = ""

For ii = 1 To MNumber
''//初始化随机数种子
Randomize Timer()
''//建立随机数
Lx = Int(Rnd * x) + 1
Ly = Int(Rnd * y) + 1
''//对随机数整形
If Lx <= 1 Then Lx = 1
If Ly <= 1 Then Ly = 1
If Lx >= x Then Lx = x
If Ly >= y Then Ly = y
''//利用随机数组合雷标识
LayTmpStr = "T_"
LayTmpStr = LayTmpStr & Ly

LayTmpStr = LayTmpStr &"_"& Lx
''//检测雷标识字符串，如果存在则跳过，不存才就放雷
If InStr(LayStr,LayTmpStr) Then
ii = ii - 1
Else
Execute(LayTmpStr & ".MineNum = ""地雷""")
''//放雷后重新组合雷标识字符串
LayStr = LayStr &" "& LayTmpStr
End If
Next

''//对雷标识字符串整形
LayStr = Trim(LayStr)
''//将雷标识字符串转换成数组
LayStr = Split(LayStr)
''//获取雷总数
Ri = UBound(LayStr) + 1

Call LayMNum()

End Function

Function LayMNum()
''//在所有方格中标识其周围的雷数
Dim Li,Lmn

For Li = 0 To UBound(MineArr)
Lmn = Eval(MineArr(Li) & ".MineNum")
Call ChkMineNum(MineArr(Li),Lmn,0)
Next

End Function

Function ChkMineNum(Tid,TMN,Tp)
''//计算雷区数字，在方格中显示其周围的雷数
Dim Tdid,Tmp,Tmp1
Dim n
Dim Sx,Sy,Ox,Oy,Mx,My

x = Tmx.Value
y = Tmy.Value
n = 0

''//将雷区标识转换成数组便于操作
Tdid = Split(Tid,"_")

''//对雷标识符进行整形初始化中央坐标
Ox = Tdid(1)
Oy = Tdid(2)

''//对雷标识符进行整形初始化横坐标幅度 1
Sx = Ox - 1
Mx = Ox + 1
If Int(Sx) <= 1 Then Sx = 1
If Int(Mx) >= Int(x) Then Mx = x

''//对雷标识符进行整形初始化纵坐标幅度 1
Sy = Oy - 1
My = Oy + 1
If Int(Sy) <= 1 Then Sy = 1
If Int(My) >= Int(y) Then My = y

If TMN = "地雷" Then
''//如果时雷标识就应该跳过
''//Execute(Tid & ".innerHTML = """ & TMN & """")
Else
''//循环计算周围雷总数
For i = Sx To Mx Step 1
Tmp1 = Tdid(0)
Tmp1 = Tmp1 & "_" & i

For o = Sy To My Step 1
Tmp = Tmp1 & "_" & o

If Eval(Tmp & ".MineNum = ""地雷""") Then
n = n + 1
ElseIf TMN = 0 And Tp = 1 Then
''//如果雷数为0则自动循环检测其周围其他雷区，直到完毕
Call ShowTMN(Tmp)
End If
Next
Next
''//显示周围雷数
ExeCute(Tid & ".MineNum = " & n)
''//ExeCute(Tid & ".innerHTML = " & n)
End If

End Function

Function ShowTMN(Tid)
''//在选中的格子中显示其周围的雷数
Dim TTn
TTn = CStr(Eval(Tid & ".MineNum"))

''//如果所点击的不是雷标识格子，则将没有禁用的标识为禁用
''//禁用的则自动跳过执行，以减少系统执行负担
If Eval(Tid & ".MineNum <> ""地雷""") Then
If Eval(Tid & ".Disable = ""True""") Then
Exit Function
Else
Execute(Tid & ".innerHTML = """ & TTn & """")
Execute(Tid & ".Disable = ""True""")
End If

If Eval(Tid & ".MineNum = ""标记""") Then
Execute(Tid & ".Disable = ""False""")
End If
Else
If Eval(Tid & ".Disable = ""True""") Then
Exit Function
End If
End If

''//按照雷数的不同显示不同的样式，以便区分
Select Case TTn
Case "0"
''//如果检测到周围雷数为0，则自动循环检测其周围的格子
ExeCute(Tid & ".MineNum = """"")
Execute(Tid & ".className = ""Tm0""")
Execute(Tid & ".innerHTML = "" """)
Call ChkMineNum(Tid,TTn,1)
Rn = Rn - 1

Case "1" Execute(Tid & ".className = ""Tm1""") : Rn = Rn - 1
Case "2" Execute(Tid & ".className = ""Tm2""") : Rn = Rn - 1
Case "3" Execute(Tid & ".className = ""Tm3""") : Rn = Rn - 1
Case "4" Execute(Tid & ".className = ""Tm4""") : Rn = Rn - 1
Case "5" Execute(Tid & ".className = ""Tm5""") : Rn = Rn - 1
Case "6" Execute(Tid & ".className = ""Tm6""") : Rn = Rn - 1
Case "7" Execute(Tid & ".className = ""Tm7""") : Rn = Rn - 1
Case "8" Execute(Tid & ".className = ""Tm8""") : Rn = Rn - 1
Case "地雷"
WinMsg = LoseMsg
Call ShowAllOb()
Exit Function
Case "标记"
Execute(Tid & ".innerHTML = "" """)
WinMsg = LoseMsg
Call ShowAllOb()
Exit Function
End Select

If z = "" & Rn & "" Then
Call ShowAllOb()
Alert(WinMsg)
End If
End Function

Function PutBn(Tid)
''//用右键做自助标记

''//如果是已经禁用的，则自动跳过
If Eval(Tid & ".Disable = ""True""") Then
If Eval(Tid & ".MineNum <> ""地雷""") Or Eval(Tid & ".MineNum <> ""标记""") Then
Exit Function
End If
End If

Execute(Tid & ".className = ""TdOver""")
Execute("MNum.style.color = ""#00FF00""")

''//标记类型
If Eval(Tid & ".MBN = """"") Then
''//标记为有雷
Execute(Tid & ".MBN = ""!""")
Execute(Tid & ".innerHTML = """ & Eval(Tid & ".MBN") & """")
Rm = Rm - 1
ElseIf Eval(Tid & ".MBN = ""!""") Then
''//标记为未知
Execute(Tid & ".MBN = ""?""")
Execute(Tid & ".innerHTML = """ & Eval(Tid & ".MBN") & """")
Rm = Rm + 1
Execute("BnNum.innerHTML = """ & MNum.Value + 1 & """")
ElseIf Eval(Tid & ".MBN = ""?""") Then
''//标记为一般状态
Execute(Tid & ".MBN = """"")
Execute(Tid & ".innerHTML = "" """)
Execute(Tid & ".className = ""TdOut""")
End If

Execute("BnNum.innerHTML = """ & Rm & """")

''//如果所标记的是雷标识，则计数
If Eval(Tid & ".MineNum = ""地雷""") Then
Ri = Ri - 1
ExeCute(Tid & ".MineNum = ""标记""")
''//下面2行代码可以用来作弊
''//Execute(Tid & ".innerHTML = " & z - Ri)
End If

End Function

Function ShowAllOb()
''//将所有障碍物反白
Dim Oi
For Oi = 0 To UBound(MineArr)
If Eval(MineArr(Oi) & ".MineNum = ""地雷""") Or Eval(MineArr(Oi) & ".MineNum = ""标记""") Then
Execute(MineArr(Oi) & ".style.color = ""#FF0000""")
Execute(MineArr(Oi) & ".bgcolor = ""#FF0000""")
Execute(MineArr(Oi) & ".Disable = ""True""")
Execute(MineArr(Oi) & ".innerHTML = ""地雷""")
Else
Call ShowTMN(MineArr(Oi))
End If
Next
End Function

</script>
<table border="1" align="center" cellpadding="2" cellspacing="1" class="TdOut">
<tr>
<td colspan="3" align="center"><a href="http://www.114xp.cn/" target="_blank">爱雪儿工作室</a> 2004年10月15日晚<br>
<table width="99%" style="height:1px; " border="0" cellpadding="0" cellspacing="0" bordercolor="#999999" bgcolor="#999999">
<tr><td></td></tr></table>
iXuEr Studio WebMine V1.0.0<br>
<a href="http://www.psysch.com/!guidy/" target="_blank">发现问题请通知作者修正，谢谢！</a></td>
</tr>
</table>
</body>
</html>

webasp.net