Imports System.IO
Imports System.Text
Public Class Form1
    Private d = New cubepuzzle
    Private solve As Boolean = False
    Private temporyfile(1) As String
    Private Sub partbox_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs)
        If solve Then Exit Sub
        Dim C_left As Boolean  'mouse left clicked
        Dim C_right As Boolean  'mouse right clicked
        If e.Button = Windows.Forms.MouseButtons.Left Then C_left = True
        If e.Button = Windows.Forms.MouseButtons.Right Then C_right = True
        d.shaderect(e.Y, e.X, C_left, C_right) 'input to bitmap and puzzle array
    End Sub
    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        Dim partbox As New PictureBox
        partbox = d.picbox(False)
        Me.Controls.Add(partbox)
        d.enter_part()
        partbox.Image = d.partentrymap.clone
        d.npartnumber = d.npartnumber + 1
        d.partentrymap() 'update map
    End Sub
    Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
        Try  'delete tempory files if they wre used
            File.Delete(temporyfile(0))
            File.Delete(temporyfile(1))
        Catch ex As Exception
        End Try
    End Sub
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        d.fast = True
        d.wide = Me.Width
        d.high = Me.Height
        Dim partbox As New PictureBox
        partbox = d.picbox(True)
        Me.Controls.Add(partbox)
        AddHandler partbox.MouseMove, AddressOf partbox_MouseMove
        partbox.Image = d.partentrymap
    End Sub
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Button2.Enabled = False
        Button1.Enabled = False
        solve = True
        d.solve_puzzle()
    End Sub
    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        SyncLock d.part  'ensure not using same time as solution worker thread
            Me.Refresh()
        End SyncLock
    End Sub
    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
        temporyfile(0) = Path.GetTempFileName & "ipz.mht"
        My.Computer.FileSystem.WriteAllBytes(temporyfile(0), My.Resources.Impuzzables, False)
        Try
            Process.Start(temporyfile(0))
        Catch ex As Exception
            MessageBox.Show("Cant display this document")
        End Try
    End Sub
    Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
        temporyfile(1) = Path.GetTempFileName & "ipz.mht"
        My.Computer.FileSystem.WriteAllBytes(temporyfile(1), My.Resources.information, False)
        Try
            Process.Start(temporyfile(1))
        Catch ex As Exception
            MessageBox.Show("Cant display this document")
        End Try
    End Sub
    Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click
        Form2.Show()
    End Sub
    Private Sub RadioButton1_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RadioButton1.CheckedChanged
        If RadioButton1.Checked = True Then d.fast = False Else d.fast = True
    End Sub
    Private Sub LinkLabel1_LinkClicked(ByVal sender As System.Object, ByVal e As System.Windows.Forms.LinkLabelLinkClickedEventArgs) Handles LinkLabel1.LinkClicked
        e.Link.Visited = True
        Dim url As String = "http://www.geocities.com/c.morey47/"
        Try
            Process.Start(url)
        Catch ex As Exception
            MessageBox.Show("Cant connect to this site")
        End Try
    End Sub
End Class
Public Class cubepuzzle
    Public part As New Bitmap(1301, 501, Drawing.Imaging.PixelFormat.Format24bppRgb)
    Private puzzlearray(6, 120, 2, 2, 2) As Boolean
    'part number , part position, bottom layer , Y axis , X axis 
