本篇介绍, 如何用Excel制作一个象棋棋盘并可以实现下棋功能
关于这个功能,其实道理也十分简单,无非就是一些图形加几个车马将帅。
通过对棋盘的了解,用直线画出棋盘,然后添加棋子,最后就开始厮*了。
话不多说,先睹为快红方棋局,开局就如上图,车马相士将炮兵,各就各位。
背景有点黑,马上开打。
蓝方棋局,同样也排好队型,不能乱,乱了方寸就败近矣。
车(这个字念ju)马象士帅
为了更直观看到下棋的场景,做了一个动态效果图,仔细看,一定不会失望。
功能介绍设置了三个按钮,一个绘制棋盘,一个绘制棋子,一个清除棋局。
感觉已经可以完成一盘棋的功能了,当然了,为了公平合理,不设置悔棋。
棋盘的样子四平八稳,没有一点特色,几百年来就是这样。
看上去十分冷漠,战争嘛,没有温柔的,流血和失去生命的过程,没有人喜欢。
代码放送主要代码:
ws.Shapes.AddShape(msoShapeOval, x, y, w, h)'画圆形
ws.Shapes.addLine(x,y, xEnd, yEnd)'画线条
绘制棋盘
Sub addLine()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim r As Integer, g As Integer, b As Integer
r = 255
g = 250
b = 250
Dim t As Long, l As Long, w As Long, h As Long
t = 150
l = 100
w = 640
h = 720
Dim lineW As Integer
lineW = 6
Dim ls As Shape
Dim Ri As Integer
Ri = 90
Dim lw As Integer
lw = lineW / 2
Dim i As Integer
For i = 0 To 9'棋盘横线
Set ls = ws.Shapes.addLine(l, t Ri * i, w l Ri - 10, t Ri * i)
With ls
With .Line
.Style = msoLineSingle
.ForeColor.RGB = RGB(r, g, b)
If i = 5 Or i = 4 Then
.Weight = 30
.ForeColor.RGB = RGB(200, 211, 0)
.Style = msoLineSingle
Else
.Weight = 2
End If
End With
End With
Next i
For i = 0 To 8'棋盘竖线
Set ls = ws.Shapes.addLine(l Ri * i, t, l Ri * i, h t Ri)
With ls
With .Line
.Style = msoLineSingle
.ForeColor.RGB = RGB(r, g, b)
.Weight = 2
End With
End With
Next i
End Sub
绘制棋子
Sub addOvalFont(sArr, n, iRow, f)
Dim ws As Worksheet
Set ws = ActiveSheet
Dim o As Shape
Dim x As Long, y As Long, w As Long, h As Long
Dim r As Integer, g As Integer, b As Integer
If f Then
r = 255
g = 25
b = 50
Else
r = 25
g = 50
b = 255
End If
x = 90 * n 60
y = 100 * iRow
w = 90
h = w
Set o = ws.Shapes.AddShape(msoShapeOval, x, y, w, h)
With o
.Fill.ForeColor.RGB = RGB(r, g, b)
With .TextFrame
.VerticalAlignment = xlVAlignCenter
.HorizontalAlignment = xlHAlignCenter
.MarginBottom = 10
.MarginLeft = 10
.MarginTop = 10
.MarginRight = 10
With .Characters
.Text = sArr '棋子文字
With .Font
.Size = 60
.Bold = True
.Name = "隶书"
.Color = RGB(225, 255, 255)
End With
End With
End With
DoEvents
End With
End Sub
棋盘布局
Private Sub CommandButton1_Click()
ClearOvalShape
Dim sArr
sArr = Array("车", "马", "相", "仕", "帅", "相", "仕", "马", "车")
sarr3 = Array("炮")
sarr4 = Array("兵")
sArr2 = Array("车", "马", "象", "士", "将", "象", "士", "马", "车")
sarr5 = Array("卒")
Dim n As Integer
For n = 0 To UBound(sArr)
Call addOvalFont(sArr(n), n, 1, True)
Call addOvalFont(sArr2(n), n, 9, False)
Next n
Call addOvalFont(sarr3(0), 1, 3, True)
Call addOvalFont(sarr3(0), 6, 3, True)
For n = 0 To 8 Step 2
Call addOvalFont(sarr4(0), n, 4, True)
Next n
Call addOvalFont(sarr3(0), 1, 7, False)
Call addOvalFont(sarr3(0), 6, 7, False)
For n = 0 To 8 Step 2
Call addOvalFont(sarr5(0), n, 6, False)
Next n
End Sub
结尾
互动功能是第一次用excel来制作,整体效果很好,唯一比较难的是对图形位置定位,这个要有一定是数学计算能力,和图形大小变化,位移等等理解,做起来需要多次调试。
最后结果也不是十分精确,为了让整个棋盘显得像那么回事儿,做了不少重复无聊的调试。
有兴趣的朋友可以自己试着做一下。
欢迎关注、收藏,免费的