Public Class ws2
    Const delm As String = "."
    Dim v1 As Integer
    Dim v2 As Integer
    Dim v3 As Integer
    Dim c1, c2 As Integer
    Dim longest As Integer
    Dim LongIndex As Integer
    Dim Temp As String
    Dim Xsize As Integer
    Dim Ysize As Integer
    Dim Count As Integer
    ' ------------------------------------
    Dim NoWords As Integer ' 8

    Dim NoPos(8) As Integer '           (NoWords) - Good, 
    Dim PosCount(8) As Integer '            Low, First to be used
    Dim Solution(20, 20) As Char '      (X,Y) -RAM redction posible
    Dim Positions(8, 400, 3) As Byte '  (NoWords, allposible, [0=X, 1=Y, 2=Dir+ Goodness])

    Dim MoveXY(8, 2) As Integer
    ' ---------------------------------
    Dim Wlen As Byte
    Dim X As Integer
    Dim Y As Integer
    Dim Cdir As Byte
    Dim Word As String
    Dim Good As Byte
    Dim NewX, NewY As Integer
    Dim r, r2 As Integer
    Dim Xtemp, Ytemp, Dtemp As Byte
    Dim Max As Integer
    Dim tries As Long

    ' ------------- INIT -------------
    Private Sub wsc_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        MoveXY(0, 0) = 1 : MoveXY(0, 1) = 0
        MoveXY(1, 0) = 1 : MoveXY(1, 1) = 1
        MoveXY(2, 0) = 0 : MoveXY(2, 1) = 1
        MoveXY(3, 0) = -1 : MoveXY(3, 1) = 1
        MoveXY(4, 0) = -1 : MoveXY(4, 1) = 0
        MoveXY(5, 0) = -1 : MoveXY(5, 1) = -1
        MoveXY(6, 0) = 0 : MoveXY(6, 1) = -1
        MoveXY(7, 0) = 1 : MoveXY(7, 1) = -1
    End Sub

    ' ----------- Display selected word -----------------
    Private Sub ListBox1_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles WordListBox.SelectedIndexChanged
        TextBox1.Text = WordListBox.SelectedItem
    End Sub

    ' ----------------- Add Word -and convert to lower case-------------
    Private Sub ButtonAdd_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonAdd.Click
        If TextBox1.Text <> WordListBox.SelectedItem And TextBox1.Text <> "" Then
            WordListBox.Items.Add(TextBox1.Text.ToLower)
        End If
    End Sub
    ' -------------- Remove word -----------------
    Private Sub ButtonRemove_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonRemove.Click
        WordListBox.Items.Remove(WordListBox.SelectedItem)
    End Sub
    ' -------------- Creat Puzzle ------------------
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        ' -------- Sort Word List -------------
        For v1 = 0 To WordListBox.Items.Count - 1
            longest = 0
            For v2 = v1 To WordListBox.Items.Count - 1
                If WordListBox.Items.Item(v2).ToString.Length > longest Then
                    longest = WordListBox.Items.Item(v2).ToString.Length
                    LongIndex = v2
                End If
            Next
            Temp = WordListBox.Items.Item(v1).ToString
            WordListBox.Items.Item(v1) = WordListBox.Items.Item(LongIndex)
            WordListBox.Items.Item(LongIndex) = Temp
        Next
        ' ---------------- Set Up Solution ---------------
        Xsize = CInt(TextBoxSize.Text) : Ysize = CInt(TextBox2.Text) : ReDim Solution(Xsize, Ysize)
        ClearSolution()
        Display()
        ' ------------solve it------------------
        NoWords = WordListBox.Items.Count
        ReDim NoPos(NoWords)
        ReDim PosCount(NoWords)
        v1 = CInt(Xsize) * CInt(Ysize) * 8
        ReDim Positions(NoWords, v1, 3)
        tries = 1 : v1 = 0
        Timer1.Enabled = True
        Button2.Text = "Stop"
       


    End Sub
    Private Sub ClearSolution()
        For c1 = 0 To Xsize - 1
            For c2 = 0 To Ysize - 1
                Solution(c1, c2) = delm
            Next
        Next
    End Sub

    Private Sub Display()
        RTBsolution.Clear()
        For v1 = 0 To Xsize - 1
            For v2 = 0 To Ysize - 1
                RTBsolution.AppendText(Solution(v1, v2).ToString + " ")
                Count = Count + 1
            Next
            RTBsolution.AppendText(Chr(13).ToString)
        Next
    End Sub

    Private Sub RTBsolution_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RTBsolution.TextChanged
        Display()
    End Sub
    ' ------------------------------Try to Solve once--------------------------------
    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        ' Loops through all words in word list
        Wlen = WordListBox.Items.Item(v1).ToString.Length
        Word = WordListBox.Items.Item(v1).ToString
        NoPos(v1) = 0 : PosCount(v1) = 0
        For X = 0 To Xsize - 1
            For Y = 0 To Ysize - 1
                If Solution(X, Y) <> delm And Solution(X, Y) <> Word.Chars(0) Then Continue For
                Good = 0
                If Solution(X, Y) = Word.Chars(0) Then : Good = 1 : End If
                For Cdir = 0 To 7 ' Check all directions for that position
                    For Count = 1 To Wlen - 1 ' Check letters in word
                        NewX = X + MoveXY(Cdir, 0) * Count
                        If NewX < 0 Or NewX > (Xsize - 1) Then Exit For
                        NewY = Y + MoveXY(Cdir, 1) * Count
                        If NewY < 0 Or NewY > (Ysize - 1) Then Exit For
                        If Solution(NewX, NewY) = delm Then Continue For
                        If Solution(NewX, NewY) = Word.Chars(Count) Then : Good = Good + 1
                        Else : Exit For
                        End If
                    Next ' check all letters
                    If Count = Wlen Then ' Word can fit
                        Positions(v1, NoPos(v1), 0) = X
                        Positions(v1, NoPos(v1), 1) = Y
                        Positions(v1, NoPos(v1), 2) = Cdir + 16 * Good ' Stores low-Direction, Hi-Goodness
                        NoPos(v1) = NoPos(v1) + 1
                    End If
                Next ' check all directions
            Next 'Y
        Next 'X
        If NoPos(v1) <> 0 Then 'did find place for word
            ' Randomize and Sort Array
            For v2 = NoPos(v1) - 1 To 0 Step -1
                r = CInt(Int(Rnd() * (v2 + 1)))
                Xtemp = Positions(v1, v2, 0) : Ytemp = Positions(v1, v2, 1) : Dtemp = Positions(v1, v2, 2)
                Positions(v1, v2, 0) = Positions(v1, r, 0) : Positions(v1, v2, 1) = Positions(v1, r, 1) : Positions(v1, v2, 2) = Positions(v1, r, 2)
                Positions(v1, r, 0) = Xtemp : Positions(v1, r, 1) = Ytemp : Positions(v1, r, 2) = Dtemp
            Next

            ' -----------------SORT-------------------
            For v2 = 0 To NoPos(v1) - 2
                Max = v2
                For v3 = v2 + 1 To NoPos(v1) - 1
                    If Positions(v1, v3, 2) And 240 > Positions(v1, Max, 2) And 240 Then : Max = v3 : End If
                Next
                Xtemp = Positions(v1, v2, 0) : Ytemp = Positions(v1, v2, 1) : Dtemp = Positions(v1, v2, 2)
                Positions(v1, v2, 0) = Positions(v1, Max, 0) : Positions(v1, v2, 1) = Positions(v1, Max, 1) : Positions(v1, v2, 2) = Positions(v1, Max, 2)
                Positions(v1, Max, 0) = Xtemp : Positions(v1, Max, 1) = Ytemp : Positions(v1, Max, 2) = Dtemp
            Next
            ' Add word to solution
            Solution(Positions(v1, PosCount(v1), 0), Positions(v1, PosCount(v1), 1)) = Word.Chars(0)
            For v2 = 1 To Wlen - 1
                NewX = Positions(v1, PosCount(v1), 0) + MoveXY(Positions(v1, PosCount(v1), 2) And 7, 0) * v2
                NewY = Positions(v1, PosCount(v1), 1) + MoveXY(Positions(v1, PosCount(v1), 2) And 7, 1) * v2
                Solution(NewX, NewY) = Word.Chars(v2)
            Next

        Else ' Can not place word
