要在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))
If q(se1(1),min + i) > 0 Then
leija = leija + 1
End If
Else '上为左右走向，下为上下走向
max = fmax(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
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 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,22)
For i = 17 To 32
If qz(i) = True Then
hang = qzwh(i)
zong = qzwz(i)
Circle (qx(hang,RGB(21,134)
CurrentX = qx(hang,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,vbBlack
Line (x0 - 7,y0 + 9)-(x0 - 7,vbBlack
End Function
Function jiao4(ByVal x0 As Double,y0 - 9)-(x0 + 19,y0 - 9),y0 - 9)-(x0 + 7,y0 - 23),vbBlack
End Function
Function jiao3(ByVal x0 As Double,y0 - 9)-(x0 - 19,y0 - 9)-(x0 - 7,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))
Call jiao2(qx(hang,zong))
Call jiao3(qx(hang,zong))
Call jiao4(qx(hang,zong))
Case 2
Call jiao1(qx(hang,zong))
Case 3
Call jiao2(qx(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))-(qx(hang,vbGreen
Next hang
For zong = 1 To 9
Line (qx(1,zong))-(qx(10,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,1)
Call jiao(3,8,1)
Call jiao(8,1)
Call jiao(4,1)
Call jiao(4,5,7,1)
Call jiao(7,2)
Call jiao(7,2)
Call jiao(4,9,3)
Call jiao(7,3)
Line (qx(3,4),qy(3,4))-(qx(1,6),6)),RGB(0,128,0)
Line (qx(10,4))-(qx(8,qy(8,0)
Line (qx(1,4))-(qx(3,0)
Line (qx(8,4))-(qx(10,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 = "form22222222222222222222,红方执棋"
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,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)),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,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,233)
End If
End If
End If
myback:
End Sub
Private Sub Form_MouseUp(Button As Integer,Y As Single)
Line (850,0)-(850,1000)
If X > 850 Then
End
End If
End Sub
Private Sub Timer1_Timer()
int1 = int1 + 1
Text1.Text = int1
'qzwh(1 To 32) As Integer '棋子所在行
' qzwz(1 To 32) As Integer '棋子所在列
' qz(1 To 32) As Boolean '棋子命
' q(1 To 10,1 To 9) As Integer '盘子中某行某列为何物
Call fq '刷新棋子
Timer1.Enabled = False
isme = True
End Sub
大家有没有注意到，在程序运行时如最小化，再弹出的话，图形清除了，这是因为form1 的autoredraw属性被设置为false的原故。
