帝国软件
  设为首页 加入收藏 关于我们
 
解密帝国网站管理系统
栏 目:
 
您的位置:首页 > 技术文档 > ASP编程
Othello游戏源程序
作者: 发布时间:2005-03-12 来源:
<%@ language = vbscript %><%
'程序版权所有者: http://www.rainfall.com/othello/rules/othellorules.html
Response.Buffer=True  dim p(8,8),b(8,8),x(8,8)
p(1,1) = 7 : p(8,1) = 7 : p(8,8) = 7 : p(1,8) = 7 : p(3,3) = 6 : p(3,4) = 6
p(3,5) = 6 : p(3,6) = 6 : p(4,3) = 6 : p(4,6) = 6 : p(5,3) = 6 : p(5,4) = 6
p(6,3) = 6 : p(6,4) = 6 : p(6,5) = 6 : p(6,6) = 6 : p(1,3) = 5 : p(1,6) = 5
p(3,1) = 5 : p(3,8) = 5 : p(6,1) = 5 : p(6,8) = 5 : p(8,3) = 5 : p(8,6) = 5
p(1,4) = 4 : p(1,5) = 4 : p(4,1) = 4 : p(4,8) = 4 : p(5,1) = 4 : p(5,8) = 4
p(8,4) = 4 : p(8,5) = 4 : p(2,3) = 3 : p(2,4) = 3 : p(2,5) = 3 : p(2,6) = 3
p(3,2) = 3 : p(3,7) = 3 : p(4,2) = 3 : p(4,7) = 3 : p(3,2) = 3 : p(3,7) = 3
p(4,2) = 3 : p(4,7) = 3 : p(5,2) = 3 : p(5,7) = 3 : p(6,2) = 3 : p(6,7) = 3
p(7,3) = 3 : p(7,4) = 3 : p(7,5) = 3 : p(7,6) = 3 : p(1,2) = 2 : p(1,7) = 2
p(2,1) = 2 : p(2,8) = 2 : p(7,1) = 2 : p(7,8) = 2 : p(8,2) = 2 : p(8,7) = 2
p(2,2) = 1 : p(2,7) = 1 : p(7,2) = 1 : p(7,7) = 1 for i = 1 to 8
  for j = 1 to 8     b(i,j) = cint(request("b" & i & j))   next next
sel = request("sel") select case sel case 0 ' init   for i=1 to 8
    for j=1 to 8       b(i,j) = 0     next   next
  b(4,4) = 1 : b(5,5) = 1 : b(4,5) = 2 : b(5,4) = 2 case 1 ' human put
  for i=1 to 8     for j=1 to 8
      if request("n" & i & j & ".x") <> "" then call put(i,j,1)     next   next
case 2   call mark(2) ' com mark   cpass = 0   for i=1 to 8
    for j=1 to 8       if x(i,j) <> 0 then cpass = 1     next   next
  if cpass <> 0 then     for i=1 to 8       for j=1 to 8
        if x(i,j) = 1 then    if pp < p(i,j) then      pp = p(i,j)
     ii = i      jj = j     end if  end if       next     next
    call put(ii,jj,2)   end if   call mark(1) ' human mark   hpass = 0
  for i=1 to 8     for j=1 to 8       if x(i,j) <> 0 then hpass = 1     next
  next   if cpass <> 0 and hpass = 0 then sel = 1  ' com again
  if cpass = 0 and hpass = 0 then sel = 3  ' end end select%>
<script language="vbscript" runat=server>sub mark(c) for i=1 to 8   for j=1 to 8
    if (( c1(i,j,c) = 1 or c2(i,j,c) = 1 or c3(i,j,c) = 1 or _
          c4(i,j,c) = 1 or c5(i,j,c) = 1 or c6(i,j,c) = 1 or _
          c7(i,j,c) = 1 or c8(i,j,c) = 1 ) and b(i,j) = 0 ) then
      x(i,j) = 1     else       x(i,j) = 0     end if   next nextend sub
function c1(i,j,c) if c = 1 then cc = 2 if c = 2 then cc = 1 for k=1 to 8
  if ( j-k < 1 ) then c1 = 0 : exit function
  if ( k = 1 and b(i,j-k) <> cc ) then c1 = 0 : exit function
  if ( k > 1 and b(i,j-k) = 0 ) then c1 = 0 : exit function
  if ( k > 1 and b(i,j-k) = c ) then c1 = 1 : exit function nextend function
