DEMO:拼图游戏

最新推荐文章于 2024-09-10 17:09:24 发布

cjqhuadielei

最新推荐文章于 2024-09-10 17:09:24 发布

阅读量601

点赞数

分类专栏： DEMO 文章标签： integer button 游戏 function 图形

本文链接：https://blog.csdn.net/cjqhuadielei/article/details/5764482

版权

DEMO 专栏收录该内容

34 篇文章 0 订阅

订阅专栏

这个例子是一个拼图游戏，整体上设计就是加载图片，选择分割成几行几列的子图片，之后经过鼠标拖拽，将各个自图片拖到正确位置之后，来告诉用户您拼图成功。

设计过程：

Ⅰ、设计要领：

1、菜单栏的建立

2、commondialog 控件、pictureclip控件、picture控件、控件数组的使用

3、鼠标按下、鼠标移动、鼠标抬起事件的操作

4、tag属性的使用

Ⅱ、设计思路：

①窗体建立菜单栏：游戏（载入图片、开始游戏、退出）和选项（2X2、3X3、4X4、自定义）

②用一个和窗体一样大小的picture控件来装要载入的整张图片。通过pictureclip控件来将图片分隔成为用户选择的子图片的个数，并放在一个小的picture控件数组中

③鼠标的按下事件--左键放在所有子图片的最上面，右键放在最下面。并且记录一个坐标

④鼠标移动事件--记录新坐标

⑤通过计算和tag属性来判断是否所有的子图片归位

Ⅲ、设计界面

Ⅳ、功能代码：

①定义一些通用变量

Dim IntWidth As Long   '定义width与ScaleWidth差
Dim IntHeight As Long '定义height与Scaleheight的差

Dim Cols As Long     '定义行数
Dim Rows As Long     '定义列数
Dim CellW As Long    '定义行宽
Dim CellH As Long    '定义列宽

Dim IsStart As Boolean      '定义布尔型变量判断游戏是否开始
Dim IsDrawing As Boolean    '定义布尔型变量判断图片是否正在拖拽

Dim XStart As Long, YStart As Long     '定义鼠标移动图片的位置

②窗体加载

Private Sub Form_Load()
    Randomize
    IsStart = False
    IntWidth = Me.Width - Me.ScaleWidth
    IntHeight = Me.Height - Me.ScaleHeight
    Me.ScaleMode = vbPixels
    PicBG.ScaleMode = vbPixels
    PicCells(0).ScaleMode = vbPixels
    PicCells(0).AutoSize = True
    PicCells(0).Visible = False
    PictureClip1.Cols = 4
    PictureClip1.Rows = 4
    BeginGame.Enabled = False
    StrOption.Enabled = False
    CommonDialog1.DialogTitle = "选择图形文件"
    CommonDialog1.Filter = "所有图形文件(*.*)|*.*|位图(*.bmp;*.dib)|(*.bmp;*.dib)"
End Sub

③菜单栏几个按钮的命令

用户选择子图片列数X行数：

Private Sub CellValue_Click(Index As Integer)
    Dim i As Integer
    For i = 0 To CellValue.count - 1
        If (i <> Index) Then
            CellValue(i).Checked = False
        Else
            PicBG.Visible = False
            CellValue(i).Checked = True
            Call UnloadPicCell
            PictureClip1.Cols = Index + 2
            PictureClip1.Rows = Index + 2
            Call LoadPicCell
            Call ShuffleCells
            PicBG.Visible = True
        End If
    Next i
End Sub

开始游戏：

Private Sub BeginGame_Click()
    Call ShuffleCells
    Call StartGame
End Sub

载入图片：

Private Sub LoadP_Click()
    CommonDialog1.ShowOpen
    If (CommonDialog1.FileName <> "|") Then
        Call UnloadPicCell
        PictureClip1.Picture = LoadPicture(CommonDialog1.FileName)
        PicBG.AutoRedraw = True
        PicBG.AutoSize = True
        PicBG.Picture = PictureClip1.Picture
        Me.ScaleMode = vbTwips
        Me.Width = PicBG.Width + IntWidth
        Me.Height = PicBG.Height + IntHeight
        Me.ScaleMode = vbPixels
        Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
        Call LoadPicCell
        BeginGame.Enabled = True
        StrOption.Enabled = True
    End If