#Region "enter and display"
    Private g As Graphics
    Private I_wide As Integer 'form width
    Private I_high As Integer 'form height
    Private p As Integer = 0  'the part number
    Private np As Integer = 0  'the part position number
    Private colors() As String = {"red", "green", "blue", "cyan", "yellow", _
        "magenta", "lime", "brown", "pink", "silver", "violet", "plum", _
        "salmon", "crimson", "darkblue", "black", "white"}
    Private display_fast As Boolean
    Public Property npartnumber() As Integer
        Get
            npartnumber = p
        End Get
        Set(ByVal value As Integer)
            p = value
            If p = 7 Then
                Form1.Button2.Enabled = False
                MessageBox.Show("This is last part you can input")
                p = 6
            End If
        End Set
    End Property
    Public WriteOnly Property wide() As Integer
        Set(ByVal value As Integer)
            I_wide = value / 1.1 'set display object width
        End Set
    End Property
    Public WriteOnly Property fast() As Boolean
        Set(ByVal value As Boolean)
            display_fast = value
        End Set
    End Property
    Public WriteOnly Property high() As Integer
        Set(ByVal value As Integer)
            I_high = value / 2  'set display object height
        End Set
    End Property
    Public Function picbox(ByVal first As Boolean) As PictureBox
        Dim partbox As New PictureBox
        If first Then
            partbox.Width = I_wide
            partbox.Height = I_high
            partbox.Location = New Point(I_wide / 26, 50)
        Else
            partbox.Width = I_wide / 2.1
            partbox.Height = I_high / 2.1
            Dim xnew = 0, ynew = 0
            If p Mod 2 > 0 Then
                xnew = I_wide / 13 + I_wide / 2.1  'odd left side
                ynew = I_high + 100 + (p - 1) / 2 * (50 + I_high / 2.1)
            Else
                xnew = I_wide / 26              'even right side
                ynew = I_high + 100 + p / 2 * (50 + I_high / 2.1)
            End If
            partbox.Location = New Point(xnew, ynew)
        End If
        partbox.BorderStyle = (System.Windows.Forms.BorderStyle.FixedSingle)
        partbox.SizeMode = PictureBoxSizeMode.StretchImage
        picbox = partbox
    End Function
    Public Function partentrymap() As Bitmap
        g = Graphics.FromImage(part) 'bitmap in memory
        Dim drawpen = New Pen(Color.FromName(colors(p)), 5)
        For j = 0 To 2 'draw three lots
            For i = 1 To 4  'draw 4 lines
                g.DrawLine(drawpen, 400 * j + 100, 100 * i, 400 * j + 400, 100 * i)
            Next i
        Next j                            'HORIZONTAL LINES
        For j = 0 To 2 'draw three lots
            For i = 1 To 4  'draw 4 lines
                g.DrawLine(drawpen, i * 100 + (j * 400), 100, i * 100 + (j * 400), 400)
            Next i
        Next j                             'VERTICAL LINES
        Dim layerinfo = New System.Drawing.Font("arial", 30)
        g.DrawString("bottom layer", layerinfo, Brushes.Purple, 140, 50)
        g.DrawString("bottom layer", layerinfo, Brushes.Purple, 140, 410)
        g.DrawString("top layer", layerinfo, Brushes.Purple, 960, 50)
        g.DrawString("top layer", layerinfo, Brushes.Purple, 960, 410)
        g.FillRectangle(Brushes.Black, 510, 20, 320, 40) 'black out old number
        g.DrawString("part number " & p + 1, layerinfo, Brushes.White, 515, 20)
        g = Nothing
        Return part
    End Function
    Public Sub shaderect(ByVal y As Integer, ByVal x As Integer, ByVal left As Boolean, ByVal right As Boolean)
        x = x * 1302 / I_wide 'image shrink onto form picturebox
        y = y * 502 / I_high
        g = Graphics.FromImage(part) 'bitmap in memory
        Dim br As New SolidBrush(Color.FromName(colors(p)))
        For k = 0 To 2 '0=bottom 1= mid 2= top
            For j = 0 To 2 'the y dimension
                For i = 0 To 2 'the x dimension
                    Dim ax = 150 + i * 100 + k * 400
                    Dim ay = 150 + j * 100
                    If Not puzzlearray(p, np, k, j, i) Then  'black out if not
                        g.FillRectangle(Brushes.Black, ax - 47, ay - 47, 95, 95)
                    End If
                    If x < ax + 50 And x > ax - 50 And y < ay + 50 And y > ay - 50 Then
                        If left Then 'add square
                            puzzlearray(p, np, k, j, i) = True 'we are in 
                        End If
                        If right Then  'remove square
                            puzzlearray(p, np, k, j, i) = False 'we are in 
                        End If
                        If puzzlearray(p, np, k, j, i) Then 'this square added
                            g.FillRectangle(br, ax - 47, ay - 47, 95, 95)
                        Else 'this is a blank square show can select
                            g.FillRectangle(Brushes.DarkOrange, ax - 47, ay - 47, 95, 95)
                        End If
                    End If
                Next i
            Next j
        Next k
        Form1.Refresh() 'show rectangles
        g = Nothing
    End Sub
    Private Sub clear()
        g = Graphics.FromImage(part) 'bitmap in memory
        For k = 0 To 2 '0=bottom 1= mid 2= top
            For j = 0 To 2 'the y dimension
                For i = 0 To 2 'the x dimension
                    Dim ax = 103 + i * 100 + k * 400
                    Dim ay = 103 + j * 100
                    g.FillRectangle(Brushes.Black, ax, ay, 95, 95)
                Next i
            Next j
        Next k
        g = Nothing
    End Sub
    Public Sub display(ByVal psub As Integer, ByVal npsub As Integer)
        clear()
        Dim br As New SolidBrush(Color.FromName(colors(psub)))
        Dim layerinfo = New System.Drawing.Font("arial", 30)
        g = Graphics.FromImage(part) 'bitmap in memory
        For k = 0 To 2 '0=bottom 1= mid 2= top
            For j = 0 To 2 'the y dimension
                For i = 0 To 2 'the x dimension
                    Dim ax = 103 + i * 100 + k * 400
                    Dim ay = 103 + j * 100
                    If puzzlearray(psub, npsub, k, j, i) Then
                        g.FillRectangle(br, ax, ay, 95, 95)
                    End If
                Next i
            Next j
        Next k
        g.FillRectangle(Brushes.Black, 490, 430, 370, 40) 'black out old number
        g.DrawString("position number " & npsub + 1, layerinfo, Brushes.White, 495, 430)
        Form1.Refresh() 'show rectangles
        g = Nothing
    End Sub
    Public Sub display_solution(ByVal psub As Integer, ByVal npsub As Integer, ByVal tf As TimeSpan)
        SyncLock part  'ensure not using same time as form 1
            partentrymap()
            Dim br As New SolidBrush(Color.FromName(colors(psub)))
            Dim layerinfo = New System.Drawing.Font("arial", 30)
            g = Graphics.FromImage(part) 'bitmap in memory
            g.FillRectangle(Brushes.Black, 490, 20, 370, 45) 'black out old 
            For k = 0 To 2 '0=bottom 1= mid 2= top
                For j = 0 To 2 'the y dimension
                    For i = 0 To 2 'the x dimension
                        Dim ax = 103 + i * 100 + k * 400
                        Dim ay = 103 + j * 100
                        If puzzlearray(psub, npsub, k, j, i) Then
                            g.FillRectangle(br, ax, ay, 95, 95)
                        End If
                    Next i
                Next j
            Next k
            g.FillRectangle(Brushes.Black, 490, 430, 370, 45) 'black out old number
            g.DrawString("Found this solution", layerinfo, Brushes.White, 495, 20)
            g.DrawString("Time taken  " & tf.ToString, layerinfo, Brushes.White, 310, 455)
            g = Nothing
        End SyncLock
    End Sub
    Public Sub display_working(ByVal k As Integer, ByVal j As Integer)
        SyncLock part  'ensure not using same time as form 1
            Dim layerinfo = New System.Drawing.Font("arial", 140)
            clear_all()
            g = Graphics.FromImage(part) 'bitmap in memory
            g.DrawString("working", layerinfo, Brushes.White, 300, 20)
            g.DrawString(k & "  " & j, layerinfo, Brushes.White, 300, 220)
            g = Nothing
        End SyncLock
    End Sub
    Private Sub clear_all()
        SyncLock part  'ensure not using same time as form 1
            g = Graphics.FromImage(part) 'bitmap in memory
            g.FillRectangle(Brushes.Black, 0, 0, 1301, 501) 'black screen
            g = Nothing
        End SyncLock
    End Sub
