用VB画象棋图

精选转载

frankie_zy 2011-03-11 17:12:19 博主文章分类：Visual Basic专区

要在VB程序中画出象棋的样子：
得用VB的Circle，line, scale等关健字，本程序中只放了一个text1,和一个timer1，如图：1

程序中的Function fchonglai()函数即可用程序画出一个象棋图子出来。
这个程序红棋可以动，但黑棋不能动。

程序运行后如图：2，3

VB程序如下：

Dim qx(1 To 10, 1 To 9) As Double
Dim qy(1 To 10, 1 To 9) As Double
Dim hang, zong As Integer
Dim x0, y0 As Double
Dim i, k As Integer

Dim qzm(0 To 32) As String '棋子名
Dim qzwh(1 To 32) As Integer '棋子所在行
Dim qzwz(1 To 32) As Integer '棋子所在列
Dim qz(1 To 32) As Boolean '棋子命
Dim q(1 To 10, 1 To 9) As Integer '盘子中某行某列为何物

Dim se1(1 To 3), se2(1 To 3) As Integer
Dim lmr1(1 To 3), lmr2(1 To 3) As String
Dim myk, mys As Boolean
Dim t6 As Integer
Dim max, min As Integer

Public isme As Boolean '是我在下棋吗，true,为是我
Dim int1 As Integer

Public Function shou()
Dim i, k As Integer
qzm(0) = Form2.chuanti_qzm(0)
For i = 1 To 32
qzm(i) = Form2.chuanti_qzm(i)
qz(i) = Form2.chuanti_qz(i)
qzwh(i) = Form2.chuanti_qzwh(i)
qzwz(i) = Form2.chuanti_qzwz(i)
Next i
For i = 1 To 10
For k = 1 To 9
q(i, k) = Form2.chuanti_q(i, k)
Next k, i
End Function
Public Function chuanti_qzm(ByVal n As Integer) As String
chuanti_qzm = qzm(n)
End Function
Public Function chuanti_qz(ByVal n As Integer) As Boolean
chuanti_qz = qz(n)
End Function
Public Function chuanti_q(ByVal m As Integer, ByVal n As Integer) As Integer
chuanti_q = q(m, n)
End Function
Public Function chuanti_qzwh(ByVal n As Integer) As Integer
chuanti_qzwh = qzwh(n)
End Function
Public Function chuanti_qzwz(ByVal n As Integer) As Integer
chuanti_qzwz = qzwz(n)
End Function

Function fmax(ByVal m As Integer, ByVal n As Integer) As Integer
If m >= n Then
fmax = m
Else
fmax = n
End If
End Function
Function fmin(ByVal m As Integer, ByVal n As Integer) As Integer
If m < n Then
fmin = m
Else
fmin = n
End If
End Function

Function fbojiao() As Boolean
Dim i, k As Integer
Dim leija As Integer
Dim buchang As Integer

Dim bojiao As Boolean

bojiao = True '默认为不泊脚

Select Case lmr1(3)
Case "车"

max = fmax(se1(1), se2(1))
min = fmin(se1(1), se2(1))
If (max - min) >= 2 Then
leija = 0
For i = (min + 1) To (max - 1)
leija = leija + q(i, se1(2))
Next i
If leija > 0 Then
bojiao = False
End If
End If

max = fmax(se1(2), se2(2))
min = fmin(se1(2), se2(2))
If (max - min) >= 2 Then
leija = 0
For i = (min + 1) To (max - 1)
leija = leija + q(se1(1), i)
Next i
If leija > 0 Then
bojiao = False
End If
End If

Case "马"

If Abs(se2(1) - se1(1)) = 2 Then

If q((se1(1) + se2(1)) / 2, se1(2)) > 0 Then
bojiao = False
End If

End If

If Abs(se2(2) - se1(2)) = 2 Then

If q(se1(1), (se1(2) + se2(2)) / 2) > 0 Then
bojiao = False
End If

End If

Case "象"

