Генератор и решатель судоку

Отличный исходник генератора или решателя головоломки судоку. Исходный код был написан на языке PureBasic. Я адаптировал его под FreeBasic , а так же оптимизировал некоторые участки кода, в результате чего размер кода сократился более чем вдвое.
Платформа: Windows. Дополнительно нужна библиотека window9 .
Автор исходного текста: rob6523 создано в 2006 году.
Адаптирование и оптимизация кода под FreeBasic: Станислав Будинов, 2011 год

Генератор судоку исходник

#INCLUDE "window9.bi"


Type elements
    As Byte valeur
    As  String valeursPossibles
End Type


Dim Shared sudoku(9,9) As elements
Dim Shared As HWND hwnd

Sub Open_sudoku()
    hwnd=OpenWindow("Генератор судоку", 0, 0, 410, 470): CenterWindow(hwnd)
    Var TraitHorizontal=Create_Image(388, 1)
    Var TraitHorizontal1=Create_Image(388, 3)
    Var TraitVertical=Create_Image(1,388)
    Var TraitVertical1=Create_Image(3,388)
    SetGadgetFont(,LoadFont("arial",16))
    Dim  As Integer f=10,g=10,h
    For a As Integer =0 To 80

        StringGadget(a, f, g, 30, 30, "", ES_NUMBER Or ES_CENTER)
        f+=43

        If f>387 Then

            f=10:g+=43

        Endif
    Next

    f=4:g=2

    For a As Integer=83 To 92

        If h>2 Or h=0 Then

            ImageGadget(a, 2, g, 390, 1, TraitHorizontal1)
            ImageGadget(a+10, g, 2, 1, 390, TraitVertical1)
            h=0

        Else

            ImageGadget(a, 4, g, 390, 1, TraitHorizontal)
            ImageGadget(a+10, g, 2, 1, 390, TraitVertical)
        Endif
        h+=1:g+=43

    Next

    ButtonGadget(82, 85, 400, 110, 30, "Поиск")
    ButtonGadget(81, 200, 400, 110, 30, "Очистить")
End Sub


Sub initialiser()
    For i As Integer =0 To 8

        For j As Integer=0 To 8

            sudoku(i,j).valeur = 0

            sudoku(i,j).valeursPossibles = "123456789"
        Next j
    Next i
End Sub


Sub verifier(GadgetID_ As Integer)
    If (Len(GetGadgetText(GadgetID_)) > 1) Then

        SetGadgetText(GadgetID_, Left(GetGadgetText(GadgetID_),1))
    Endif
End Sub


Function estResolu() As Byte

    Dim As Byte result = 1

    For i As Integer=0 To 8

        For j As Integer=0 To 8

            If sudoku(i,j).valeur=0 Then

                result = 0

            Endif
        Next j
    Next i
    Return result
End Function


Function listeValeursEnPrise(ligne As Byte,colonne As Byte) As String

    Dim As String result = ""
    For i As Byte=0 To 8

        If ((i <> colonne) And (sudoku(ligne,i).valeur <> 0)) Then

            result += Str(sudoku(ligne,i).valeur)
        Endif
    Next i
    For i As Byte=0 To 8

        If ((i <> ligne) And (sudoku(i,colonne).valeur <> 0)) Then

            result += Str(sudoku(i,colonne).valeur)
        Endif
    Next i
    For i As Byte=(ligne\3)*3 To ((ligne\3)*3)+2

        For j As Byte=(colonne\3)*3 To ((colonne\3)*3)+2

            If ((i<>ligne) And (j<>colonne) And (sudoku(i,j).valeur <> 0)) Then

                result += Str(sudoku(i,j).valeur)
            Endif
        Next j
    Next i
    Return result
End Function


Sub simplifierSudoku()
    Dim As Byte ligne,colonne
    While((ligne<9))
        If (sudoku(ligne,colonne).valeur = 0) Then

            Dim As String valeursImpossibles = listeValeursEnPrise(ligne,colonne)
            While Len(valeursImpossibles)>0

                sudoku(ligne,colonne).valeursPossibles=ReplaceString(sudoku(ligne,colonne).valeursPossibles,Left(valeursImpossibles,1),"")
                valeursImpossibles = ReplaceString(valeursImpossibles,Left(valeursImpossibles,1),"")
            Wend

            If(Len(sudoku(ligne,colonne).valeursPossibles)=1) Then

                sudoku(ligne,colonne).valeur = Val(Left(sudoku(ligne,colonne).valeursPossibles,1))
                ligne = 0

                colonne = -1

            Endif
        Endif
        colonne += 1

        If colonne = 9 Then

            colonne = 0

            ligne += 1

        Endif
    Wend