BACKONE:
            If v1 = 0 Then
                TextBox3.Text = "No Possible Solution" : Timer1.Enabled = False
                GoTo ENDTIME
            End If
            tries = tries + 1

            TextBox3.Text = "Try# " + tries.ToString
            ClearSolution()
            'GoTo BACKINTO
            v1 = v1 - 1
            PosCount(v1) = PosCount(v1) + 1
            If PosCount(v1) = NoPos(v1) Then GoTo BACKONE

            For v2 = 0 To v1
                Wlen = WordListBox.Items.Item(v2).ToString.Length
                Word = WordListBox.Items.Item(v2).ToString
                Solution(Positions(v2, PosCount(v2), 0), Positions(v2, PosCount(v2), 1)) = Word.Chars(0)
                For v3 = 1 To Wlen - 1
                    NewX = Positions(v2, PosCount(v2), 0) + MoveXY(Positions(v2, PosCount(v2), 2) And 7, 0) * v3
                    NewY = Positions(v2, PosCount(v2), 1) + MoveXY(Positions(v2, PosCount(v2), 2) And 7, 1) * v3
                    Solution(NewX, NewY) = Word.Chars(v3)
                Next
            Next

        End If
        v1 = v1 + 1 'Next Word
        WordListBox.SelectedIndex = v1 - 1