#End Region
#Region "move part"
    Private Function clear_top(ByVal npi As Integer) As Boolean
        For y = 0 To 2
            For x = 0 To 2 'any square in front side means this is false
                If puzzlearray(p, npi, 2, y, x) Then
                    clear_top = False 'there is a square here
                    Exit Function 'dont need to go any further
                End If
            Next
        Next
        clear_top = True 'checked all so must be clear
    End Function
    Private Sub move_top(ByVal npi As Integer) 'from npi to new np
        For y = 0 To 2 ' the layer
            For x = 0 To 2
                For z = 2 To 1 Step -1 'move two rows to right
                    puzzlearray(p, np, z, y, x) = puzzlearray(p, npi, z - 1, y, x)
                Next z
                puzzlearray(p, np, 0, y, x) = False 'clear row 
            Next x
        Next y
    End Sub
    Private Function clear_bot(ByVal npi As Integer) As Boolean
        For y = 0 To 2
            For x = 0 To 2 'any square in front side means this is false
                If puzzlearray(p, npi, 0, y, x) Then
                    clear_bot = False 'there is a square here
                    Exit Function 'dont need to go any further
                End If
            Next
        Next
        clear_bot = True 'checked all so must be clear
    End Function
    Private Sub move_bot(ByVal npi As Integer) 'from npi to new np
        For y = 0 To 2 ' the layer
            For x = 0 To 2
                For z = 0 To 1 'move two rows to right
                    puzzlearray(p, np, z, y, x) = puzzlearray(p, npi, z + 1, y, x)
                Next z
                puzzlearray(p, np, 2, y, x) = False 'clear row 
            Next x
        Next y
    End Sub
    Private Function clear_front(ByVal npi As Integer) As Boolean
        For z = 0 To 2
            For x = 0 To 2 'any square in front side means this is false
                If puzzlearray(p, npi, z, 2, x) Then
                    clear_front = False 'there is a square here
                    Exit Function 'dont need to go any further
                End If
            Next
        Next
        clear_front = True 'checked all so must be clear
    End Function
    Private Sub move_front(ByVal npi As Integer) 'from npi to new np
        For z = 0 To 2 ' the layer
            For x = 0 To 2
                For y = 2 To 1 Step -1 'move two rows to right
                    puzzlearray(p, np, z, y, x) = puzzlearray(p, npi, z, y - 1, x)
                Next y
                puzzlearray(p, np, z, 0, x) = False 'clear row 
            Next x
        Next z
    End Sub
    Private Function clear_back(ByVal npi As Integer) As Boolean
        For z = 0 To 2
            For x = 0 To 2 'any square in front side means this is false
                If puzzlearray(p, npi, z, 0, x) Then
                    clear_back = False 'there is a square here
                    Exit Function 'dont need to go any further
                End If
            Next
        Next
        clear_back = True 'checked all so must be clear
    End Function
    Private Sub move_back(ByVal npi As Integer) 'from npi to new np
        For z = 0 To 2 ' the layer
            For x = 0 To 2
                For y = 0 To 1  'move two rows to right
                    puzzlearray(p, np, z, y, x) = puzzlearray(p, npi, z, y + 1, x)
                Next y
                puzzlearray(p, np, z, 2, x) = False 'clear row 
            Next x
        Next z
    End Sub
    Private Function clear_right(ByVal npi As Integer) As Boolean
        For z = 0 To 2
            For y = 0 To 2 'any square in right side means this is false
                If puzzlearray(p, npi, z, y, 2) Then
                    clear_right = False 'there is a square here
                    Exit Function 'dont need to go any further
                End If
            Next
        Next
        clear_right = True 'checked all so must be clear
    End Function
    Private Sub move_right(ByVal npi As Integer) 'from npi to new np
        For z = 0 To 2 ' the layer
            For y = 0 To 2
                For x = 2 To 1 Step -1 'move two rows to right
                    puzzlearray(p, np, z, y, x) = puzzlearray(p, npi, z, y, x - 1)
                Next x
                puzzlearray(p, np, z, y, 0) = False 'clear row 
            Next y
        Next z
    End Sub
    Private Function clear_left(ByVal npi As Integer) As Boolean
        For z = 0 To 2
            For y = 0 To 2 'any square in right side means this is false
                If puzzlearray(p, npi, z, y, 0) Then
                    clear_left = False 'there is a square here
                    Exit Function 'dont need to go any further
                End If
            Next
        Next
        clear_left = True 'checked all so must be clear
    End Function
    Private Sub move_left(ByVal npi As Integer) 'from npi to new np
        For z = 0 To 2 ' the layer
            For y = 0 To 2
                For x = 0 To 1  'move two rows to right
                    puzzlearray(p, np, z, y, x) = puzzlearray(p, npi, z, y, x + 1)
                Next x
                puzzlearray(p, np, z, y, 2) = False 'clear row 
            Next y
        Next z
    End Sub
