如何用VB编程开发纸牌接龙游戏？
Posted 跟我学VB
tags:
篇首语：本文由小常识网(cha138.com)小编为大家整理，主要介绍了如何用VB编程开发纸牌接龙游戏？相关的知识，希望对你有一定的参考价值。
大家好，在Windows系统的电脑上，都可以发现有纸牌这个有趣的休闲小游戏。
电脑自带的纸牌游戏图
纸牌游戏规则
游戏中下方的牌称为为主牌，若上面有比主牌大1或者小1的牌，点击它们可消除。若没有可消除的，可点击主牌可换主牌。
那么，如何用VB编程来开发呢？
分析：
用VB编程开发纸牌游戏，需要用到VB常用控件、控件数组、图形控件、控制结构、数组、过程、文件方面的综合内容。
VB开发纸牌游戏运行图
程序实现代码
Option Explicit
Dim x0 As Long, y0 As Long '拖动过程中保存鼠标的位置
Dim left0 As Long, top0 As Long '被拖动多张牌中最上方牌的位置
Dim inmove As Boolean '如果为True表示处于拖动过程中
Dim cardsmove() As Integer '动态数组，保存移动中的多张牌（0~cardsmovenum-1）
Dim cardsmovenum As Integer '移动牌的张数
Dim movefrom As Integer '保存拖动的源序列号
Dim min As Long, sec As Integer '游戏的分与秒
Private Sub Form_Load()
Dim i As Integer, j As Integer
'空档牌
j = 0
For i = 0 To 4
imgBack(i).Picture = GetPicture(5, 14)
imgBack(i).Top = conVerGap
imgBack(i).Left = conHorGap * (j + 1) + conCardWidth * j
j = j + 1
If i = 0 Then j = j + 2
Next
'生成另外51张牌
For i = 2 To 52
Load imgCards(i)
Next
If Dir(App.Path & "\cards.txt") <> "" Then
If MsgBox("是否恢复上次保存的牌局？", vbYesNo + vbQuestion, "接龙") = vbYes Then
Open App.Path & "\cards.txt" For Input As 1
Input #1, back
For i = 0 To 12
For j = 0 To 30
Input #1, queues(i, j)
If queues(i, j) <> 0 Then Input #1, updown(queues(i, j))
Next
Next
Input #1, min, sec
Close 1
Else
Randomize
back = 1 + Rnd * 12 '背面图案
Call Shuffle '随机洗牌
End If
Else
Randomize
back = 1 + Rnd * 12 '背面图案
Call Shuffle '随机洗牌
End If
Call ShowCards '显示所有牌
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim i As Integer, j As Integer
If MsgBox("是否保存牌局？下次启动后继续。", vbYesNo + vbQuestion, "接龙") = vbYes Then
Open App.Path & "\cards.txt" For Output As 1
Write #1, back
For i = 0 To 12
For j = 0 To 30
Write #1, queues(i, j),
If queues(i, j) <> 0 Then Write #1, updown(queues(i, j)),
Next
Next
Write #1,
Write #1, min, sec '记录游戏的分与秒
Close 1
Else
If Dir(App.Path & "\cards.txt") <> "" Then
Kill App.Path & "\cards.txt"
End If
End If
End Sub
Private Sub mnuExit_Click()
Unload Me
End Sub
Private Sub mnuNew_Click()
sec = 0
min = 0
Call Shuffle ' 洗牌
Call ShowCards '显示所有牌
End Sub
Private Sub ShowCards()
Dim i As Integer, j As Integer, k As Integer
Dim offset As Integer '每个序列中牌的纵向偏移量
For i = 0 To 6 '显示下列7个序列
j = 0
offset = 0
k = queues(i, j)
Do While k <> 0
If updown(k) Then '正面
imgCards(k) = GetPicture((k - 1) \ 13 + 1, (k - 1) Mod 13 + 1)
Else '反面
imgCards(k) = GetPicture(5, back)
End If
imgCards(k).Top = offset + conCardHeight + 2 * conVerGap '纵坐标
imgCards(k).Left = conHorGap * (i + 1) + conCardWidth * i '横坐标
imgCards(k).ZOrder 0
imgCards(k).Visible = True
j = j + 1
If updown(k) Then offset = offset + conVerGap Else offset = offset + conMiniVerGap '反面的和正面的间柜不同
k = queues(i, j)
Loop
Next
For i = 7 To 8 '显示左上角2个序列
j = 0
k = queues(i, j)
Do While k <> 0
If updown(k) Then '正面
imgCards(k) = GetPicture((k - 1) \ 13 + 1, (k - 1) Mod 13 + 1)
Else '反面
imgCards(k) = GetPicture(5, back)
End If
imgCards(k).Top = conVerGap
imgCards(k).Left = conHorGap * (i - 7 + 1) + conCardWidth * (i - 7)
imgCards(k).ZOrder 0
imgCards(k).Visible = True
j = j + 1
k = queues(i, j)
Loop
Next
For i = 9 To 12 '显示右上角的4个序列
j = 0
k = queues(i, j)
Do While k <> 0
If updown(k) Then '正面
imgCards(k).Picture = GetPicture((k - 1) \ 13 + 1, (k - 1) Mod 13 + 1)
Else '反面
imgCards(k).Picture = GetPicture(5, back)
End If
imgCards(k).Top = conVerGap
imgCards(k).Left = conHorGap * (i + 1 - 9 + 3) + conCardWidth * (i - 9 + 3)
imgCards(k).ZOrder 0
imgCards(k).Visible = True
j = j + 1
k = queues(i, j)
Loop
Next
End Sub
Private Sub imgBack_Click(Index As Integer) '如果点击的是序列7最下面的空牌，则将序列8中的牌移至序列7
Dim i As Integer, j As Integer
If Index = 0 Then
j = queuetop(8) '查找第8序列中最顶牌的序号
i = 0
Do While j >= 0
queues(7, i) = queues(8, j)
queues(8, j) = 0
updown(queues(7, i)) = False '反面
imgCards(queues(7, i)).Picture = GetPicture(5, back)
imgCards(queues(7, i)).Left = conHorGap
imgCards(queues(7, i)).ZOrder 0
i = i + 1
j = j - 1
Loop
Exit Sub
End If
End Sub
Private Sub imgCards_DblClick(Index As Integer) '如果双击了序列8最顶层牌,判断该牌是否可以放置在序列9-12之一的顶层
Dim i As Integer, j As Integer, k As Integer
Dim queueclicked As Integer '被双击的序列号
queueclicked = queueno(Index)
If queueclicked = 7 Or queueclicked >= 9 And queueclicked <= 12 Then Exit Sub '这几个序列不接受双击操作
k = queuetop(queueclicked)
If queues(queueclicked, k) <> Index Then Exit Sub '如果双击的牌不是该序列最顶层牌,则不反应
If Not updown(Index) Then Exit Sub '如果双击的背面，则不反应
If Index Mod 13 = 1 Then '判断此牌是否为A
'将A放置在9-12序列中第一个空序列中
For i = 9 To 12
j = queuetop(i) '查找空序列
If j = -1 Then
queues(i, j + 1) = Index
queues(queueclicked, k) = 0
imgCards(Index).Top = conVerGap
imgCards(Index).Left = conHorGap * (i - 9 + 4) + conCardWidth * (i - 9 + 3)
Exit For
End If
Next
Else '如果不是A ,则搜索比其小1,同花色的牌
For i = 9 To 12
j = queuetop(i) '查找非空序列
If j <> -1 Then
If queues(i, j) = Index - 1 Then
queues(i, j + 1) = Index
queues(queueclicked, k) = 0
imgCards(Index).Top = conVerGap
imgCards(Index).Left = conHorGap * (i - 9 + 4) + conCardWidth * (i - 9 + 3)
Exit For
End If
End If
Next
If ifFinish() Then '判断是否完成
MsgBox "祝贺接龙成功！" & Chr(10) & Chr(13) & "用时" & min & "分" & sec & "秒。", vbInformation, "接龙"
End If
End If
End Sub
Private Sub imgCards_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
Dim i As Integer, j As Integer, k As Integer
Dim fTop As Boolean '判断点击的牌是否位于序列顶部
Dim que As Integer, ind As Integer '当前点击牌位于的序列和序号
Dim topind As Integer '本序列中最顶牌的序号
Dim mousepos As POINTAPI '保存鼠标位置
que = queueno(Index) '点击的序列
ind = queueindex(Index) '被点击牌的序号
topind = queuetop(que) '被点击序列的顶张牌的序号
If queues(que, ind + 1) = 0 Then fTop = True Else fTop = False '判断点击的牌是否最顶层
'如果是点击了左上角的第7序列，则其上最顶牌移至第8序列
If que = 7 And fTop Then
For i = 30 To 0 Step -1 '查找第8序列
If queues(8, i) <> 0 Then
Exit For
End If
Next
i = i + 1
queues(8, i) = queues(7, ind) '移动牌
queues(7, ind) = 0
updown(Index) = True '将牌翻起
imgCards(Index).Picture = GetPicture((Index - 1) \ 13 + 1, (Index - 1) Mod 13 + 1)
imgCards(Index).Left = conCardWidth + 2 * conHorGap
imgCards(Index).ZOrder 0
ElseIf que >= 0 And que <= 7 And fTop And updown(Index) = False Then '如果点击的是序列0-7中顶反面牌,则将其反转
Call Turn(Index, True)
ElseIf updown(Index) Then '如果点击的是其他正面牌，则进入拖动状态
left0 = imgCards(Index).Left
top0 = imgCards(Index).Top
Call GetCursorPos(mousepos)
x0 = mousepos.x
y0 = mousepos.y
inmove = True
cardsmovenum = topind - ind + 1 '移动的牌数
movefrom = que '拖动的源序列
ReDim cardsmove(1 To cardsmovenum) '保存每个被拖动的牌号
For i = 1 To cardsmovenum
cardsmove(i) = queues(que, ind + i - 1)
imgCards(cardsmove(i)).ZOrder 0
Next
End If
End Sub
Private Sub imgCards_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
Dim i As Integer
Dim mousepos As POINTAPI
If inmove Then
Call GetCursorPos(mousepos) '得到新的鼠标位置
For i = 1 To cardsmovenum
imgCards(cardsmove(i)).Left = imgCards(cardsmove(i)).Left + mousepos.x - x0
imgCards(cardsmove(i)).Top = imgCards(cardsmove(i)).Top + mousepos.y - y0
Next
x0 = mousepos.x
y0 = mousepos.y
End If
End Sub
Private Sub imgCards_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
Dim moveto As Integer '鼠标释放时所处的序列
Dim i As Integer, j As Integer, k As Integer
Dim delx As Long, dely As Long
Dim newx As Long, newy As Long
Dim fmoveback As Boolean '是否移回原位置
If inmove Then
moveto = getqueueatcursor()
If moveto = -1 Or movefrom = moveto Then '拖动的位置不对(不在序列0-7和9-12上)，返回初始位置
fmoveback = True
ElseIf moveto >= 9 And moveto <= 12 And cardsmovenum > 1 Then '拖多张至9-12序列
fmoveback = True
End If
If Not fmoveback Then
If moveto >= 9 And moveto <= 12 Then '拖至9-12序列
If queuetop(moveto) = -1 And cardsmove(1) Mod 13 <> 1 Then '序列空，但拖来的不是A
fmoveback = True
ElseIf queuetop(moveto) <> -1 Then
If queues(moveto, queuetop(moveto)) + 1 <> cardsmove(1) Then '序列非空，但不连续
fmoveback = True
End If
End If
ElseIf moveto >= 0 And moveto <= 7 Then '拖至0-7序列
If queuetop(moveto) = -1 And cardsmove(1) Mod 13 <> 0 Then '序列空，但拖来的不是K
fmoveback = True
ElseIf queuetop(moveto) <> -1 Then
If Not ((queues(moveto, queuetop(moveto)) - 1) Mod 13 = (cardsmove(1) Mod 13) And _
((queues(moveto, queuetop(moveto)) - 1 - 1) \ 13 + ((cardsmove(1) - 1) \ 13)) Mod 2 = 1) Then '序列非空，但不连续
fmoveback = True
End If
End If
End If
End If
If fmoveback Then '移回开始拖动的序列中
delx = imgCards(cardsmove(1)).Left - left0
dely = imgCards(cardsmove(1)).Top - top0
For i = 1 To cardsmovenum
imgCards(cardsmove(i)).Left = imgCards(cardsmove(i)).Left - delx
imgCards(cardsmove(i)).Top = imgCards(cardsmove(i)).Top - dely
Next
Else '移到目标序列中
k = queuetop(movefrom)
For i = 1 To cardsmovenum '从源序列中删除
queues(movefrom, k - i + 1) = 0
Next
k = queuetop(moveto)
For i = 1 To cardsmovenum '移至目标序列中
queues(moveto, k + i) = cardsmove(i)
Next
If k = -1 Then '目标序列为空时，计算放置位置
If moveto >= 0 And moveto <= 6 Then
newx = conHorGap * (moveto + 1) + conCardWidth * moveto
newy = conVerGap * 2 + conCardHeight
ElseIf moveto >= 9 And moveto <= 12 Then
newx = conHorGap * (moveto + 1 + 3 - 9) + conCardWidth * (moveto + 3 - 9)
newy = conVerGap
End If
Else '目标序列非空时，计算放置位置
newx = imgCards(queues(moveto, k)).Left
If moveto >= 9 And moveto <= 12 Then
newy = imgCards(queues(moveto, k)).Top
Else
newy = imgCards(queues(moveto, k)).Top + conVerGap
End If
End If
For i = 1 To cardsmovenum '放置被拖动的图片
imgCards(cardsmove(i)).Left = newx
imgCards(cardsmove(i)).Top = newy + conVerGap * (i - 1)
imgCards(cardsmove(i)).ZOrder 0
Next
If ifFinish() Then '判断是否完成
MsgBox "祝贺接龙成功！" & Chr(10) & Chr(13) & "用时" & min & "分" & sec & "秒。", vbInformation, "接龙"
End If
End If
inmove = False
End If
End Sub
Private Function getqueueatcursor() As Integer
Dim i As Integer, j As Integer
Dim x As Integer, y As Integer
Dim mousepos As POINTAPI
Call GetCursorPos(mousepos)
x = mousepos.x - Me.Left / Screen.TwipsPerPixelX
y = mousepos.y - Me.Top / Screen.TwipsPerPixelY
If y > 2 * conVerGap + conCardHeight Then '0-6序列
getqueueatcursor = x \ (conHorGap + conCardWidth)
If getqueueatcursor < 0 Then getqueueatcursor = -1
If getqueueatcursor > 6 Then getqueueatcursor = -1
Exit Function
Else
getqueueatcursor = x \ (conHorGap + conCardWidth) + 7
If getqueueatcursor < 7 Then getqueueatcursor = -1
If getqueueatcursor > 13 Then getqueueatcursor = -1
If getqueueatcursor <= 9 Then
getqueueatcursor = -1
Else
If getqueueatcursor >= 10 Then
getqueueatcursor = getqueueatcursor - 1
End If
End If
Exit Function
End If
End Function
Private Sub mnuSelectBack_Click()
Dim oldback As Integer
Dim i As Integer
oldback = back
frmSelectBack.Show 1, Me
If oldback <> back Then
For i = 1 To 52
If Not updown(i) Then
imgCards(i).Picture = GetPicture(5, back)
End If
Next
End If
End Sub
Private Sub Timer1_Timer()
sec = sec + 1
If sec = 60 Then
min = min + 1
sec = 0
End If
Me.Caption = "接龙-" & Format(min, "00") & ":" & Format(sec, "00")
End Sub
为了帮助VB基础薄弱或者VB零基础想快速掌握VB编程的朋友，充分利用好冬季有限的时间，2018年冬季视频直播现已正式开启了，针对VB基础薄弱或者零基础的朋友有专门的基础讲解课程；对已有VB编程基础想综合提高编程开发能力的朋友有综合讲解课程及串口通信与数据库开发课程可供选择学习。
VB视频指导包含的内容
1、所有的VB视频都是亲自讲解，每节视频都会结合实际程序，程序代码均会一句一句详细讲解；
2、学习没有时间限制；
3、老师随时指导；
4、学习即可获得各种编程学习资料和开发工具。
跟我学VB
2018年11月下旬
1、VB从入门到综合视频直播学习优惠中，本课程由数年VB开发经验老师亲自讲解，学习问题随时指导，能够让你短时间内掌握VB课程；
2、VB全套学习资料网盘版，内容包括亲自讲解的视频、课件教程、编程实例大全（含源代码工程文件）、学习总结资料、各种编程开发工具现在优惠发放中；
3、2019年3月全国计算机二级VB考试指导进行中，找对方法、方能在有限的时间内一次顺利通过考试；
4、凡现在报名学习的朋友均送全套网盘学习资料一份！
长按上图，关注跟我学VB公众平台
更多VB精彩内容，尽在VB学习
以上是关于如何用VB编程开发纸牌接龙游戏？的主要内容，如果未能解决你的问题，请参考以下文章