End Sub


Function resoudreParBackTracking(ligne As Byte, colonne As Byte) As Byte

    If (ligne = 9) Then Return 1

    If (sudoku(ligne, colonne).valeur = 0) Then

        Dim As Byte i=1, trouve
        While ((i < (Len(sudoku(ligne, colonne).valeursPossibles)) + 1) And (trouve = 0))
            If ((Instr(listeValeursEnPrise(ligne,colonne),Mid(sudoku(ligne,colonne).valeursPossibles,i,1))) = 0) Then

                sudoku(ligne,colonne).valeur = Val(Mid(sudoku(ligne,colonne).valeursPossibles,i,1))
                colonne += 1

                If colonne = 9 Then

                    colonne = 0

                    ligne += 1

                Endif
                trouve=resoudreParBackTracking(ligne, colonne)
                If (trouve = 0) Then

                    colonne = colonne - 1

                    If colonne = -1 Then

                        colonne = 8

                        ligne = ligne -1

                    Endif
                    If ligne <> -1 Then

                        sudoku(ligne,colonne).valeur = 0

                    Else

                        Return 0

                    Endif
                Endif
            Endif
            i += 1

        Wend

        Return trouve
    Else

        colonne += 1

        If colonne = 9 Then

            colonne = 0

            ligne += 1

        Endif
        Return resoudreParBackTracking(ligne, colonne)
    Endif
End Function


Open_sudoku()
Dim As Integer event,GadgetID_

Do


    Event = WaitEvent()
    If Event = EventGadget Then

        GadgetID_ = EventNumber
        If GadgetID_ = 82 Then

            DisableGadget(82, 1)
            SetGadgetText(82,"Поиск...")
            initialiser()
            Dim As Byte ligne,colonne,verif
            Dim As String message
            For i As Byte=0 To 80

                If GetGadgetText(i) <> "" Then

                    sudoku(ligne,colonne).valeur = Val(GetGadgetText(i))
                Endif
                colonne += 1

                If colonne = 9 Then

                    colonne = 0

                    ligne += 1

                Endif
            Next i
            For ligne=0 To 8

                For colonne=0 To 8

                    If (sudoku(ligne,colonne).valeur <> 0) And (Instr(listeValeursEnPrise(ligne,colonne),Str(sudoku(ligne,colonne).valeur)) <> 0) Then

                        verif = 1

                    Endif
                Next colonne
            Next ligne
            If verif = 1 Then

                MessBox("Ошибка в судоку !!!", "Решение этого судоку не может быть найден", MB_OK Or MB_ICONERROR)
            Else

                Var Debut = GetTickCount()
                simplifierSudoku()
                If estResolu() = 0 Then

                    resoudreParBackTracking(0,0)
                    message = "Решение найдено за " + Str(GetTickCount() - Debut) + " миллисекунд(ы)."
                Else

                    message = "Решение найдено за " + Str(GetTickCount() - Debut) + " миллисекунд(ы)."
                Endif
                ligne = 0

                colonne = 0

                For i As Byte=0 To 80

                    If sudoku(ligne, colonne).valeur <>0 Then

                        SetGadgetText(i,Str(sudoku(ligne, colonne).valeur))
                    Endif
                    colonne += 1

                    If colonne = 9 Then

                        colonne = 0

                        ligne += 1

                    Endif
                Next i
                MessBox("Решение найдено!", message, MB_OK Or MB_ICONINFORMATION)
            Endif
            DisableGadget(82, 0)
            SetGadgetText(82,"Поиск")
        Elseif GadgetID_ = 81 Then

            For i As Byte=0 To 80

                SetGadgetText(i, "")
            Next i
        Elseif ((GadgetID_ >= 0) And (GadgetID_ <= 80)) Then

            verifier(GadgetID_)
        Endif
    Endif

Loop Until Event =EventClose