VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsPuzzle"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Type BlankPosition
    X   As Integer
    Y   As Integer
End Type

Private canvass             As PictureBox
Private buffer              As PictureBox
Private buffer2             As PictureBox
Private selector            As PictureBox
Private moulding            As PictureBox
Private blank               As PictureBox
Private colSize             As Integer
Private rowSize             As Integer
Private cellCount           As Integer
Private click(1)            As Integer
Private cell()              As clsCell
Private pictureSelection    As PictureConstants
Private blankPos            As BlankPosition
Public onPlay               As Boolean
Private showHint            As Boolean

Private Sub Class_Initialize()
    colSize = INITIAL_COLSIZE
    rowSize = INITIAL_ROWSIZE
    cellCount = colSize * rowSize
    pictureSelection = WOODY
    onPlay = False
    showHint = False
End Sub

Public Sub initialize(ByRef this As Form, ByRef newCanvass As PictureBox, ByRef newBuffer As PictureBox, newBuffer2 As PictureBox, ByRef newSelector As PictureBox, ByVal newMoulding As PictureBox, ByRef newBlank As PictureBox)
    
    Set canvass = newCanvass
    Set buffer = newBuffer
    Set selector = newSelector
    Set buffer2 = newBuffer2
    Set moulding = newMoulding
    Set blank = newBlank
    
    loadImages
    positionCanvass
    initializeCells
    drawMouldings this
    setImages
    
End Sub

Private Sub positionCanvass()
    canvass.left = IMAGE_LEFT
    canvass.top = IMAGE_TOP
End Sub

Public Property Let setColSize(ByVal newColSize As Integer)
    colSize = newColSize
    cellCount = colSize * rowSize
End Property

Public Property Get getColSize() As Integer
    getColSize = colSize
End Property

Public Property Let setRowSize(ByVal newRowSize As Integer)
    rowSize = newRowSize
    cellCount = colSize * rowSize
End Property

Public Property Get getRowSize() As Integer
    getRowSize = rowSize
End Property

Public Property Let setPictureSelection(ByVal newPictureSelection As PictureConstants)
    pictureSelection = newPictureSelection
End Property

Public Property Get getPictureSelection() As PictureConstants
    getPictureSelection = pictureSelection
End Property

Public Property Let setHint(ByVal newHint As Boolean)
    
    If Not (showHint = newHint) Then
        showHint = newHint
        redrawCanvass
    End If
    
End Property

Public Property Get getHint() As Boolean
    getHint = showHint
End Property

Private Sub initializeCells()

    Dim row         As Integer
    Dim col         As Integer
    Dim cellCtr     As Integer
    Dim cellWidth   As Integer
    Dim cellHeight  As Integer
    Dim boardW      As Integer
    Dim boardH      As Integer
    
    ReDim cell(cellCount - 1) As clsCell

    cellWidth = IMAGE_WIDTH \ colSize
    cellHeight = IMAGE_HEIGHT \ rowSize
    
    boardW = (cellWidth * colSize) + (colSize + 1)
    boardH = (cellHeight * rowSize) + (rowSize + 1)

    resizeCanvass boardW, boardH
    resizeBuffer boardW, boardH
    resizeSelector boardW, boardH
    resizeBufferImage cellWidth, cellHeight

    For row = 1 To rowSize
        For col = 1 To colSize
            Set cell(cellCtr) = New clsCell
            cell(cellCtr).setWidth = cellWidth
            cell(cellCtr).setHeight = cellHeight
            cell(cellCtr).setLeft = (col - 1) * cellWidth + col
            cell(cellCtr).setTop = (row - 1) * cellHeight + row
            cell(cellCtr).setX = col
            cell(cellCtr).setY = row
            cell(cellCtr).setImageIndex = cellCtr
            cell(cellCtr).setIndex = cellCtr
            cellCtr = cellCtr + 1
        Next
    Next

    blankPos.X = cell(cellCount - 1).getX
    blankPos.Y = cell(cellCount - 1).getY
    drawBufferWithHint