If q((se1(1) + se2(1)) / 2, (se1(2) + se2(2)) / 2) > 0 Then
bojiao = False
End If

Case "炮"
bojiao = False
buchang = Abs(se2(1) - se1(1)) + Abs(se2(2) - se1(2))

leija = 0
For i = 0 To buchang '第一步要算出累加值
If se2(1) - se1(1) = 0 Then
max = fmax(se1(2), se2(2))
min = fmin(se1(2), se2(2))
If q(se1(1), min + i) > 0 Then
leija = leija + 1
End If
Else '上为左右走向，下为上下走向
max = fmax(se1(1), se2(1))
min = fmin(se1(1), se2(1))
If q(min + i, se1(2)) > 0 Then
leija = leija + 1
End If
End If
Next i

If se2(3) = 0 And leija = 1 Then
bojiao = True
End If

If se2(3) > 0 And leija = 3 Then
bojiao = True
End If

'不是隔山不能吃的，炮
End Select

fbojiao = bojiao

End Function

Function fchidiao()
qz(q(se2(1), se2(2))) = False
End Function

Function fzhixing()

If q(se2(1), se2(2)) > 0 Then
Call fchidiao
End If

q(se2(1), se2(2)) = se1(3)
q(se1(1), se1(2)) = 0
qzwh(se1(3)) = se2(1)
qzwz(se1(3)) = se2(2)

Call fq '刷新棋子

End Function

Function fjiaobu() As Boolean
Dim jiaobu As Boolean
jiaobu = False

Select Case lmr1(3)
Case "车"
If (se2(1) - se1(1)) * (se2(2) - se1(2)) = 0 Then
jiaobu = True
End If

Case "马"
If Abs((se2(1) - se1(1)) * (se2(2) - se1(2))) = 2 And se2(1) >= 1 And se2(1) <= 10 And se2(2) >= 1 And se2(2) <= 9 Then
jiaobu = True
End If

Case "象"
If (se2(1) = 1 Or se2(1) = 3 Or se2(1) = 5) And (se2(2) = 1 Or se2(2) = 3 Or se2(2) = 5 Or se2(2) = 7 Or se2(2) = 9) Then
If Abs(se2(2) - se1(2)) = 2 Then
jiaobu = True
End If

End If

Case "士"
If Abs((se2(1) - se1(1)) * (se2(2) - se1(2))) = 1 And se2(1) >= 1 And se2(1) <= 3 And se2(2) >= 4 And se2(2) <= 6 Then
jiaobu = True
End If

Case "王"
If (se2(1) - se1(1)) * (se2(2) - se1(2)) = 0 And (Abs(se2(1) - se1(1)) + Abs(se2(2) - se1(2))) <= 1 Then
If se2(1) <= 3 And se2(1) >= 1 And se2(2) >= 4 And se2(2) <= 6 Then

jiaobu = True

End If

Case "炮"
If (se2(1) - se1(1)) * (se2(2) - se1(2)) = 0 Then
jiaobu = True
End If

Case "兵"
If se1(1) <= 5 Then

If se2(1) - se1(1) = 1 And se2(2) - se1(2) = 0 Then
jiaobu = True

End If

Else

If se2(1) - se1(1) = 1 And se2(2) - se1(2) = 0 Then
jiaobu = True
End If

If se2(1) - se1(1) = 0 And Abs(se2(2) - se1(2)) = 1 Then
jiaobu = True

End If

End Select

fjiaobu = jiaobu
End Function

Function fis()

mys = False '选择了物体没有
myk = False '可以执行操作么

se1(1) = 1 '行
se1(2) = 1 '列
se1(3) = 0 '是什么（0---32）
se2(1) = 1
se2(2) = 2
se2(3) = 0

End Function

Public Function fq()

Cls

Call huaqp '画棋盘的格子

