我想要一个用vb编的五子棋的源码(不要超连接的)

我要的是代码哦 不是给我一个超连接的网站哦 还有不要复杂的!谢谢! 能帮我解释其中算法再加十分哦!

'在窗体上加入以下控件 'image1(0),image1(0) - 黑白棋图片 'image2,image3(0) 'form中的picture图片为棋盘。因无法上传，请自行领会。 Option Explicit Dim I, J, K, Counter, Firstmoved, Rt, Gen, r, flag As Integer Dim Grid(225), H(224), V(224), RL(224), LR(224), Tb(2), Order(225) As Integer Private Sub Form_Initialize() lblHelp.Top = 0 lblHelp.Left = 0 Image1(0).Top = -1000 Image1(1).Top = -1000 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 + "●有什么问题请与本人联系.电子邮件:[email protected]." _ + vbCrLf + vbCrLf + vbCrLf + "●本页面单击后隐藏." End Sub Private Sub Form_Resize() Me.Height = 5800 Me.Width = 5100 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 224 Load Image3(I) '加载棋子控件 Image3(I).Top = (I \ 15) * 22 + 5 Image3(I).Left = (I Mod 15) * 22 + 5 Image3(I).Visible = True Next Ini End Sub '游戏初始化 Sub Ini() For I = 0 To 224 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 = 225 '五子一线 mun = Piece * 5 For I = 0 To 224 If H(I) = mun Or V(I) = mun Or RL(I) = mun Or LR(I) = mun Then LineWin = 225 + Piece Exit Function End If Next I '四子一线 mun = Piece * 4 For I = 0 To 224 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 * 15) = 0 Then LineWin = I + K * 15: Exit Function Next K End If If RL(I) = mun Then For K = 0 To 4 If Grid(I + K * 14) = 0 Then LineWin = I + K * 14: Exit Function Next K End If If LR(I) = mun Then For K = 0 To 4 If Grid(I + K * 16) = 0 Then LineWin = I + K * 16: 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 * 15 + J) = 0 Then ToMove = I * 15 + 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) = 231 Then MsgBox "您输了!" Ini Exit Sub End If If Counter = 225 Then MsgBox "和棋" Ini Exit Sub End If End Sub '低级模式 Function Defend() As Integer Rt = LineWin(6) If Rt < 225 Then Defend = Rt: Exit Function Rt = LineWin(1) If Rt < 225 Then Defend = Rt: Exit Function '查找落子位置 Rt = FindBlank If Rt < 225 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 224 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) = 226 + flag * 5 Then If flag = 0 Then MsgBox "您赢了!" Else MsgBox "您输了!" Ini Exit Sub End If If Counter = 225 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 = -10000 For wz = 0 To 224 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 < 225 Then Attempt = Rt: Exit Function Rt = LineWin(1) If Rt < 225 Then Attempt = Rt: Exit Function '查找落子位置 Rt = linethree(6) If Rt < 225 Then Attempt = Rt: Exit Function Rt = linethree(1) If Rt < 225 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 < 225 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 \ 15 J = ij Mod 15 '横线影响 b = IIf(J - 4 > 0, J - 4, 0) e = IIf(J > 10, 10, J) For K = b To e mun = H(I * 15 + 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 * 15 + K) = H(I * 15 + K) + Piece mun = H(I * 15 + 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 > 10, 10, I) For K = b To e mun = V(K * 15 + 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 * 15 + J) = V(K * 15 + J) + Piece mun = V(K * 15 + 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 > 10, 10, I) b = IIf(b > J + I - IIf(J + 4 > 14, 14, J + 4), b, J + I - IIf(J + 4 > 14, 14, 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 * 15 + 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 * 15 + I + J - K) = RL(K * 15 + I + J - K) + Piece mun = RL(K * 15 + 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 > 10, 10, 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 > 10, 10, J), I - J + IIf(J > 10, 10, J), e) For K = b To e mun = LR(K * 15 - 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 * 15 - I + J + K) = LR(K * 15 - I + J + K) + Piece mun = LR(K * 15 - 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 = 225 '三子一线 mun = Piece * 3 For I = 0 To 224 If H(I) = mun Then If Grid(I) = 0 Then If I Mod 15 < 10 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 \ 15) < 10 Then If Grid(I + 75) = 0 Then For K = 1 To 4 If Grid(I + K * 15) = 0 Then Tb(0) = I + K * 15 Tb(1) = I Tb(2) = I + 75 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 \ 15) < 10 And I Mod 15 > 4 Then If Grid(I + 70) = 0 Then For K = 1 To 4 If Grid(I + K * 14) = 0 Then Tb(0) = I + K * 14 Tb(1) = I Tb(2) = I + 70 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 \ 15) < 10 And I Mod 15 < 10 Then If Grid(I + 80) = 0 Then For K = 1 To 4 If Grid(I + K * 16) = 0 Then Tb(0) = I + K * 16 Tb(1) = I Tb(2) = I + 80 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

像这类挑战人工和机械智能的大多程序代码其实都并非很简单(甚至会很复杂,比如象棋等等),不过可以给简单定一个较低的级别到是很容易实现,网上很多这样的五子棋源码,其中核心算法均已经列出,并且很有参考意义. 虽然可以再重新写一段代码 但结构和算法仍然不会有太大的区别.\ 代码我就不提供了 想必你手上的参考网址应该有一大堆了 ,但如果是单机版的 我可以帮你改成网络联机对战的.

你好！ 像这类挑战人工和机械智能的大多程序代码其实都并非很简单(甚至会很复杂,比如象棋等等),不过可以给简单定一个较低的级别到是很容易实现,网上很多这样的五子棋源码,其中核心算法均已经列出,并且很有参考意义. 虽然可以再重新写一段代码 但结构和算法仍然不会有太大的区别.\ 代码我就不提供了 想必你手上的参考网址应该有一大堆了 ,但如果是单机版的 我可以帮你改成网络联机对战的. 如有疑问，请追问。