End Sub

Private Sub resizeBuffer(ByVal newWidth As Integer, ByVal newHeight As Integer)
    buffer.width = newWidth
    buffer.height = newHeight
End Sub

Private Sub resizeCanvass(ByVal newWidth As Integer, ByVal newHeight As Integer)
    canvass.width = newWidth
    canvass.height = newHeight
End Sub

Public Sub slide(ByVal newIndex As Integer)

    If Not ((blankPos.X = cell(newIndex).getX) Or (blankPos.Y = cell(newIndex).getY)) Then Exit Sub
    
    Dim m       As MovementConstants
    Dim cX      As Integer
    Dim cY      As Integer
    Dim cCount  As Integer
    
    cX = cell(newIndex).getX
    cY = cell(newIndex).getY
    
    If blankPos.Y = cY Then
        If blankPos.X < cX Then
            m = RIGHTWARD
            cCount = cX - blankPos.X
        ElseIf blankPos.X > cX Then
            m = LEFTWARD
            cCount = blankPos.X - cX
        Else
            m = NONE
        End If
    End If
    
    If blankPos.X = cX Then
        If blankPos.Y < cY Then
            m = DOWNWARD
            cCount = cY - blankPos.Y
        ElseIf blankPos.Y > cY Then
            m = UPWARD
            cCount = blankPos.Y - cY
        Else
            m = NONE
        End If
    End If

    If m <> NONE Then moveCells cX, cY, m, cCount

End Sub

Private Sub shuffleImageIndexes()

    Const MOVE_COUNT    As Integer = 200
    
    Dim orientation(1)  As OrientationConstants
    Dim movement(1)     As MovementConstants
    Dim o               As OrientationConstants
    Dim m               As MovementConstants
    Dim cCount          As Integer
    Dim newX            As Integer
    Dim newY            As Integer
    Dim moveCtr         As Integer
    Dim moveCount       As Integer
    
    moveCount = (colSize * rowSize) * 4
    
    Do
        Do
        
            Randomize (Format(Time, "ss"))
            
            newX = blankPos.X
            newY = blankPos.Y
        
            o = CInt(Rnd * 1)
            
            If o = VERTICAL Then
                
                movement(0) = LEFTWARD
                movement(1) = RIGHTWARD
                m = movement(CInt(Rnd * 1))
                
                If m = LEFTWARD Then
                    cCount = CInt(Rnd * (blankPos.X - 2)) + 1
                    newX = blankPos.X - cCount
                Else
                    cCount = CInt(Rnd * ((colSize - blankPos.X))) + 1
                    newX = blankPos.X + cCount
                End If
                
            Else
                
                movement(0) = UPWARD
                movement(1) = DOWNWARD
                m = movement(CInt(Rnd * 1))
                
                If m = UPWARD Then
                    cCount = CInt(Rnd * (blankPos.Y - 2)) + 1
                    newY = blankPos.Y - cCount
                Else
                    cCount = CInt(Rnd * ((rowSize - blankPos.Y) - 1)) + 1
                    newY = blankPos.Y + cCount
                End If
                
            End If
                            
        Loop Until moveIsValid(newX, newY)
        
        ' The move is valid at this point
        moveCells newX, newY, m, cCount
        Sleep 100
        
        moveCtr = moveCtr + 1
        
        DoEvents
        
        
    Loop Until moveCtr = moveCount
    
End Sub

