基本信息

---

下载

   友情提示：（无需注册或充值，赞助后即可获取资源下载链接）

---

     嘿，亲！知识可是无价之宝呢，但咱这精心整理的资料也耗费了不少心血呀。小小地破费一下，绝对物超所值哦！如有下载和支付问题，请联系我们QQ(微信同号)：78630559

本次赞助数额为： 2 元　

支付宝支付

微信支付

   源码介绍

---

Imports PicClip
Public Class Form1
    Dim Pic(15) As PictureBox '定义16个图片
    Dim a(15) As Point   '定义16个图片的初始位置
    Dim b(15) As Integer  '定义16个位置的flag信息
    Dim CP As Point
    Dim TimeTotal As Double  '定义总共用时
    Dim ResTotal As Boolean  '定义是否完成图片排列的结果变量
    Dim StepTotal As Double  '定义总共移动的步骤数
    Dim IsPic As Boolean ' 定义是否为图片


    Public Sub SplitPic()
        '下面初始化16个图片的位置、大小、背景等
        For i = 0 To 15
            Pic(i) = New PictureBox
            Pic(i).Parent = Panel1
            Pic(i).Location = New Point(5   (i Mod 4) * (HAH   15), 5   (i \ 4) * (HAW - 10))
            Pic(i).Height = HAH
            Pic(i).Width = HAW
            Pic(i).BackColor = Color.Red
            Pic(i).Tag = i
            Me.Panel1.Controls.Add(Pic(i))
            AddHandler Pic(i).Click, AddressOf Pict_Click '注册事件
        Next
        Panel1.Width = 20   4 * HAW
        Panel1.Height = 20   4 * HAH
    End Sub
    '下面是计算16个位置信息的flag，空白位置的flag=3，可以移动的图片位置flag=1，不能移动的位置flag=0
    Public Sub Calu()
        For i = 0 To 15
            If b(i) = 3 Then
                If i = 0 Then
                    b(1) = 1
                    b(4) = 1
                End If
                If i = 1 Then
                    b(0) = 1
                    b(2) = 1
                    b(5) = 1
                End If
                If i = 2 Then
                    b(1) = 1
                    b(3) = 1
                    b(6) = 1
                End If
                If i = 3 Then
                    b(2) = 1
                    b(7) = 1
                End If
                If i = 4 Then
                    b(0) = 1
                    b(5) = 1
                    b(8) = 1
                End If
                If i = 5 Then
                    b(1) = 1
                    b(4) = 1
                    b(6) = 1
                    b(9) = 1
                End If
                If i = 6 Then
                    b(2) = 1
                    b(5) = 1
                    b(7) = 1
                    b(10) = 1
                End If
                If i = 7 Then
                    b(3) = 1
                    b(6) = 1
                    b(11) = 1
                End If
                If i = 8 Then
                    b(4) = 1
                    b(12) = 1
                    b(9) = 1
                End If
                If i = 9 Then
                    b(5) = 1
                    b(8) = 1
                    b(10) = 1
                    b(13) = 1
                End If
                If i = 10 Then
                    b(6) = 1
                    b(11) = 1
                    b(9) = 1
                    b(14) = 1
                End If
                If i = 11 Then
                    b(7) = 1
                    b(10) = 1
                    b(15) = 1
                End If
                If i = 12 Then
                    b(8) = 1
                    b(13) = 1
                End If
                If i = 13 Then
                    b(9) = 1
                    b(12) = 1
                    b(14) = 1
                End If
                If i = 14 Then
                    b(10) = 1
                    b(13) = 1
                    b(15) = 1
                End If
                If i = 15 Then
                    b(11) = 1
                    b(14) = 1
                End If
                Exit For
            End If
        Next
    End Sub
    Private Sub 打开图片OToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)

    End Sub
    '无用代码 可以删除
    'Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
    '    'Dim a As PictureClip = New PictureClip
    '    'a.Picture = Image.FromFile("c:/0.jpg")
    '    'a.Rows = 4
    '    'a.Cols = 4
    '    'PictureBox1.Image = a.GraphicCell(1)
    '    Dim img As New Bitmap("c:\015.bmp")
    '    Dim rc As Rectangle = New Rectangle(120, 120, 360, 360)
    '    Dim newImg As Bitmap = img.Clone(rc, Imaging.PixelFormat.DontCare)
    '    'PictureBox1.Image = Nothing
    '    PictureBox1.Image = newImg
    '    'Me.CreateGraphics.DrawImage(newImg, 0, 0)
    'End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim mySkin As Sunisoft.IrisSkin.SkinEngine = New Sunisoft.IrisSkin.SkinEngine
        mySkin.SkinFile = Application.StartupPath & "/skin/1.ssk"
        '窗体载入时，设置容器Panel的背景颜色、位置信息，大小信息等
        Panel1.BackColor = Color.Green '设置图片容器背景为白色
        Panel1.Location = New Point(10, 30) '设置图片容器的位置及大小
        Panel1.Width = 400
        Panel1.Height = 400
        '初始化耗时、步骤数，是否已经载入图片等信息
        TimeTotal = 0
        StepTotal = 0
        Button2.Enabled = False
        Button4.Enabled = False
        IsPic = False
    End Sub

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        '先将正确排列后的结果赋值给a(i),以便后续判断是否完成排列
        For i = 0 To 15
            a(i) = Pic(i).Location
            '给每个pic的tag赋值，便于判断不同的图片
            Pic(i).Tag = i
        Next

        '定义一个16个字符
        Dim s As String = "0123456789ABCDEF"
        Dim ts As String
        Dim indexN As Integer = 0
        Dim n As Integer = 0
        '下面循环完成随机图片的生成
        Do While Len(s) > 0

            Randomize()
            '随机取其中的一个字符，转化为数字
            ts = Mid(s, Int(Rnd() * (Len(s)))   1, 1)
            indexN = CInt("&H" & ts)
            '将取出的字符从字符串中去掉
            s = Replace(s, ts, "")
            n = n   1
            '将一个随机的位置信息赋值给图片
            Pic(n - 1).Location = a(indexN)
            '如果是最后一个图片，则将该图片对应的b(i)=3,为空白图片
            If n - 1 = 15 Then
                For i = 0 To 15
                    b(i) = 0
                Next
                b(indexN) = 3
            End If
        Loop
        Pic(15).Visible = False

        '初始化位置标志flag
        Call Calu()
        '计时开始
        Timer1.Start()
        '初始化步骤数和耗时为0
        StepTotal = 0
        TimeTotal = 0
    End Sub
    '调试用代码 可以删除
    'Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
    '    Dim img As New Bitmap("c:\015.bmp")
    '    PictureBox1.Image = img
    '    Dim a(,) As Bitmap
    '    a = ClipImg(img)
    '    PictureBox1.SizeMode = PictureBoxSizeMode.Zoom

    '    PictureBox1.Image = a(0, 0)
    'End Sub

    Private Sub Pict_Click(ByVal sender As Object, ByVal e As EventArgs)
        Dim pla As Point
        If Not TypeOf sender Is PictureBox Then Return '如果sender对象不是按钮则退出过程
        Dim c As PictureBox = DirectCast(sender, PictureBox) '强类型转换   等效方法有：CType、TryCast、DirectCast
        '遍历图片
        For i = 0 To 15
            '如果点击的是图片i
            If Pic(c.Tag).Location = a(i) Then
                '且该图片可以移动
                If b(i) = 1 Then
                    '交换空白图片和要移动的图片
                    StepTotal = StepTotal   1
                    pla = Pic(15).Location
                    Pic(15).Location = Pic(c.Tag).Location
                    Pic(c.Tag).Location = pla
                    'Call ChangeL(Pic(c.Tag).Location, Pic(15).Location)
                    'Debug.Print("交换成功")
                    Exit For
                End If
            End If
        Next
        '初始化位置标志
        For i = 0 To 15
            b(i) = 0
        Next

        For i = 0 To 15
            '重新置空白图片的位置flag=3
            If Pic(15).Location = a(i) Then
                b(i) = 3
                Exit For
            End If
        Next
        '初始化位置标志flag
        Call Calu()

        '判断是否完成排列图片
        ResTotal = True
        For i = 0 To 15
            If Pic(i).Location <> a(i) Then
                ResTotal = False
            End If
        Next
        If ResTotal = True Then
            Timer1.Enabled = False
            MsgBox("完成游戏啦！")
        End If

    End Sub

    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        '计算耗时
        TimeTotal = TimeTotal   1
        '显示耗时
        Label2.Text = TimeTotal
        '显示步骤数
        Label6.Text = StepTotal
    End Sub

    Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
        '打开和关闭参考图的代码
        If Button4.Text = "显示参考图" Then
            Form2.Show()
            Button4.Text = "关闭参考图"
        Else
            Button4.Text = "显示参考图"
            Form2.Close()
        End If
    End Sub

    Private Sub 文件FToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 文件FToolStripMenuItem.Click
        '如果已经载入过图片，则释放掉该pic
        If IsPic = True Then
            For i = 0 To UBound(Pic)
                Me.Controls.Remove(Pic(i))
                Pic(i).Dispose()
            Next
        End If
        '以下是打开图片的动作，使用的是OpenFileDialog控件
        Dim fn As String
        fn = ""
        OpenFileDialog1.Title = "请选择图片"
        OpenFileDialog1.InitialDirectory = Application.StartupPath
        OpenFileDialog1.Filter = "txt files (*.txt)|*.txt|All files (*.*)|*.*|Pictures (*.jpg;*.bmp)|*.jpg;*bmp"
        OpenFileDialog1.FilterIndex = 3
        If OpenFileDialog1.ShowDialog() = DialogResult.OK Then
            'Microsoft.VisualBasic.FileCopy(OpenFileDialog1.FileName, Application.StartupPath & "/Photos/" & TextBox1.Text & ".jpg")
            fn = OpenFileDialog1.FileName
            PicPath = fn
            PictureBox1.Image = Image.FromFile(OpenFileDialog1.FileName)
        End If

        '根据新载入的大图，计算每个小图片的宽度和高度
        Dim img As New Bitmap(fn)
        HAW = img.Width / 4
        HAH = img.Height / 4
        PictureBox1.Image = img
        '分解图片
        Dim a(,) As Bitmap
        a = ClipImg(img)
        PictureBox1.SizeMode = PictureBoxSizeMode.Zoom
        Call SplitPic()
        '分解后的图片对应到每个Pic数组中
        For i = 0 To 15
            Pic(i).Image = a(i Mod 4, i \ 4)
        Next
        Button2.Enabled = True
        Button4.Enabled = True
        IsPic = True
    End Sub

    Private Sub 背景颜色ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)

    End Sub

    Private Sub 背景颜色SToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 背景颜色SToolStripMenuItem.Click
        If ColorDialog1.ShowDialog() = DialogResult.OK Then
            Panel1.BackColor = ColorDialog1.Color
        End If
    End Sub
End Class