FillStyle = 0
DrawWidth = 3
For i = 1 To 16
If qz(i) = True Then
FillColor = RGB(231, 2, 22)
hang = qzwh(i)
zong = qzwz(i)
Circle (qx(hang, zong), qy(hang, zong)), 33, RGB(231, 3, 134)
FillColor = RGB(231, 244, 252)
CurrentX = qx(hang, zong) - 21
CurrentY = qy(hang, zong) + 27
FontSize = 18
ForeColor = RGB(252, 252, 252)
Print Right(qzm(i), 1)
End If
Next i
FillStyle = 0
FillColor = RGB(21, 2, 22)
For i = 17 To 32
If qz(i) = True Then
hang = qzwh(i)
zong = qzwz(i)
Circle (qx(hang, zong), qy(hang, zong)), 33, RGB(21, 3, 134)
CurrentX = qx(hang, zong) - 21
CurrentY = qy(hang, zong) + 27
FontSize = 18
ForeColor = RGB(252, 252, 252)
Print Right(qzm(i), 1)
End If
Next i
End Function
Function fqz()
Dim i As Integer
For i = 1 To 32
qz(i) = True
Next i

q(1, 1) = 1
q(1, 2) = 2
q(1, 3) = 3
q(1, 4) = 4
q(1, 5) = 5
q(1, 6) = 6
q(1, 7) = 7
q(1, 8) = 8
q(1, 9) = 9

q(3, 2) = 10
q(3, 8) = 11
q(4, 1) = 12
q(4, 3) = 13
q(4, 5) = 14
q(4, 7) = 15
q(4, 9) = 16

q(10, 1) = 17
q(10, 2) = 18
q(10, 3) = 19
q(10, 4) = 20
q(10, 5) = 21
q(10, 6) = 22
q(10, 7) = 23
q(10, 8) = 24
q(10, 9) = 25

q(8, 2) = 26
q(8, 8) = 27
q(7, 1) = 28
q(7, 3) = 29
q(7, 5) = 30
q(7, 7) = 31
q(7, 9) = 32

End Function
Function fqzm()
qzm(0) = ""
qzm(1) = "左红车"
qzm(2) = "左红马"
qzm(3) = "左红象"
qzm(4) = "左红士"
qzm(5) = "中红王"
qzm(6) = "右红士"
qzm(7) = "右红象"
qzm(8) = "右红马"
qzm(9) = "右红车"
qzm(10) = "左红炮"
qzm(11) = "右红炮"
qzm(12) = "1红兵"
qzm(13) = "2红兵"
qzm(14) = "3红兵"
qzm(15) = "4红兵"
qzm(16) = "5红兵"

qzm(17) = "左黑车"
qzm(18) = "左黑马"
qzm(19) = "左黑象"
qzm(20) = "左黑士"
qzm(21) = "中黑王"
qzm(22) = "右黑士"
qzm(23) = "右黑象"
qzm(24) = "右黑马"
qzm(25) = "右黑车"
qzm(26) = "左黑炮"
qzm(27) = "右黑炮"
qzm(28) = "1黑兵"
qzm(29) = "2黑兵"
qzm(30) = "3黑兵"
qzm(31) = "4黑兵"
qzm(32) = "5黑兵"

End Function

Function fqzw()

qzwz(1) = 1
qzwz(2) = 2
qzwz(3) = 3
qzwz(4) = 4
qzwz(5) = 5
qzwz(6) = 6
qzwz(7) = 7
qzwz(8) = 8
qzwz(9) = 9

qzwz(10) = 2
qzwz(11) = 8
qzwz(12) = 1
qzwz(13) = 3
qzwz(14) = 5
qzwz(15) = 7
qzwz(16) = 9

qzwz(17) = 1
qzwz(18) = 2
qzwz(19) = 3
qzwz(20) = 4
qzwz(21) = 5
qzwz(22) = 6
qzwz(23) = 7
qzwz(24) = 8
qzwz(25) = 9

qzwz(26) = 2
qzwz(27) = 8
qzwz(28) = 1
qzwz(29) = 3
qzwz(30) = 5
qzwz(31) = 7
qzwz(32) = 9