Private Sub moveCells(ByVal newX As Integer, ByVal newY As Integer, ByVal m As MovementConstants, ByVal cCount As Integer)

    Dim cIndex          As Integer
    Dim nIndex          As Integer
    Dim tempIndex       As Integer
    Dim i               As Integer

    cIndex = findCellIndexByXY(blankPos.X, blankPos.Y)
    nIndex = findCellIndexByXY(newX, newY)
    tempIndex = cell(cIndex).getImageIndex
        
    Select Case m
        Case RIGHTWARD
        
            For i = 1 To cCount
                cell(cIndex).setImageIndex = cell(cIndex + 1).getImageIndex
                drawCellImage cIndex, vbSrcCopy
                cIndex = cIndex + 1
            Next
            
        Case DOWNWARD
            
            For i = 1 To cCount
                cell(cIndex).setImageIndex = cell(cIndex + colSize).getImageIndex
                drawCellImage cIndex, vbSrcCopy
                cIndex = cIndex + colSize
            Next
            
        Case LEFTWARD
            
            For i = 1 To cCount
                cell(cIndex).setImageIndex = cell(cIndex - 1).getImageIndex
                drawCellImage cIndex, vbSrcCopy
                cIndex = cIndex - 1
            Next
            
        Case UPWARD
            
            For i = 1 To cCount
                cell(cIndex).setImageIndex = cell(cIndex - colSize).getImageIndex
                drawCellImage cIndex, vbSrcCopy
                cIndex = cIndex - colSize
            Next
            
    End Select
        
    cell(nIndex).setImageIndex = tempIndex
    drawCellImage nIndex, vbSrcCopy
    blankPos.X = newX
    blankPos.Y = newY
    canvass.Refresh

End Sub

Private Function moveIsValid(ByVal newX As Integer, ByVal newY As Integer) As Boolean
    moveIsValid = ((newX >= 1 And newX <= colSize) And (newY >= 1 And newY <= rowSize))
End Function

Private Function findCellIndexByXY(ByVal bX As Integer, ByVal bY As Integer) As Integer
    findCellIndexByXY = ((bY - 1) * colSize) + (bX - 1)
End Function

Private Function done(ByVal marked As Variant) As Boolean

    Dim i   As Integer
    done = True
    For i = 0 To UBound(marked)
        If marked(i) = False Then
            done = False
            Exit Function
        End If
    Next

End Function

Private Sub setImages()

    Dim col         As Integer
    Dim row         As Integer
    Dim ctr         As Integer
    
    canvass.Picture = LoadPicture(EMPTY_STRING)
    selector.FillStyle = vbFSSolid
    
    For row = 1 To rowSize
        For col = 1 To colSize
            
            drawCellImage ctr, vbSrcCopy
            
            selector.FillColor = RGB(ctr + 1, ctr + 1, ctr + 1)
            Rectangle selector.hdc, _
                      cell(ctr).getLeft, _
                      cell(ctr).getTop, _
                      cell(ctr).getLeft + cell(ctr).getWidth, _
                      cell(ctr).getTop + cell(ctr).getHeight
            
            ctr = ctr + 1
            
        Next
    Next

End Sub

Private Sub drawCellImage(ByVal cIndex As Integer, ByVal rasterOp As Long)

    BitBlt canvass.hdc, _
           cell(cIndex).getLeft, _
           cell(cIndex).getTop, _
           cell(cIndex).getWidth, _
           cell(cIndex).getHeight, _
           IIf((showHint = True), buffer2.hdc, buffer.hdc), _
           cell(cell(cIndex).getImageIndex).getLeft, _
           cell(cell(cIndex).getImageIndex).getTop, _
           rasterOp
    
End Sub

Public Sub shuffleCells(ByRef this As Form)
    
    initializeCells
    shuffleImageIndexes
    setImages
    onPlay = True
    
End Sub

Public Sub reset(ByRef this As Form)
    initializeCells
    setImages
    drawMouldings this
End Sub

Public Sub loadImages()
    buffer.Picture = LoadResPicture(RES_BASE + pictureSelection, vbResBitmap)
    canvass.Picture = LoadResPicture(RES_BASE + pictureSelection, vbResBitmap)
    moulding.Picture = LoadResPicture(RESID_MOULDING, vbResBitmap)
    resizeSelector buffer.width, buffer.height
End Sub

Private Sub resizeSelector(ByVal newWidth As Integer, ByVal newHeight As Integer)
    selector.width = newWidth
    selector.height = newHeight
End Sub

Public Function solved() As Boolean

    Dim i   As Integer
    solved = True
    For i = 0 To cellCount - 1
        If cell(i).getImageIndex <> cell(i).getIndex Then
            solved = False
            Exit Function
        End If
    Next