ENDTIME:
        If v1 = NoWords Then
            Timer1.Enabled = False : Button2.Text = "----"
            TextBox3.Text = "good in " + tries.ToString + " tries"
            Display()
        End If
    End Sub
    ' Stop / Start
    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        If Button2.Text = "Stop" Then
            Button2.Text = "Start"
            Timer1.Enabled = False
            Display()
        Else
            If Button2.Text = "Start" Then
                Button2.Text = "Stop"
                Timer1.Enabled = True
            End If
        End If
    End Sub
    ' Copy wordlist to clipboard
    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
        Clipboard.Clear() : Temp = ""
        For c1 = 0 To WordListBox.Items.Count - 1
            Temp = Temp + WordListBox.Items.Item(c1).ToString + Chr(13).ToString
        Next
        Clipboard.SetText(Temp)
    End Sub
    ' Copy puzzle to clipboard
    Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
        Clipboard.Clear() : Temp = ""
        Clipboard.SetText(RTBsolution.Text)
    End Sub
    ' Fill In missing letters
    Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click
        For c1 = 0 To Xsize - 1
            For c2 = 0 To Ysize - 1
                If Solution(c1, c2).ToString = delm Then
                    If RadioButton1.Checked Then
                        r = CInt(Int(Rnd() * NoWords))
                        Solution(c1, c2) = Mid(WordListBox.Items.Item(r), 1, 1)
                    End If
                    If RadioButton2.Checked Then
                        r = CInt(Int(Rnd() * NoWords))
                        r2 = CInt(Int(Rnd() * Len(NoWords))) + 1
                        Solution(c1, c2) = Mid(WordListBox.Items.Item(r), r2, 1)
                    End If
                    If RadioButton3.Checked Then
                        r = CInt(Int(Rnd() * 26)) + 97
                        Solution(c1, c2) = Chr(r)
                    End If
                End If
            Next
        Next
        Display()
    End Sub
    ' Clear Word list
    Private Sub Button6_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button6.Click
        WordListBox.Items.Clear()
    End Sub
    ' Copy From Clipboard
    Private Sub Button7_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button7.Click
        Dim l As String
        WordListBox.Items.Clear()
        Temp = Clipboard.GetText
        Word = ""
        For c1 = 1 To Len(Temp)
            l = Mid(Temp, c1, 1).ToLower
            If l >= "a" And l < "{" Then
                Word = Word + l
            Else
                If Word <> "" Then
                    WordListBox.Items.Add(Word)
                    Word = ""
                End If
            End If
        Next
        If Word <> "" Then
            WordListBox.Items.Add(Word)
        End If
    End Sub

    Private Sub Button8_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button8.Click
        WordListBox.Sorted = False : WordListBox.Sorted = True
    End Sub

    '-----------------------------PRINTING-----------------------------
    '------------------------------------------------------------------
    ' Declare the PrintDocument object.
    Private WithEvents docToPrint As New Printing.PrintDocument

    ' This method will set properties on the PrintDialog object and
    ' then display the dialog.
    Private Sub ButtonPrint_Click(ByVal sender As System.Object, _
        ByVal e As System.EventArgs) Handles ButtonPrint.Click
        If Timer1.Enabled = False Then
            ' Allow the user to choose the page range he or she would
            ' like to print.
            PrintDialog1.AllowSomePages = True

            ' Show the help button.
            PrintDialog1.ShowHelp = True

            ' Set the Document property to the PrintDocument for 
            ' which the PrintPage Event has been handled. To display the
            ' dialog, either this property or the PrinterSettings property 
            ' must be set 
            PrintDialog1.Document = docToPrint

            Dim result As DialogResult = PrintDialog1.ShowDialog()

            ' If the result is OK then print the document.
            If (result = DialogResult.OK) Then
                docToPrint.Print()
            End If
        End If

    End Sub

    ' The PrintDialog will print the document
    ' by handling the document's PrintPage event.
    Private Sub document_PrintPage(ByVal sender As Object, _
       ByVal e As System.Drawing.Printing.PrintPageEventArgs) _
           Handles docToPrint.PrintPage

        ' Insert code to render the page here.
        ' This code will be called when the control is drawn.

        ' The following code will render a simple
        ' message on the printed document.
        Dim text As String
        Dim printFont As New System.Drawing.Font _
            ("Courier", 14, System.Drawing.FontStyle.Regular)
        Dim puzzleFont As New System.Drawing.Font _
            ("Courier New", 12, System.Drawing.FontStyle.Regular)
        text = TextBox4.Text
        c1 = 400 - Len(text) * 7
        ' Draw the content.
        e.Graphics.DrawString(text, printFont, _
            System.Drawing.Brushes.Black, c1, 10)
        X = 5 : Y = 100
        longest = 0

        For c1 = 0 To WordListBox.Items.Count - 1
            Word = WordListBox.Items.Item(c1).ToString
            e.Graphics.DrawString(Word, puzzleFont, _
                        System.Drawing.Brushes.Black, X, Y)
            If Len(Word) > longest Then : longest = Len(Word) : End If
            Y = Y + 15
            If Y > 1000 Then : Y = 100 : X = X + longest * 12 + 4 : longest = 0 : End If
        Next
        Y = 100 : X = X + longest * 12 + 9
        e.Graphics.DrawString(RTBsolution.Text, puzzleFont, _
                            System.Drawing.Brushes.Black, X, Y)
        text = "Tim Salazar 2006  -  InsectPhotos.net"
        Y = 34 : X = 400 - Len(text) * 6
        e.Graphics.DrawString(text, puzzleFont, _
                            System.Drawing.Brushes.Black, X, Y)
    End Sub


    '------------------------------------------------------------------

End Class