#End Region
#Region "part in every position"
    Private Sub mrs(ByVal npmrs As Integer)
        If clear_right(npmrs) Then
            np = np + 1  'new position one to right
            move_right(npmrs) 'into next position
            If clear_right(npmrs + 1) Then
                np = np + 1  'new position one to right
                move_right(npmrs + 1) 'into next position
            End If
        End If
    End Sub
    Private Sub move()
        Dim npi = np  'the start position number
        Dim newnp(8) As Integer
        mrs(npi) ' the very first location bottom top left
        If clear_front(npi) Then 'CheckBox start position
            np = np + 1  'new position one to front
            move_front(npi) 'into next position
            newnp(0) = np
            mrs(np)
            If clear_front(newnp(0)) Then 'CheckBox new start position
                np = np + 1  'new position one to front
                move_front(newnp(0)) 'into next position
                newnp(1) = np 'the new position of the square
                mrs(np)
            End If
        End If
        If clear_top(npi) Then 'at the start top left hand side
            np = np + 1  'new position one to top
            move_top(npi) 'into next position
            newnp(2) = np
            mrs(np)
            If clear_front(newnp(2)) Then
                np = np + 1  'new position one to front
                move_front(newnp(2)) 'into next position
                newnp(3) = np
                mrs(np)
                If clear_front(newnp(3)) Then
                    np = np + 1  'new position one to front
                    move_front(newnp(3)) 'into next position
                    newnp(4) = np
                    mrs(np)
                End If
            End If
            If clear_top(newnp(2)) Then 'at the start top left hand side
                np = np + 1  'new position one to top
                move_top(newnp(2)) 'into next position
                newnp(5) = np
                mrs(np)
                If clear_front(newnp(5)) Then
                    np = np + 1  'new position one to front
                    move_front(newnp(5)) 'into next position
                    newnp(6) = np
                    mrs(np)
                    If clear_front(newnp(6)) Then
                        np = np + 1  'new position one to front
                        move_front(newnp(6)) 'into next position
                        mrs(np)
                    End If
                End If
            End If
        End If
    End Sub