function c2(i,j,c) if c = 1 then cc = 2 if c = 2 then cc = 1 for k=1 to 8
  if ( i+k > 8 ) then c2 = 0 : exit function
  if ( k = 1 and b(i+k,j) <> cc ) then c2 = 0 : exit function
  if ( k > 1 and b(i+k,j) = 0 ) then c2 = 0 : exit function
  if ( k > 1 and b(i+k,j) = c ) then c2 = 1 : exit function nextend function
function c3(i,j,c) if c = 1 then cc = 2 if c = 2 then cc = 1 for k=1 to 8
  if ( j+k > 8 ) then c3 = 0 : exit function
  if ( k = 1 and b(i,j+k) <> cc ) then c3 = 0 : exit function
  if ( k > 1 and b(i,j+k) = 0 ) then c3 = 0 : exit function
  if ( k > 1 and b(i,j+k) = c ) then c3 = 1 : exit function nextend function
function c4(i,j,c) if c = 1 then cc = 2 if c = 2 then cc = 1 for k=1 to 8
  if ( i-k < 1 ) then c4 = 0 : exit function
  if ( k = 1 and b(i-k,j) <> cc ) then c4 = 0 : exit function
  if ( k > 1 and b(i-k,j) = 0 ) then c4 = 0 : exit function
  if ( k > 1 and b(i-k,j) = c ) then c4 = 1 : exit function nextend function
function c5(i,j,c) if c = 1 then cc = 2 if c = 2 then cc = 1 for k=1 to 8
  if ( i+k > 8 or j-k < 1 ) then c5 = 0 : exit function
  if ( k = 1 and b(i+k,j-k) <> cc ) then c5 = 0 : exit function
  if ( k > 1 and b(i+k,j-k) = 0 ) then c5 = 0 : exit function
  if ( k > 1 and b(i+k,j-k) = c ) then c5 = 1 : exit function nextend function
function c6(i,j,c) if c = 1 then cc = 2 if c = 2 then cc = 1 for k=1 to 8
  if ( i+k > 8 or j+k > 8 ) then c6 = 0 : exit function
  if ( k = 1 and b(i+k,j+k) <> cc ) then c6 = 0 : exit function
  if ( k > 1 and b(i+k,j+k) = 0 ) then c6 = 0 : exit function
  if ( k > 1 and b(i+k,j+k) = c ) then c6 = 1 : exit function nextend function
function c7(i,j,c) if c = 1 then cc = 2 if c = 2 then cc = 1 for k=1 to 8
  if ( i-k < 1 or j+k > 8 ) then c7 = 0 : exit function
  if ( k = 1 and b(i-k,j+k) <> cc ) then c7 = 0 : exit function
  if ( k > 1 and b(i-k,j+k) = 0 ) then c7 = 0 : exit function
  if ( k > 1 and b(i-k,j+k) = c ) then c7 = 1 : exit function nextend function
function c8(i,j,c) if c = 1 then cc = 2 if c = 2 then cc = 1 for k=1 to 8
  if ( i-k < 1 or j-k < 1 ) then c8 = 0 : exit function
  if ( k = 1 and b(i-k,j-k) <> cc ) then c8 = 0 : exit function
  if ( k > 1 and b(i-k,j-k) = 0 ) then c8 = 0 : exit function
  if ( k > 1 and b(i-k,j-k) = c ) then c8 = 1 : exit function nextend function
sub put(i,j,c) b(i,j) = c if c = 1 then cc = 2 if c = 2 then cc = 1
if c1(i,j,c) = 1 then   k = 1   do while b(i,j-k) = cc     b(i,j-k) = c
    k = k + 1   loop end if if c2(i,j,c) = 1 then   k = 1
  do while b(i+k,j) = cc     b(i+k,j) = c     k = k + 1   loop end if
if c3(i,j,c) = 1 then   k = 1   do while b(i,j+k) = cc     b(i,j+k) = c
    k = k + 1   loop end if if c4(i,j,c) = 1 then   k = 1
  do while b(i-k,j) = cc     b(i-k,j) = c     k = k + 1   loop end if
