【非源码开发】【chess游戏源码】【cms源码建站】nel源码

2024-12-29 15:51:17 来源:推金币源码 cocos 分类:热点

1.vb问题 求各位帮忙

nel源码

vb问题 求各位帮忙

       网上转载的,呵呵,非源码开发我也不太明白

       '在窗体上加入以下控件

       'image1(0),chess游戏源码image1(0) - 黑白棋

       'image2,image3(0)

       'form中的picture为棋盘。因无法上传,cms源码建站请自行领会。requests 编码 源码

       Option Explicit

       Dim I,会员 资料 源码 J, K, Counter, Firstmoved, Rt, Gen, r, flag As Integer

       Dim Grid(), H(), V(), RL(), LR(), Tb(2), Order() As Integer

       Private Sub Form_Initialize()

       lblHelp.Top = 0

       lblHelp.Left = 0

       Image1(0).Top = -

       Image1(1).Top = -

       lblHelp.Left = -lblHelp.Width

       lblHelp = vbCrLf + vbCrLf + " 游戏帮助" + vbCrLf _

       + vbCrLf + vbCrLf + "●游戏规则:黑方先行,轮流弈子,任一方向先连成五子者胜." _

       + vbCrLf + vbCrLf + vbCrLf + "●操作提示:①可选择[先后]、[难度]和[对手]菜单设置游戏," _

       + vbCrLf + vbCrLf + " 只有按[游戏]->[开始]后才可在棋盘上落子." _

       + vbCrLf + vbCrLf + " ②按[游戏]->[清盘]可重玩并设置游戏." _

       + vbCrLf + vbCrLf + " ③落子后按[动作]菜单下的选择可任意悔棋和恢复." _

       + vbCrLf + vbCrLf + " ④各功能菜单都提供了快捷键(Alt+相应字母)." _

       + vbCrLf + vbCrLf + vbCrLf + "●有什么问题请与本人联系.电子邮件:xwwxyz@sina.com." _

       + vbCrLf + vbCrLf + vbCrLf + "●本页面单击后隐藏."

       End Sub

       Private Sub Form_Resize()

       Me.Height =

       Me.Width =

       End Sub

       Private Sub lblHelp_Click()

       lblHelp.Visible = False

       End Sub

       Private Sub mnuAfter_Click()

       Firstmoved = 0

       mnuAfter.Checked = True

       mnuFirst.Checked = False

       End Sub

       Private Sub Form_Load()

       Dim I As Integer

       For I = 1 To

       Load Image3(I) '加载棋子控件

       Image3(I).Top = (I \ ) * + 5

       Image3(I).Left = (I Mod ) * + 5

       Image3(I).Visible = True

       Next

       Ini

       End Sub

       '游戏初始化

       Sub Ini()

       For I = 0 To

       Image3(I) = Image2

       Image3(I).Enabled = False

       Grid(I) = 0

       V(I) = 0

       H(I) = 0

       LR(I) = 0

       RL(I) = 0

       Next I

       mnuBack.Enabled = False

       Counter = 0

       Gen = 0

       If mnuAfter.Checked = True Then

       Firstmoved = 0

       Else

       Firstmoved = 1

       End If

       mnuStart.Enabled = True

       End Sub

       '一方是否可获胜

       Function LineWin(Piece As Integer) As Integer

       Dim mun As Integer

       LineWin =

       '五子一线

       mun = Piece * 5

       For I = 0 To

       If H(I) = mun Or V(I) = mun Or RL(I) = mun Or LR(I) = mun Then

       LineWin = + Piece

       Exit Function

       End If

       Next I

       '四子一线

       mun = Piece * 4

       For I = 0 To

       If H(I) = mun Then

       For K = 0 To 4

       If Grid(I + K) = 0 Then LineWin = I + K: Exit Function

       Next K

       End If

       If V(I) = mun Then

       For K = 0 To 4

       If Grid(I + K * ) = 0 Then LineWin = I + K * : Exit Function

       Next K

       End If

       If RL(I) = mun Then

       For K = 0 To 4

       If Grid(I + K * ) = 0 Then LineWin = I + K * : Exit Function

       Next K

       End If

       If LR(I) = mun Then

       For K = 0 To 4

       If Grid(I + K * ) = 0 Then LineWin = I + K * : Exit Function

       Next K

       End If

       Next I

       End Function

       '计算机走棋

       Sub ComputerMove()

       Dim ToMove As Integer

       If Counter = 0 Then

       Randomize

       I = Int(Rnd * 7 + 4)

       J = Int(Rnd * 7 + 4)

       If Grid(I * + J) = 0 Then ToMove = I * + J

       Else

       If mnuLower.Checked = True Then ToMove = Defend Else ToMove = Attempt

       End If

       Counter = Counter + 1

       If Firstmoved = 0 Then Image3(ToMove) = Image1(0) Else Image3(ToMove) = Image1(1)

       Grid(ToMove) = 2

       Order(Counter) = ToMove

       LineGen ToMove, 6

       If LineWin(6) = Then

       MsgBox "您输了!"

       Ini

       Exit Sub

       End If

       If Counter = Then

       MsgBox "和棋"

       Ini

       Exit Sub

       End If

       End Sub

       '低级模式

       Function Defend() As Integer

       Rt = LineWin(6)

       If Rt < Then Defend = Rt: Exit Function

       Rt = LineWin(1)

       If Rt < Then Defend = Rt: Exit Function

       '查找落子位置

       Rt = FindBlank

       If Rt < Then Defend = Rt: Exit Function

       End Function

       '悔棋

       Private Sub mnuBack_Click()

       mnuComeback.Enabled = True

       If (Counter + Firstmoved) Mod 2 = 0 Then Rt = -1 Else Rt = -6

       Grid(Order(Counter)) = 0

       Image3(Order(Counter)) = Image2

       LineGen Order(Counter), Rt

       Counter = Counter - 1

       If mnuComputer.Checked = True Then

       Grid(Order(Counter)) = 0

       Image3(Order(Counter)) = Image2

       LineGen Order(Counter), -1

       Counter = Counter - 1

       Else

       flag = 1 - flag

       End If

       r = r + 1

       If Counter = 1 And Firstmoved = 0 And mnuComputer.Checked = True Then mnuBack.Enabled = False

       If Counter = 0 Then mnuBack.Enabled = False

       End Sub

       '恢复棋子

       Private Sub mnuComeback_Click()

       mnuBack.Enabled = True

       Counter = Counter + 1

       If (Counter + Firstmoved) Mod 2 = 0 Then

       Grid(Order(Counter)) = 1

       Image3(Order(Counter)) = Image1(1 - Firstmoved)

       LineGen Order(Counter), 1

       Else

       Grid(Order(Counter)) = 2

       Image3(Order(Counter)) = Image1(Firstmoved)

       LineGen Order(Counter), 6

       End If

       If mnuComputer.Checked = True Then

       Counter = Counter + 1

       Grid(Order(Counter)) = 2

       Image3(Order(Counter)) = Image1(Firstmoved)

       LineGen Order(Counter), 6

       Else

       flag = 1 - flag

       End If

       r = r - 1

       If r = 0 Then mnuComeback.Enabled = False

       End Sub

       Private Sub mnuComputer_Click() '对手

       mnuComputer.Checked = True '电脑

       mnuHuman.Checked = False '棋手

       End Sub

       Private Sub mnuClear_Click() '清盘

       Ini

       mnuFirst.Enabled = True

       mnuAfter.Enabled = True

       mnuLower.Enabled = True

       mnuHigher.Enabled = True

       mnuComputer.Enabled = True

       mnuHuman.Enabled = True

       End Sub

       Private Sub mnuHuman_Click()

       mnuHuman.Checked = True

       mnuComputer.Checked = False

       End Sub

       Private Sub mnuStart_Click() '开始

       lblHelp.Visible = False

       For I = 0 To

       Image3(I).Enabled = True

       Next I

       mnuFirst.Enabled = False

       mnuAfter.Enabled = False

       mnuLower.Enabled = False

       mnuHigher.Enabled = False

       mnuComputer.Enabled = False

       mnuHuman.Enabled = False

       If Firstmoved = 0 And mnuComputer.Checked = True Then ComputerMove

       If Firstmoved = 0 And mnuHuman.Checked = True Then flag = 1 Else flag = 0

       mnuStart.Enabled = False

       End Sub

       '玩家走棋

       Private Sub image3_Click(Index As Integer)

       If Grid(Index) <> 0 Then Exit Sub

       Counter = Counter + 1

       If Firstmoved = 0 Then

       Image3(Index) = Image1(1 - flag)

       Else

       Image3(Index) = Image1(flag)

       End If

       Grid(Index) = 1 + flag

       Order(Counter) = Index

       mnuBack.Enabled = True

       mnuComeback.Enabled = False

       r = 0

       LineGen Index, (1 + flag * 5)

       If LineWin(1 + flag * 5) = + flag * 5 Then

       If flag = 0 Then MsgBox "您赢了!" Else MsgBox "您输了!"

       Ini

       Exit Sub

       End If

       If Counter = Then

       MsgBox "和棋"

       Ini

       Exit Sub

       End If

       If mnuComputer.Checked = True Then ComputerMove Else flag = 1 - flag

       End Sub

       '查找可以落子的空位

       Function FindBlank() As Integer

       Dim wz, fs, lz, RndNum As Integer

       fs = -

       For wz = 0 To

       If Grid(wz) = 0 Then

       Grid(wz) = 2

       LineGen wz, 6

       Rt = Gen

       If Rt > fs Then fs = Rt: lz = wz

       Grid(wz) = 0

       LineGen wz, -6

       End If

       Next wz

       FindBlank = lz

       End Function

       '高级模式

       Function Attempt() As Integer

       Dim wz As Integer

       Rt = LineWin(6)

       If Rt < Then Attempt = Rt: Exit Function

       Rt = LineWin(1)

       If Rt < Then Attempt = Rt: Exit Function

       '查找落子位置

       Rt = linethree(6)

       If Rt < Then Attempt = Rt: Exit Function

       Rt = linethree(1)

       If Rt < Then

       Grid(Tb(0)) = 2

       LineGen Tb(0), 6

       Rt = Gen: wz = Tb(0)

       Grid(Tb(0)) = 0

       LineGen Tb(0), -6

       Grid(Tb(1)) = 2

       LineGen Tb(1), 6

       If Rt < Gen Then Rt = Gen: wz = Tb(1)

       Grid(Tb(1)) = 0

       LineGen Tb(1), -6

       Grid(Tb(2)) = 2

       LineGen Tb(2), 6

       If Rt < Gen Then Rt = Gen: wz = Tb(2)

       Grid(Tb(2)) = 0

       LineGen Tb(2), -6

       Attempt = wz

       Exit Function

       End If

       Rt = FindBlank

       If Rt < Then Attempt = Rt: Exit Function

       End Function

       Private Sub mnuFirst_Click() '先后手

       Firstmoved = 1

       mnuAfter.Checked = False

       mnuFirst.Checked = True

       End Sub

       Private Sub mnuHigher_Click()

       mnuLower.Checked = False

       mnuHigher.Checked = True

       End Sub

       Private Sub mnuLower_Click() '难度

       mnuLower.Checked = True

       mnuHigher.Checked = False

       End Sub

       '局势评估

       Function LineGen(ij, Piece)

       Dim b, e, mun As Integer

       I = ij \

       J = ij Mod

       '横线影响

       b = IIf(J - 4 > 0, J - 4, 0)

       e = IIf(J > , , J)

       For K = b To e

       mun = H(I * + K)

       If mun < 6 Then Gen = Gen + mun * 2 ^ mun

       If mun > 5 And mun Mod 6 = 0 Then mun = mun \ 6 - 1: Gen = Gen - mun * 2 ^ mun

       H(I * + K) = H(I * + K) + Piece

       mun = H(I * + K)

       If mun < 6 Then Gen = Gen - mun * 2 ^ mun

       If mun > 5 And mun Mod 6 = 0 Then mun = mun \ 6 - 1: Gen = Gen + mun * 2 ^ mun

       Next K

       '竖线影响

       b = IIf(I - 4 > 0, I - 4, 0)

       e = IIf(I > , , I)

       For K = b To e

       mun = V(K * + J)

       If mun < 6 Then Gen = Gen + mun * 2 ^ mun

       If mun > 5 And mun Mod 6 = 0 Then mun = mun \ 6 - 1: Gen = Gen - mun * 2 ^ mun

       V(K * + J) = V(K * + J) + Piece

       mun = V(K * + J)

       If mun < 6 Then Gen = Gen - mun * 2 ^ mun

       If mun > 5 And mun Mod 6 = 0 Then mun = mun \ 6 - 1: Gen = Gen + mun * 2 ^ mun

       Next K

       '撇线影响

       b = IIf(I - 4 > 0, I - 4, 0)

       e = IIf(I > , , I)

       b = IIf(b > J + I - IIf(J + 4 > , , J + 4), b, J + I - IIf(J + 4 > , , J + 4))

       e = IIf(e > J + I - IIf(J > 4, J, 4), J + I - IIf(J > 4, J, 4), e)

       For K = b To e

       mun = RL(K * + I + J - K)

       If mun < 6 Then Gen = Gen + mun * 2 ^ mun

       If mun > 5 And mun Mod 6 = 0 Then mun = mun \ 6 - 1: Gen = Gen - mun * 2 ^ mun

       RL(K * + I + J - K) = RL(K * + I + J - K) + Piece

       mun = RL(K * + I + J - K)

       If mun < 6 Then Gen = Gen - mun * 2 ^ mun

       If mun > 5 And mun Mod 6 = 0 Then mun = mun \ 6 - 1: Gen = Gen + mun * 2 ^ mun

       Next K

       '捺线影响

       b = IIf(I - 4 > 0, I - 4, 0)

       e = IIf(I > , , I)

       b = IIf(b > I - J + IIf(J - 4 > 0, J - 4, 0), b, I - J + IIf(J - 4 > 0, J - 4, 0))

       e = IIf(e > I - J + IIf(J > , , J), I - J + IIf(J > , , J), e)

       For K = b To e

       mun = LR(K * - I + J + K)

       If mun < 6 Then Gen = Gen + mun * 2 ^ mun

       If mun > 5 And mun Mod 6 = 0 Then mun = mun \ 6 - 1: Gen = Gen - mun * 2 ^ mun

       LR(K * - I + J + K) = LR(K * - I + J + K) + Piece

       mun = LR(K * - I + J + K)

       If mun < 6 Then Gen = Gen - mun * 2 ^ mun

       If mun > 5 And mun Mod 6 = 0 Then mun = mun \ 6 - 1: Gen = Gen + mun * 2 ^ mun

       Next K

       End Function

       '是否存在三子一线(可发展成五子联线)

       Function linethree(Piece As Integer) As Integer

       Dim mun As Integer

       linethree =

       '三子一线

       mun = Piece * 3

       For I = 0 To

       If H(I) = mun Then

       If Grid(I) = 0 Then

       If I Mod < Then

       If Grid(I + 5) = 0 Then

       For K = 1 To 4

       If Grid(I + K) = 0 Then

       Tb(0) = I + K

       Tb(1) = I

       Tb(2) = I + 5

       linethree = Tb(0)

       Exit Function

       End If

       Next K

       End If

       End If

       End If

       End If

       If V(I) = mun Then

       If Grid(I) = 0 Then

       If (I \ ) < Then

       If Grid(I + ) = 0 Then

       For K = 1 To 4

       If Grid(I + K * ) = 0 Then

       Tb(0) = I + K *

       Tb(1) = I

       Tb(2) = I +

       linethree = Tb(0)

       Exit Function

       End If

       Next K

       End If

       End If

       End If

       End If

       If RL(I) = mun Then

       If Grid(I) = 0 Then

       If (I \ ) < And I Mod > 4 Then

       If Grid(I + ) = 0 Then

       For K = 1 To 4

       If Grid(I + K * ) = 0 Then

       Tb(0) = I + K *

       Tb(1) = I

       Tb(2) = I +

       linethree = Tb(0)

       Exit Function

       End If

       Next K

       End If

       End If

       End If

       End If

       If LR(I) = mun Then

       If Grid(I) = 0 Then

       If (I \ ) < And I Mod < Then

       If Grid(I + ) = 0 Then

       For K = 1 To 4

       If Grid(I + K * ) = 0 Then

       Tb(0) = I + K *

       Tb(1) = I

       Tb(2) = I +

       linethree = Tb(0)

       Exit Function

       End If

       Next K

       End If

       End If

       End If

       End If

       Next I

       End Function

       Private Sub munHelp_Click() '帮助

       lblHelp.Visible = True

       End Sub

更多资讯请点击:热点

热门资讯

cad源码管理

2024-12-29 14:552000人浏览

foxmail系统源码

2024-12-29 14:39152人浏览

正则源码提取_正则 提取

2024-12-29 14:052021人浏览

推荐资讯

德黑蘭一學生宿舍發生一氧化碳中毒事件 44人被緊急送醫

據央視新聞報道,當地時間12月6日,伊朗首都德黑蘭一學生宿舍發生一氧化碳中毒事件,導致44人中毒。事件發生後,中毒者已被立即送往醫院進行治療。責任編輯: 張岩

gps模板源码_gps平台源码

1.如何利用Android编程实现GPS定位2.如何更改安卓手机GPS位置? - 知乎3.导出GPS地图如何利用Androidç

正则源码提取_正则 提取

1.如何用java中HTMLPraser提取网页源代码中的某些链接2.11《Python 原生爬虫教程》使用正则表达式进行页面提取如何用java中HTMLPraser提取网页源代码中的某些链接 使