#End Region
#Region "rotate part"
    Private puzznp(15) As Integer  'the np number of positions for each part
    Public Sub every()
        home()
        move()
        For i = 0 To 2 'check at 90 180 and 270 rotation
            Dim npi As Integer
            If i = 0 Then npi = 0 Else npi = np 'first must be origonal part
            rotate_right(npi)
            If same() Then
                clearnp() 'dont need it now
                np = np - 1 'back to un rotated
            Else : move()
            End If
        Next i
        For i = 0 To 2 'check at 90 180 and 270 rotation
            Dim npi As Integer
            If i = 0 Then npi = 0 Else npi = np 'first must be origonal part
            rotate_top(npi)
            If same() Then
                clearnp() 'dont need it now
                np = np - 1 'back to un rotated
            Else : move()
            End If
        Next i
        For i = 0 To 2 'check at 90 180 and 270 rotation
            Dim npi As Integer
            If i = 0 Then npi = 0 Else npi = np 'first must be origonal part
            rotate_front(npi)
            If same() Then
                clearnp() 'dont need it now
                np = np - 1 'back to un rotated
            Else : move()
            End If
        Next i
        puzznp(p) = np 'the number of positions for this puzzle
    End Sub
    Private Function same() As Boolean 'if current np same as very first
        For z = 0 To 2
            For y = 0 To 2
                For x = 0 To 2
                    If puzzlearray(p, np, z, y, x) <> puzzlearray(p, 0, z, y, x) Then
                        same = False
                        Exit Function 'if one different then not equal
                    End If
                Next
            Next
        Next
        same = True  'been through all and all same
    End Function
    Private Sub rotate_right(ByVal npi As Integer)
        For z = 0 To 2 'looking from front
            For y = 0 To 2
                For x = 0 To 2
                    puzzlearray(p, np + 1, 2 - x, y, z) = puzzlearray(p, npi, z, y, x)
                Next x
            Next y
        Next z
        np = np + 1
        home()
    End Sub
    Public Sub rotate_top(ByVal npi As Integer)
        For z = 0 To 2 'looking from front
            For y = 0 To 2
                For x = 0 To 2
                    puzzlearray(p, np + 1, z, 2 - x, y) = puzzlearray(p, npi, z, y, x)
                Next x
            Next y
        Next z
        np = np + 1
        home()
    End Sub
    Private Sub rotate_front(ByVal npi As Integer)
        For z = 0 To 2 'looking from front
            For y = 0 To 2
                For x = 0 To 2
                    puzzlearray(p, np + 1, y, z, 2 - x) = puzzlearray(p, npi, z, y, x)
                Next x
            Next y
        Next z
        np = np + 1  'the above also rotates right twice
        rotate_right(np)  'copy then clear and decrease np
        rotate_right(np) 'to make it exact and np is now 2 along
        home()
        For z = 0 To 2 'looking from front
            For y = 0 To 2
                For x = 0 To 2
                    puzzlearray(p, np - 2, z, y, x) = puzzlearray(p, np, z, y, x)
                Next x
            Next y
        Next z
        clearnp()
        np = np - 1
        clearnp()
        np = np - 1 'now have rotated part
    End Sub
    Private Sub home()
        Dim npi = np 'remember start value
        If clear_left(np) Then
            np = np + 1
            move_left(np - 1)
            If clear_left(np) Then
                np = np + 1
                move_left(np - 1)
            End If
        End If
        If clear_bot(np) Then
            np = np + 1
            move_bot(np - 1)
            If clear_bot(np) Then
                np = np + 1
                move_bot(np - 1)
            End If
        End If
        If clear_back(np) Then
            np = np + 1
            move_back(np - 1)
            If clear_back(np) Then
                np = np + 1
                move_back(np - 1)
            End If
        End If
        For z = 0 To 2       'copy the last(if any or none) move
            For y = 0 To 2
                For x = 0 To 2
                    puzzlearray(p, npi, z, y, x) = puzzlearray(p, np, z, y, x)
                Next
            Next
        Next
        Do Until np = npi 'untill at start position
            clearnp() 'clear all working parts
            np = np - 1
        Loop
    End Sub
    Private Sub clearnp()
        For z = 0 To 2  'clear part at np
            For y = 0 To 2
                For x = 0 To 2
                    puzzlearray(p, np, z, y, x) = False
                Next
            Next
        Next
    End Sub
