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

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

       '在窗体上加入以下控件

       'image1(0),image1(0) - 黑白棋

       'image2,image3(0)

       'form中的picture为棋盘。因无法上传，棋源源码编译lazarus请自行领会。码黑php vod源码

       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 + "●操作提示:①可选择[先后]、[难度]和[对手]菜单设置游戏,源码vc opengl源码" _

        + 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