if c5(i,j,c) = 1 then   k = 1   do while b(i+k,j-k) = cc     b(i+k,j-k) = c
    k = k + 1   loop end if if c6(i,j,c) = 1 then   k = 1
  do while b(i+k,j+k) = cc     b(i+k,j+k) = c     k = k + 1   loop end if
if c7(i,j,c) = 1 then   k = 1   do while b(i-k,j+k) = cc     b(i-k,j+k) = c
    k = k + 1   loop end if if c8(i,j,c) = 1 then   k = 1
  do while b(i-k,j-k) = cc     b(i-k,j-k) = c     k = k + 1   loop end if
end sub</script><HTML><HEAD>
<TITLE>Othello</TITLE></HEAD><BODY BGCOLOR="#000000" TEXT="#FFFFFF" LINK="#FF0000" VLINK="#FF0000">
<BR><CENTER><IMG SRC="othello.gif" width=120 height=36></CENTER><BR><CENTER>
<FORM METHOD=POST ACTION=OTHELLO.ASP><TABLE BORDER=1><% for j=1 to 8
  response.write "<tr>"   for i=1 to 8     response.write "<td>"
    response.write "<input type=hidden name=b" & i & j & " value=" & b(i,j) & ">"
    select case b(i,j)     case 0       if x(i,j) = 1 then
       response.write "<input type=image src=""move.gif""  border=0 name=n" & i & j & ">"
      else
       response.write "<img src=""none.gif"" width=20 height=20 border=0>"
      end if     case 1
      response.write "<img src=""white.gif"" width=20 height=20 border=0>"
    case 2
      response.write "<img src=""black.gif"" width=20 height=20 border=0>"
    end select     response.write "</td>"   next   response.write "</tr>" next
response.write "</table><p>" select case sel case 0,1
  response.write "<input type=hidden name=sel value=2>"
  response.write "<input type=submit value=Computer>"  case 2
  response.write "<input type=hidden name=sel value=1>"
  response.write "Din tur" case 3   for i=1 to 8     for j=1 to 8
      if b(i,j) = 1 then human = human + 1
      if b(i,j) = 2 then com = com + 1     next   next 'Added by Alex98
IF com > human THEN response.write "<FONT SIZE=5><B>You lost!</B></FONT><BR>"
ELSE response.write "<FONT SIZE=5><B>You won!</B></FONT><BR>" END IF
  response.write "<B>Score:</B><BR>Computer " & (com) & ".000 points<BR>You " & (human) & ".000
points"   response.write "<BR><A HREF=""othello.asp"">A new game.</A>"
  response.write "<BR><BR><hr NOSHADE><B>Credits:</B><BR>"
  response.write "Original code: <a href=""mailto:itohk@livedoor.com"">Koh Itoh</a><BR>"
  response.write "Gfx & modifications: <a href=""mailto:webmaster@haneng.com"">A. Haneng</a><BR>"
end select%></TABLE></form></center>
<CENTER><FONT SIZE=2><A HREF="http://www.rainfall.com/othello/rules/othellorules.html">Othello
rules</A></FONT></CENTER></body></html>所有源程序及图版请在本站游戏源程序里找找。
  
评论】【加入收藏夹】【 】【打印】【关闭
※ 相关链接
无相关信息

   栏目导行
  PHP编程
  ASP编程
  ASP.NET编程
  JAVA编程
   站点最新
·致合作伙伴的欢迎信
·媒体报道
·帝国软件合作伙伴计划协议
·DiscuzX2.5会员整合通行证发布
·帝国CMS 7.0版本功能建议收集
·帝国网站管理系统2012年授权购买说
·PHPWind8.7会员整合通行证发布
·[官方插件]帝国CMS-访问统计插件
·[官方插件]帝国CMS-sitemap插件
·[官方插件]帝国CMS内容页评论AJAX分
   类别最新
·在ASP中使用数据库
·使用ASP脚本技术
·通过启动脚本来感受ASP的力量
·学习使用ASP对象和组件
·解析asp的脚本语言
·初看ASP-针对初学者
·ASP开发10条经验总结
·ASP之对象总结
·ASP与数据库应用(给初学者)
·关于学习ASP和编程的28个观点
 
关于帝国 | 广告服务 | 联系我们 | 程序开发 | 网站地图 | 留言板 帝国网站管理系统