End Function

Private Sub Class_Terminate()
    
    On Error Resume Next
    Dim i           As Integer
    
    For i = 0 To cellCount - 1
        Set cell(i) = Nothing
    Next
    
End Sub

Private Sub resizeBufferImage(ByVal cellWidth As Integer, ByVal cellHeight As Integer)

    Dim i   As Integer
    
    buffer2.Picture = LoadResPicture(RES_BASE + pictureSelection, vbResBitmap)

    ' Stretch the image on the buffer
    buffer.PaintPicture buffer2.Picture, 0, 0, buffer.ScaleWidth, buffer.ScaleHeight, 0, 0, , , vbSrcCopy
    
    ' Draw cell image borders
    buffer.DrawWidth = 2
    
    ' Horizontal borders
    For i = 0 To colSize - 1
        buffer.ForeColor = RGB(200, 200, 200)
        buffer.Line ((i * cellWidth) + (i + 1), 0)-((i * cellWidth) + (i + 1), buffer.ScaleHeight)
        buffer.ForeColor = RGB(30, 30, 30)
        buffer.Line ((i * cellWidth) + i + cellWidth, 0)-((i * cellWidth) + i + cellWidth, buffer.ScaleHeight)
    Next
    
    ' Vertical borders
    For i = 0 To rowSize - 1
        buffer.ForeColor = RGB(200, 200, 200)
        buffer.Line (0, (i * cellHeight) + (i + 1))-(buffer.ScaleWidth, (i * cellHeight) + (i + 1))
        buffer.ForeColor = RGB(30, 30, 30)
        buffer.Line (0, (i * cellHeight) + i + cellHeight)-(buffer.ScaleWidth, (i * cellHeight) + i + cellHeight)
    Next
    
    ' Draw the last cell image as blank
    drawBlankImage cellWidth, cellHeight
    
    buffer.Refresh

End Sub

Private Sub drawBufferWithHint()

    Dim i       As Integer
    
    buffer2.width = buffer.width
    buffer2.height = buffer.height
    buffer2.Picture = buffer.Image
    buffer2.ForeColor = RGB(255, 255, 255)
    buffer2.FontBold = True
    
    For i = 0 To cellCount - 2
        buffer2.CurrentX = cell(i).getLeft + 2
        buffer2.CurrentY = cell(i).getTop + 2
        buffer2.Print CStr(i + 1)
    Next
    buffer2.Refresh

End Sub