qzwh(1) = 1
qzwh(2) = 1
qzwh(3) = 1
qzwh(4) = 1
qzwh(5) = 1
qzwh(6) = 1
qzwh(7) = 1
qzwh(8) = 1
qzwh(9) = 1
qzwh(10) = 3
qzwh(11) = 3
qzwh(12) = 4
qzwh(13) = 4
qzwh(14) = 4
qzwh(15) = 4
qzwh(16) = 4

qzwh(17) = 10
qzwh(18) = 10
qzwh(19) = 10
qzwh(20) = 10
qzwh(21) = 10
qzwh(22) = 10
qzwh(23) = 10
qzwh(24) = 10
qzwh(25) = 10
qzwh(26) = 8
qzwh(27) = 8
qzwh(28) = 7
qzwh(29) = 7
qzwh(30) = 7
qzwh(31) = 7
qzwh(32) = 7

End Function

Function jiao1(ByVal x0 As Double, ByVal y0 As Double)
Line (x0 + 7, y0 + 9)-(x0 + 19, y0 + 9), vbBlack
Line (x0 + 7, y0 + 9)-(x0 + 7, y0 + 23), vbBlack
End Function
Function jiao2(ByVal x0 As Double, ByVal y0 As Double)
Line (x0 - 7, y0 + 9)-(x0 - 19, y0 + 9), vbBlack
Line (x0 - 7, y0 + 9)-(x0 - 7, y0 + 23), vbBlack
End Function
Function jiao4(ByVal x0 As Double, ByVal y0 As Double)
Line (x0 + 7, y0 - 9)-(x0 + 19, y0 - 9), vbBlack
Line (x0 + 7, y0 - 9)-(x0 + 7, y0 - 23), vbBlack
End Function
Function jiao3(ByVal x0 As Double, ByVal y0 As Double)
Line (x0 - 7, y0 - 9)-(x0 - 19, y0 - 9), vbBlack
Line (x0 - 7, y0 - 9)-(x0 - 7, y0 - 23), vbBlack
End Function

Function jiao(ByVal hang As Integer, ByVal zong As Integer, ByVal n As Integer)

Select Case n
Case 1
Call jiao1(qx(hang, zong), qy(hang, zong))
Call jiao2(qx(hang, zong), qy(hang, zong))
Call jiao3(qx(hang, zong), qy(hang, zong))
Call jiao4(qx(hang, zong), qy(hang, zong))
Case 2
Call jiao1(qx(hang, zong), qy(hang, zong))
Call jiao4(qx(hang, zong), qy(hang, zong))
Case 3
Call jiao2(qx(hang, zong), qy(hang, zong))
Call jiao3(qx(hang, zong), qy(hang, zong))

End Select

End Function
Function huaqp()

hang = 1
zong = 1
x0 = 50
y0 = 10
For hang = 1 To 10
For zong = 1 To 9
qx(hang, zong) = x0 + 82 * zong
qy(hang, zong) = y0 + 92 * hang
DrawWidth = 6
Next zong, hang

FillStyle = 1

DrawWidth = 3
Line (qx(10, 1), qy(10, 1))-(qx(1, 9), qy(1, 9)), vbBlue, B

DrawWidth = 1
For hang = 1 To 10
Line (qx(hang, 1), qy(hang, 1))-(qx(hang, 9), qy(hang, 9)), vbGreen
Next hang

For zong = 1 To 9
Line (qx(1, zong), qy(1, zong))-(qx(10, zong), qy(10, zong)), vbGreen
Next zong

FillStyle = 0
FillColor = BackColor
Line (qx(6, 1) + 3, qy(6, 1) - 3)-(qx(5, 9) - 3, qy(5, 9) + 3), BackColor, B

FontSize = 25
ForeColor = RGB(123, 1, 11)

CurrentX = qx(6, 3)
CurrentY = qy(6, 3) - 7
Print "楚河汉界"

