搜公众号
推荐 原创 视频 Java开发 开发工具 Python开发 Kotlin开发 Ruby开发 .NET开发 服务器运维 开放平台 架构师 大数据 云计算 人工智能 开发语言 其它开发 iOS开发 前端开发 JavaScript开发 Android开发 PHP开发 数据库
Lambda在线 > 跟我学VB > 如何用VB编程开发纸牌接龙游戏?

如何用VB编程开发纸牌接龙游戏?

跟我学VB 2018-12-11
举报
往期精彩内容


大家好,在Windows系统的电脑上,都可以发现有纸牌这个有趣的休闲小游戏。


如何用VB编程开发纸牌接龙游戏?

电脑自带的纸牌游戏图


纸牌游戏规则


游戏中下方的牌称为为主牌,若上面有比主牌大1或者小1的牌,点击它们可消除。若没有可消除的,可点击主牌可换主牌。


那么,如何用VB编程来开发呢?

分析:

用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如何用VB编程开发纸牌接龙游戏?

        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

如何用VB编程开发纸牌接龙游戏?

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                      '如果双击的背面,则不反应

    

如何用VB编程开发纸牌接龙游戏?

    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  '判断点击的牌是否最顶层

    

    

如何用VB编程开发纸牌接龙游戏?

    '如果是点击了左上角的第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

        

如何用VB编程开发纸牌接龙游戏?

            

        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

        

如何用VB编程开发纸牌接龙游戏?

        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零基础想快速掌握VB编程的朋友,充分利用好冬季有限的时间,2018年冬季视频直播现已正式开启了,针对VB基础薄弱或者零基础的朋友有专门的基础讲解课程;对已有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编程开发纸牌接龙游戏?》的版权归原作者「跟我学VB」所有,文章言论观点不代表Lambda在线的观点, Lambda在线不承担任何法律责任。如需删除可联系QQ:516101458

文章来源: 阅读原文

相关阅读

举报