纯VBScript版的Web扫雷程序

最新推荐文章于 2021-11-12 21:33:11 发布

原创最新推荐文章于 2021-11-12 21:33:11 发布 · 1k 阅读

0 ·

CC 4.0 BY-SA版权

文章标签：

#vbscript #web #function #table #border #input

这是一个使用纯VBScript编写的Web扫雷游戏程序，可在浏览器中直接运行。游戏支持自定义雷区大小和雷数，通过单击来挖开方块并找出所有地雷。右键可标记疑似雷区。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">

<html>

<head>

<title>Guidy的Web扫雷程序 - 纯VBScript版</title>

@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>

<fieldset style="background-color:bottonface;"><legend>扫雷控制面板</legend><table border="0" align="center" cellpadding="0" cellspacing="1">

<tr>

</tr>

<tr>

</tr>

<tr>

</tr>

</table>

</fieldset></td></tr>

</table>

<tr>

<ul>

<li><strong><font color="#FF0000">请设定后点击『开始』按钮，即可进入游戏！</font></strong></li>

<li><strong><font color="#FF0000">缺点是初始化的时候，特别占系统资源！！</font></strong></li>

<li>“扫雷”游戏的目标是尽快找到雷区中的所有地雷，而不许踩到地雷。如果挖开的是地雷，您将输掉游戏。</li>

<li>通过单击即可挖开方块。如果挖开的是地雷，则您输掉游戏。</li>

<li>如果方块上出现数字，则表示在其周围的八个方块中共有多少颗地雷。</li>

<li>要标记您认为可能有地雷的方块，请右键单击它。 </li>

<li>要标记您认为不确定的方块，请右键单击它两次。 </li>

</ul>

</div></div></td>

</tr>

</table>

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 官方网站：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

TmpStr = TmpStr & " </tr>"

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

''''//对雷标识字符串整形

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)

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

''''//显示周围雷数

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

''''//按照雷数的不同显示不同的样式，以便区分

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

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

End Function

</script>

<tr>

<td colspan="3" align="center"><a href="http://www.114xp.cn/" target="_blank">爱雪儿工作室</a> 2004年10月15日晚<br>

iXuEr Studio WebMine V1.0.0<br>

<a href="http://www.psysch.com/!guidy/" target="_blank">发现问题请通知作者修正，谢谢！</a></td>

</tr>

</table>

</body>

</html>