Call jiao(3, 2, 1)
Call jiao(3, 8, 1)
Call jiao(8, 2, 1)
Call jiao(8, 8, 1)

Call jiao(4, 3, 1)
Call jiao(4, 5, 1)
Call jiao(4, 7, 1)
Call jiao(7, 3, 1)
Call jiao(7, 5, 1)
Call jiao(7, 7, 1)

Call jiao(4, 1, 2)
Call jiao(7, 1, 2)
Call jiao(4, 9, 3)
Call jiao(7, 9, 3)

Line (qx(3, 4), qy(3, 4))-(qx(1, 6), qy(1, 6)), RGB(0, 128, 0)
Line (qx(10, 4), qy(10, 4))-(qx(8, 6), qy(8, 6)), RGB(0, 128, 0)

Line (qx(1, 4), qy(1, 4))-(qx(3, 6), qy(3, 6)), RGB(0, 128, 0)
Line (qx(8, 4), qy(8, 4))-(qx(10, 6), qy(10, 6)), RGB(0, 128, 0)

End Function

Function fchonglai()
Form1.Caption = " 象棋大战！"
Height = 7000
Width = Height / 0.8
Top = (Screen.Height - Height) / 2
Left = (Screen.Width - Width) / 2
Show
Scale (0, 1000)-(1000, 0)

Cls
Call fqzm '初始化棋子的名字
Call fqzw '初始化棋子的位置
Call huaqp '画棋盘的格子
Call fqz '初始化棋子的命
Call fq '刷新棋子

Call fis '初始化选择物体

End Function

Private Sub Form_Load()

Form1.Show

isme = True

Call fchonglai '重新来一局棋吧！

Form1.Caption = "form11111111111111111111,红方执棋"

End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If isme = False Then
GoTo myback
End If

Dim xx, yy As Double
Dim hh, zz As Integer
Dim whoid As Integer
Dim who As String

Dim dxx, dyy As Integer

'无孔不入

If mys = True Then
'选取了棋子begin
xx = (X - 50) / 82
yy = (Y - 10) / 92
zz = CInt(xx)
hh = CInt(yy)
If hh >= 1 And hh <= 10 And zz >= 1 And zz <= 9 Then
whoid = q(hh, zz)
who = qzm(whoid)

lmr2(1) = Left(who, 1)
lmr2(2) = Mid(who, 2, 1)
lmr2(3) = Right(who, 1)

If lmr2(2) = "红" Then
GoTo mygo
End If

If lmr2(2) = "黑" Or lmr2(2) = "" Then

se2(1) = hh
se2(2) = zz
se2(3) = whoid

myk = fjiaobu '检验步法是否正确

If myk = True Then

If fbojiao = True Then

Call fzhixing '人，即我开始下一脚棋

isme = False
Timer1.Enabled = True

End If

End If
mys = False

Else

'
mys = True
se1(1) = hh
se1(2) = zz
se1(3) = whoid

FillStyle = 1
DrawWidth = 3

Circle (qx(hh, zz), qy(hh, zz)), 33, RGB(21, 32, 233)

End If
End If
'选取了棋子end
Else
'没有选取棋子
xx = (X - 50) / 82
yy = (Y - 10) / 92
zz = CInt(xx)
hh = CInt(yy)

If hh >= 1 And hh <= 10 And zz >= 1 And zz <= 9 Then
'在其盘的格子之内
whoid = q(hh, zz)
who = qzm(whoid)
lmr1(1) = Left(who, 1)
lmr1(2) = Mid(who, 2, 1)
lmr1(3) = Right(who, 1)

mygo:

If lmr1(2) = "红" Then
Call fq

mys = True
se1(1) = hh
se1(2) = zz
se1(3) = whoid

FillStyle = 1
DrawWidth = 3

Circle (qx(hh, zz), qy(hh, zz)), 33, RGB(21, 32, 233)

End If

End If
End If

myback:

End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

Line (850, 0)-(850, 1000)
If X > 850 Then
End
End If

End Sub