Code: Alles auswählen
; ------------------------------------------------------------------------------------
; Sudoku Solver
; Author: Alexander Aigner
; ------------------------------------------------------------------------------------
EnableExplicit
Structure SudEntry
Element.i
Available.b[9]
EndStructure
Global Dim Sudoku.SudEntry(8, 8)
Define Clear, Solve, Event, Main, r, c, w, h, d, bd, x1, y1, x2, y2, ox
Procedure ClearAvailable()
Protected c, r, a
For r = 0 To 8
For c = 0 To 8
For a = 0 To 8
Sudoku(c, r)\Available[a] = #False
Next
Next
Next
EndProcedure
Procedure NewSudoku()
Protected c, r, a
For r = 0 To 8
For c = 0 To 8
SetGadgetText(Sudoku(c, r)\Element, "")
Next
Next
EndProcedure
Procedure SolveSudoku()
Protected s, c, r, a, val, Empty, Change
Protected b1, b2, b3, b4, bs1, bs2, c2, r2
Protected nbAvailable, lAvailable
ClearAvailable() ; Mal alles platt machen
Empty = #True
Change = #True
; Solange noch was frei ist oder sich was ändert
While Change And Empty
Empty = #False
Change = #False
; Reihen & Spalten abklappern
For r = 0 To 8
For c = 0 To 8
Val = Val(GetGadgetText(Sudoku(c, r)\Element))
If Val
; Nicht mehr mögliche streichen
For s = 0 To 8
If s<>r
Sudoku(c, s)\Available[Val-1] = #True
EndIf
If s<>c
Sudoku(s, r)\Available[Val-1] = #True
EndIf
Next
Else
Empty = #True ; Noch was frei
EndIf
Next
Next
; Blöcke abklappern
For b1 = 0 To 2
For b2 = 0 To 2
For b3 = 0 To 2
For b4 = 0 To 2
r = b1*3 + b3
c = b2*3 + b4
Val = Val(GetGadgetText(Sudoku(c, r)\Element))
If Val
; Nicht mehr mögliche streichen
For bs1 = 0 To 2
For bs2 = 0 To 2
r2 = b1*3 + bs1
c2 = b2*3 + bs2
If r<>r2 And c<>c2
Sudoku(c2, r2)\Available[Val-1] = #True
EndIf
Next
Next
Else
Empty = #True ; Noch was frei
EndIf
Next
Next
Next
Next
; Checken
For r = 0 To 8
For c = 0 To 8
nbAvailable = 9
For a = 0 To 8
If Sudoku(c, r)\Available[a]
nbAvailable-1
Else
lAvailable = a + 1
EndIf
Next
If nbAvailable = 1 ; Eindeutige Lösung!
If Not GetGadgetText(Sudoku(c, r)\Element)
SetGadgetText(Sudoku(c, r)\Element, Str(lAvailable))
Change = #True
EndIf
ElseIf Not nbAvailable ; FEHLER!
Change = #True
Empty = #False
Break 3
EndIf
Next
Next
Wend
; Meldungen
If (Change = #False) And (Empty = #False)
MessageRequester("Gelöst", "Sudoku wurde gelöst")
ElseIf (Change = #False) And (Empty = #True)
MessageRequester("Nicht eindeutig", "Sudoku nicht eindeutig lösbar, bitte geben sie eine weitere Zahl ein")
ElseIf (Change = #True) And (Empty = #False)
MessageRequester("Fehler", "Es ist ein Fehler im Sudoku")
EndIf
EndProcedure
; X - Position
x1 = 5
; Y - Position
y1 = 5
; Breite 1. Eingabe
w = 20
; Höhe 1. Eingabe
h = 20
; Abstand zwischen den Eingaben
d = 5
; Abstand zwischen den Blöcken
bd = 15
ox = x1
Main = OpenWindow(#PB_Any, 0, 0, 250, 310, "Sudoku - Solver", #PB_Window_ScreenCentered | #PB_Window_SystemMenu | #PB_Window_Invisible)
Solve = ButtonGadget(#PB_Any, 5, 260, 240, 20, "Lösen")
Clear = ButtonGadget(#PB_Any, 5, 285, 240, 20, "Neues Sudoku")
; SudokuFeld zeichnen
For r = 0 To 8
If Not r%3 And r
y1 + (bd-d)
EndIf
x1 = ox
For c = 0 To 8
If Not c%3 And c
x1 + (bd-d)
EndIf
x2 = x1 + c*(w + d)
y2 = y1 + r*(h + d)
Sudoku(c, r)\Element = StringGadget(#PB_Any, x2, y2, w, h, "", #PB_String_Numeric|#PB_Text_Center)
SendMessage_(GadgetID(Sudoku(c, r)\Element), #EM_LIMITTEXT, 1, 0) ; Zeichenanzahl begrenzen
Next
Next
HideWindow(Main, #Null)
Repeat
Event = WaitWindowEvent()
Select Event
Case #PB_Event_Gadget
Select EventGadget()
Case Clear
NewSudoku()
Case Solve
SolveSudoku()
EndSelect
EndSelect
Until Event = #PB_Event_CloseWindow