End Sub

④判断子图片归位的过程

Public Function IsAllRight() As Boolean
    Dim count As Integer
    Dim i As Integer
    count = Cols * Rows
    For i = 1 To count
        If (PicCells(i).Tag = "NO") Then
            IsAllRight = False
            Exit Function
        End If
    Next i
    IsAllRight = True
End Function

⑤将图片分成相应的多张子图片

Public Sub ShuffleCells()
    PicBG.Picture = LoadPicture("")
    PicCells(0).ScaleMode = vbPixels
    Dim count As Integer
    count = Cols * Rows
    Dim i As Integer
    Dim kk() As Integer
    ReDim kk(1 To count) As Integer
    For i = 1 To count
        kk(i) = i
    Next i
    Dim pos As Integer
    Dim temp As Integer
    For i = 1 To count - 1
        pos = Int(Rnd * (count + 1 - i) + i)
        temp = kk(i): kk(i) = kk(pos): kk(pos) = temp
        PicCells(kk(i)).ZOrder 0
    Next i
    For i = 1 To count
        PicCells(i).Left = Rnd * (PicBG.ScaleWidth - CellW)
        PicCells(i).Top = Rnd * (PicBG.ScaleHeight - CellH)
    Next i
    For i = 1 To count
        PicCells(i).Visible = True
    Next i
End Sub

⑥加载和卸载子图片过程：

Public Sub UnloadPicCell()
    Dim num As Integer
    If (Cols * Rows < 1) Then
        Exit Sub
    End If
    For num = 1 To Cols * Rows
        Unload PicCells(num)
    Next num
End Sub

Public Sub LoadPicCell()
    Dim num As Integer
    Cols = PictureClip1.Cols
    Rows = PictureClip1.Rows
    CellW = PictureClip1.Width / Cols
    CellH = PictureClip1.Height / Rows
    For num = 1 To Cols * Rows
        Load PicCells(num)
        PicCells(num).Picture = PictureClip1.GraphicCell(num - 1)
        PicCells(num).Tag = "NO"
    Next num

End Sub

⑦鼠标事件

Private Sub PicCells_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If (IsStart = True And IsDrawing = False) Then
        If (Button = 1) Then
            PicCells(Index).ZOrder 0
            IsDrawing = True
            XStart = X
            YStart = Y
        ElseIf (Button = 2) Then
            PicCells(Index).ZOrder 1
        End If
    End If
End Sub

Private Sub PicCells_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim dx As Long
    Dim dy As Long
    Dim NewLeft As Long
    Dim NewTop As Long
    If (IsStart = True And IsDrawing = True) Then
        dx = X - XStart
        dy = Y - YStart
        If (Abs(dx) > 5 And Abs(dy) > 5) Then
            NewLeft = PicCells(Index).Left + dx
            NewTop = PicCells(Index).Top + dy
            If (NewLeft < 0) Then
                NewLeft = 0
            ElseIf (NewLeft > (Cols - 1) * CellW) Then
                NewLeft = (Cols - 1) * CellW
            End If
            If (NewTop < 0) Then
                NewTop = 0
            ElseIf (NewTop > (Rows - 1) * CellH) Then
                NewTop = (Rows - 1) * CellH
            End If
        PicCells(Index).Move NewLeft, NewTop
        End If
    End If
End Sub

Private Sub PicCells_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If (IsStart = True And IsDrawing = True) Then
        IsDrawing = False
        Dim OkLeft As Long
        Dim OkTop As Long
        Dim CurLeft As Long
        Dim CurTop As Long
        OkLeft = ((Index - 1) Mod Cols) * CellW
        OkTop = ((Index - 1) / Rows) * CellH
        CurLeft = PicCells(Index).Left
        CurTop = PicCells(Index).Top
        If (Abs(OkLeft - CurLeft) <= 10="" and="" abs="" -="" curtop="" 10="" then="">            PicCells(Index).Move OkLeft, OkTop
            PicCells(Index).Tag = "YES"
            If (IsAllRight() = True) Then
                MsgBox "OK!恭喜您！"
                IsStart = False
                Exit Sub
            End If
        Else
            PicCells(Index).Tag = "NO"
        End If
    End If
End Sub