For I = 1 To n
s = s + p
p = 2 ^ I
Next I
I = 1
Do While I <= n '这里应该是小于等于N 不是小于N
s = s + p
p = 2 ^ I
I = I + 1
Loop
吃多少年的问题: s 02 / (500 6000000000# 365)
结果为 336927年
看下棋盘的row和column各多少行，然后建立一个2d数组
boolean[][] pos = new boolean[row][column];
初始化2d数组为boolean并且全部赋值为false
你要做的就是随机产生row和column，用Random里的nextInt(row 或者column)随机产生点，并将
pos[row][column] = true;
网上转载的，呵呵，我也不太明白
'在窗体上加入以下控件
'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()
lblHelpTop = 0
lblHelpLeft = 0
Image1(0)Top = -1000
Image1(1)Top = -1000
lblHelpLeft = -lblHelpWidth
lblHelp = vbCrLf + vbCrLf + " 游戏帮助" + vbCrLf _
+ vbCrLf + vbCrLf + "●游戏规则:黑方先行,轮流弈子,任一方向先连成五子者胜" _
+ vbCrLf + vbCrLf + vbCrLf + "● *** 作提示:①可选择[先后]、[难度]和[对手]菜单设置游戏," _
+ vbCrLf + vbCrLf + " 只有按[游戏]->[开始]后才可在棋盘上落子" _
+ vbCrLf + vbCrLf + " ②按[游戏]->[清盘]可重玩并设置游戏" _
+ vbCrLf + vbCrLf + " ③落子后按[动作]菜单下的选择可任意悔棋和恢复" _
+ vbCrLf + vbCrLf + " ④各功能菜单都提供了快捷键(Alt+相应字母)" _
+ vbCrLf + vbCrLf + vbCrLf + "●有什么问题请与本人联系电子邮件:xwwxyz@sinacom" _
+ vbCrLf + vbCrLf + vbCrLf + "●本页面单击后隐藏"
End Sub
Private Sub Form_Resize()
MeHeight = 5800
MeWidth = 5100
End Sub
Private Sub lblHelp_Click()
lblHelpVisible = False
End Sub
Private Sub mnuAfter_Click()
Firstmoved = 0
mnuAfterChecked = True
mnuFirstChecked = 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
mnuBackEnabled = False
Counter = 0
Gen = 0
If mnuAfterChecked = True Then
Firstmoved = 0
Else
Firstmoved = 1
End If
mnuStartEnabled = 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 mnuLowerChecked = 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()
mnuComebackEnabled = 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 mnuComputerChecked = 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 mnuComputerChecked = True Then mnuBackEnabled = False
If Counter = 0 Then mnuBackEnabled = False
End Sub
'恢复棋子
Private Sub mnuComeback_Click()
mnuBackEnabled = 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 mnuComputerChecked = 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 mnuComebackEnabled = False
End Sub
Private Sub mnuComputer_Click() '对手
mnuComputerChecked = True '电脑
mnuHumanChecked = False '棋手
End Sub
Private Sub mnuClear_Click() '清盘
Ini
mnuFirstEnabled = True
mnuAfterEnabled = True
mnuLowerEnabled = True
mnuHigherEnabled = True
mnuComputerEnabled = True
mnuHumanEnabled = True
End Sub
Private Sub mnuHuman_Click()
mnuHumanChecked = True
mnuComputerChecked = False
End Sub
Private Sub mnuStart_Click() '开始
lblHelpVisible = False
For I = 0 To 224
Image3(I)Enabled = True
Next I
mnuFirstEnabled = False
mnuAfterEnabled = False
mnuLowerEnabled = False
mnuHigherEnabled = False
mnuComputerEnabled = False
mnuHumanEnabled = False
If Firstmoved = 0 And mnuComputerChecked = True Then ComputerMove
If Firstmoved = 0 And mnuHumanChecked = True Then flag = 1 Else flag = 0
mnuStartEnabled = 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
mnuBackEnabled = True
mnuComebackEnabled = 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 mnuComputerChecked = 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
mnuAfterChecked = False
mnuFirstChecked = True
End Sub
Private Sub mnuHigher_Click()
mnuLowerChecked = False
mnuHigherChecked = True
End Sub
Private Sub mnuLower_Click() '难度
mnuLowerChecked = True
mnuHigherChecked = 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() '帮助
lblHelpVisible = True
End Sub
Dim X1 As Integer
Dim Y1 As Integer
Dim X2 As Integer
Dim Y2 As Integer
Dim Step As Integer
Dim Waiting As Boolean
Private Sub Check1_Click()
Winsock1LocalPort = port
Winsock1Listen
End Sub
Private Sub Command1_Click()
Winsock1RemoteHost = Ip
Winsock1RemotePort = port
Winsock1Connect
End Sub
Private Sub Form_Load()
Step = 200
X1 = 400
Y1 = 600
X2 = 400 + Step 24
Y2 = 600 + Step 24
Check2BackColor = vbYellow
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Waiting = False Then
QiZhi X, Y, True
End If
End Sub
Private Sub Form_Paint()
For i = 0 To 24
MeLine (X1, Y1 + Step i)-(X2, Y1 + Step i)
MeLine (X1 + Step i, Y1)-(X1 + Step i, Y2)
Next
End Sub
Private Function QiZhi(X, Y, SendData As Boolean)
Dim color As Long
Dim xx As Integer
Dim yy As Integer
xx = (((X - X1 - 100) \ (Step \ 2)) \ 2 + 1) Step + X1
yy = (((Y - Y1 - 100) \ (Step \ 2)) \ 2 + 1) Step + Y1
If Check2Value = 1 Then
If SendData Then
color = vbBlue
Else
color = vbYellow
End If
Else
If SendData Then
color = vbYellow
Else
color = vbBlue
End If
End If
For i = 0 To 49
MeCircle (xx, yy), i 2, color
Next
If SendData Then
Winsock1SendData Str(xx) & "| " & Str(yy)
Waiting = True
Label3 = "轮到对方下棋 "
Else
Waiting = False
Label3 = "轮到你了，赶快 "
End If
End Function
Private Sub Check2_Click()
If Check2Value = 1 Then
Check2BackColor = vbBlue
Else
Check2BackColor = vbYellow
End If
End Sub
Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
If Winsock1State <> sckClosed Then Winsock1Close
Winsock1Accept requestID
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim xx As Integer
Dim yy As Integer
Dim dd As String
Winsock1GetData dd, vbString, bytesTotal
DebugPrint dd
a = Split(dd, "| ")
QiZhi a(0), a(1), False
End Sub
Public Class Form1
Private Sub Form1_Load(ByVal sender As SystemObject, ByVal e As SystemEventArgs) Handles MyBaseLoad
Label1Text = "姓名"
Label2Text = "性别"
Label3Text = "爱好"
RadioButton1Text = "男"
RadioButton2Text = "女"
CheckBox1Text = "篮球"
CheckBox2Text = "羽毛球"
CheckBox3Text = "足球"
CheckBox4Text = "乒乓球"
CheckBox5Text = "下棋"
CheckBox6Text = "游泳"
TextBox1Text = ""
Button1Text = "确定"
End Sub
Private Sub Button1_Click(ByVal sender As SystemObject, ByVal e As SystemEventArgs) Handles Button1Click
Dim str As String = ""
str = str & TextBox1Text & " "
If RadioButton1Checked = True Then
str = str & "性别:男 "
Else
str = str & "性别:女 "
End If
str = str & "兴趣爱好："
If CheckBox1Checked = True Then
str = str & "篮球 "
End If
If CheckBox2Checked = True Then
str = str & "羽毛球 "
End If
If CheckBox3Checked = True Then
str = str & "足球 "
End If
If CheckBox4Checked = True Then
str = str & "乒乓球 "
End If
If CheckBox5Checked = True Then
str = str & "下棋 "
End If
If CheckBox6Checked = True Then
str = str & "游泳 "
End If
ComboBox1ItemsAdd(str)
End Sub
End Class
放一个timer控件
在timer上写
n++
if n > 1000 then 落子超时
你timer启用了没Interval属性启用了没变量n要先给个初值的还有我写的"落子超时" 是指你落子超时后的代码你别超中文上去了啊
以上就是关于求助高手~！！VB do while 国际象棋棋盘上的麦粒程序！！全部的内容，包括:求助高手~！！VB do while 国际象棋棋盘上的麦粒程序！！、怎么在vb6.0中做一个可以下棋的五子棋盘、vb问题 求各位帮忙等相关内容解答，如果想了解更多相关内容，可以关注我们，你们的支持是我们更新的动力！
欢迎分享，转载请注明来源：内存溢出
微信扫一扫
支付宝扫一扫
评论列表（0条）