Question

VB课程设计 题目如图VB VB VB





Answer 1

界面你自已做一下了，源代码如下。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182

Option Explicit
Dim Board(0 To 18, 0 To 18) As Byte '此数组标识棋盘上每个点是否有子：0 无子，1 黑，2 白子
Dim lastnum As Integer '最新放置棋子的位置号
Const HDist As Integer = 250
Const VDist As Integer = 800
Const Grid As Integer = 250

Private Sub cmdRemoveBlack_Click() '移除黑子
Dim i As Integer
For i = 0 To 360
If Board(i Mod 19, i \ 19) = 1 Then Board(i Mod 19, i \ 19) = 0: shpChess(i).Visible = False
Next
Call CountChess
End Sub

Private Sub cmdRemoveWhite_Click() '移除白子
Dim i As Integer
For i = 0 To 360
If Board(i Mod 19, i \ 19) = 2 Then Board(i Mod 19, i \ 19) = 0: shpChess(i).Visible = False
Next
Call CountChess
End Sub

Private Sub cmdUndo_Click() '撤消最后一步
shpChess(lastnum).Visible = False
Board(lastnum Mod 19, lastnum \ 19) = 0
Call CountChess
End Sub

Private Sub Command1_Click()
Unload Me
End Sub

Private Sub Form_Load()
'窗体加载时，使用直线控件数组生成19*19的围棋盘
Dim i As Integer
Randomize
'生成横线
For i = 1 To 18
Load LinH(i)
Next
For i = 0 To 18
LinH(i).Visible = True
LinH(i).X1 = HDist
LinH(i).Y1 = VDist + Grid * i
LinH(i).Y2 = VDist + Grid * i
LinH(i).X2 = HDist + Grid * 18
Next
'生成竖线
For i = 1 To 18
Load LinV(i)
Next
For i = 0 To 18
LinV(i).Visible = True
LinV(i).Y1 = VDist
LinV(i).X1 = HDist + Grid * i
LinV(i).Y2 = VDist + Grid * 18
LinV(i).X2 = HDist + Grid * i
Next
'生成棋子
For i = 1 To 360
Load shpChess(i)
shpChess(i).FillStyle = 0
shpChess(i).FillColor = vbWhite
Next
For i = 0 To 360
shpChess(i).Top = (i \ 19) * Grid + VDist - 100
shpChess(i).Left = (i Mod 19) * Grid + HDist - 100
shpChess(i).Visible = True
Next
'读取已存的棋局
If Dir("save.txt") <> "" Then
Open "save.txt" For Input As #1
For i = 0 To 360
Input #1, Board(i Mod 19, i \ 19)
Next
Close
End If

Call CountChess
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim i As Integer
Dim j As Integer
'计算行列
i = (X - HDist) / Grid
j = (Y - VDist) / Grid

'防止下标越界
If i > 18 Then i = 18
If i < 0 Then i = 0
If j > 18 Then j = 18
If j < 0 Then j = 0

If Shift = 0 Then '加子
lastnum = j * 19 + i
If Board(i, j) = 0 Then
Select Case Button
Case 1
shpChess(lastnum).FillColor = vbBlack
Board(i, j) = 1
Case 2
shpChess(lastnum).FillColor = vbWhite
Board(i, j) = 2
End Select
shpChess(lastnum).Visible = True
Else
MsgBox "此处有子，不能落子。"
End If
ElseIf Shift = 2 Then '按住Ctrl键去子
If Board(i, j) <> 0 Then
Select Case Button
Case 1
If Board(i, j) = 1 Then
shpChess(i + 19 * j).Visible = False
Board(i, j) = 0
End If
Case 2
If Board(i, j) = 2 Then
shpChess(i + 19 * j).Visible = False
Board(i, j) = 0
End If
End Select
Else
MsgBox "此处无子，不能提子。"
End If
End If
Call CountChess
End Sub
'退出时，保存当前棋局
Private Sub Form_Unload(Cancel As Integer)
Open "save.txt" For Output As #1
Dim i As Integer
For i = 0 To 360
Write #1, Board(i Mod 19, i \ 19),
Next
Close #1
End Sub

Private Sub Timer1_Timer()
Static i As Integer
Dim j As Integer

If i = 0 Then
For j = 0 To 360
shpChess(j).FillColor = vbBlack
Next
i = i + 1
Else
For j = 0 To 360
If Board(j Mod 19, j \ 19) = 1 Then
shpChess(j).FillColor = vbBlack
ElseIf Board(j Mod 19, j \ 19) = 2 Then
shpChess(j).FillColor = vbWhite
Else
shpChess(j).Visible = False
End If
Next
Timer1.Enabled = False
End If

End Sub
Sub CountChess()
Dim total As Byte, black As Byte, white As Byte
Dim i As Integer
Dim j As Integer
For i = 0 To 18
For j = 0 To 18
If Board(i, j) = 1 Then
black = black + 1
ElseIf Board(i, j) = 2 Then
white = white + 1
End If
Next
Next
txtBlack.Text = black
txtWhite.Text = white
txtTotal.Text = black + white
If total = 361 Then MsgBox "Game Over"
End Sub