#End Region
#Region "enter part"
    Public Sub enter_part()
        every()
        Dim tnum As Integer = 0
        Do Until tnum = np + 1
            display(p, tnum)
            If Not display_fast Then System.Threading.Thread.Sleep(1000)
            tnum = tnum + 1
        Loop
        np = 0   'start np again
    End Sub
#End Region
#Region "solution"
    Dim ans(15) As Integer
    Public Sub solve_puzzle()
        clear_all()
        Dim sp As New System.Threading.Thread(AddressOf solve)
        sp.IsBackground = True
        sp.Start()
    End Sub
    Public Sub solve()
        System.Threading.Thread.CurrentThread.Priority = Threading.ThreadPriority.Lowest
        Dim ts = Date.Now
        For i0 = 0 To puzznp(0) 'check each position with every other
            For i1 = 0 To puzznp(1)  'number of first part positions
                display_working(puzznp(0) - i0, puzznp(1) - i1) 'display progress
                For i2 = 0 To puzznp(2)
                    For i3 = 0 To puzznp(3)
                        For i4 = 0 To puzznp(4)
                            For i5 = 0 To puzznp(5)
                                For i6 = 0 To puzznp(6)
                                    ans(0) = i0  'the np of the first part
                                    ans(1) = i1  'np of next
                                    ans(2) = i2
                                    ans(3) = i3
                                    ans(4) = i4
                                    ans(5) = i5
                                    ans(6) = i6
                                    If Not clash() Then  'display solution
                                        clear_all()
                                        Dim tf = DateTime.Now.Subtract(ts)
                                        For i = 0 To 6
                                            display_solution(i, ans(i), tf) 'the position of each part
                                        Next
                                        Exit Sub  'found a solution
                                    End If
                                Next i6
                            Next i5
                        Next i4
                    Next i3
                Next i2
            Next i1
        Next i0
        MessageBox.Show("we dont have a solution for these parts")
    End Sub
    Private Function clash() As Boolean
        For z = 0 To 2
            For y = 0 To 2
                For x = 0 To 2
                    For j = 0 To 6
                        For i = j + 1 To 6
                            If puzzlearray(j, ans(j), z, y, x) And puzzlearray(i, ans(i), z, y, x) Then
                                clash = True
                                Exit Function 'there is a clash of parts
                            End If
                        Next
                    Next

                Next
            Next
        Next
        clash = False  'been through all so must be no clashes
    End Function
#End Region
End Class