Public Sub drawMouldings(ByRef this As Form)

    Dim i               As Integer
    Dim rMouldCount     As Integer
    Dim cMouldCount     As Integer
    
    rMouldCount = (canvass.height \ MOULDING_SIZE) + 2
    cMouldCount = (canvass.width \ MOULDING_SIZE) + 2

    this.Cls
    ' Horizontal mouldings
    For i = 0 To cMouldCount - 1
        ' Top
        BitBlt this.hdc, (IMAGE_LEFT + (i * MOULDING_SIZE)) - MOULDING_SIZE, IMAGE_TOP - MOULDING_SIZE, MOULDING_SIZE, MOULDING_SIZE, moulding.hdc, MOULDING_SIZE, 0, vbSrcCopy
        ' Bottom
        BitBlt this.hdc, (IMAGE_LEFT + (i * MOULDING_SIZE)) - MOULDING_SIZE, (IMAGE_TOP + canvass.height), MOULDING_SIZE, MOULDING_SIZE, moulding.hdc, MOULDING_SIZE, moulding.ScaleHeight - MOULDING_SIZE, vbSrcCopy
    Next
    
    ' Vertical mouldings
    For i = 0 To rMouldCount - 1
        ' left
        BitBlt this.hdc, IMAGE_LEFT - MOULDING_SIZE, (IMAGE_TOP + (i * MOULDING_SIZE)) - MOULDING_SIZE, MOULDING_SIZE, MOULDING_SIZE, moulding.hdc, 0, MOULDING_SIZE, vbSrcCopy
        ' right
        BitBlt this.hdc, IMAGE_LEFT + canvass.width, (IMAGE_TOP + (i * MOULDING_SIZE)) - MOULDING_SIZE, MOULDING_SIZE, MOULDING_SIZE, moulding.hdc, moulding.ScaleWidth - MOULDING_SIZE, MOULDING_SIZE, vbSrcCopy
    Next
    
    ' Upper left corner
    BitBlt this.hdc, IMAGE_LEFT - MOULDING_SIZE, IMAGE_TOP - MOULDING_SIZE, MOULDING_SIZE, MOULDING_SIZE, moulding.hdc, 0, 0, vbSrcCopy
           
    ' Upper right corner
    BitBlt this.hdc, IMAGE_LEFT + canvass.width, IMAGE_TOP - MOULDING_SIZE, MOULDING_SIZE, MOULDING_SIZE, moulding.hdc, moulding.ScaleWidth - MOULDING_SIZE, 0, vbSrcCopy
           
    ' Bottom left corner
    BitBlt this.hdc, IMAGE_LEFT - MOULDING_SIZE, IMAGE_TOP + canvass.height, MOULDING_SIZE, MOULDING_SIZE, moulding.hdc, 0, moulding.ScaleHeight - MOULDING_SIZE, vbSrcCopy
           
    ' Bottom right corner
    BitBlt this.hdc, IMAGE_LEFT + canvass.width, IMAGE_TOP + canvass.height, MOULDING_SIZE, MOULDING_SIZE, moulding.hdc, moulding.ScaleWidth - MOULDING_SIZE, moulding.ScaleHeight - MOULDING_SIZE, vbSrcCopy
    
End Sub

Private Sub drawBlankImage(ByVal cellWidth As Integer, ByVal cellHeight As Integer)

    Dim X       As Integer
    Dim Y       As Integer
    Dim cCount  As Integer
    Dim rCount  As Integer
    
    cCount = (cellWidth \ MOULDING_SIZE) + 1
    rCount = (cellHeight \ MOULDING_SIZE) + 1
    
    blank.width = cellWidth
    blank.height = cellHeight
    
    ' Surface color/image
    For Y = 0 To rCount
        For X = 0 To cCount
            BitBlt blank.hdc, X * MOULDING_SIZE, Y * MOULDING_SIZE, MOULDING_SIZE, MOULDING_SIZE, moulding.hdc, moulding.ScaleWidth - (MOULDING_SIZE * 2), moulding.ScaleHeight - (MOULDING_SIZE * 2), vbSrcCopy
        Next
    Next

    ' Upper shadow
    For X = 0 To cCount
        BitBlt blank.hdc, X * MOULDING_SIZE, 0, MOULDING_SIZE, MOULDING_SIZE, moulding.hdc, moulding.ScaleWidth - (MOULDING_SIZE * 2), MOULDING_SIZE, vbSrcCopy
    Next

    ' Left shadow
    For Y = 0 To rCount
        BitBlt blank.hdc, 0, Y * MOULDING_SIZE, MOULDING_SIZE, MOULDING_SIZE, moulding.hdc, MOULDING_SIZE, moulding.ScaleHeight - (MOULDING_SIZE * 2), vbSrcCopy
    Next
    
    ' Corner shadow
    BitBlt blank.hdc, 0, 0, MOULDING_SIZE, MOULDING_SIZE, moulding.hdc, MOULDING_SIZE, MOULDING_SIZE, vbSrcCopy

    blank.Refresh
    
    ' Draw the blank image on the buffer.
    BitBlt buffer.hdc, buffer.ScaleWidth - cellWidth - 1, buffer.ScaleHeight - cellHeight - 1, cellWidth, cellHeight, blank.hdc, 0, 0, vbSrcCopy

End Sub

Public Sub redrawCanvass()

    Dim i   As Integer
    
    For i = 0 To cellCount - 1
        drawCellImage i, vbSrcCopy
    Next
    canvass.Refresh

End Sub
