fehlerhaft Code mit SetGadgetColor
Verfasst: 11.06.2024 15:30
Hallo zusammen,
ich möchte ein kleine Programm schreiben für Sudoku.
Als Base habe ich den Code "Sudoku Solver" von Alexander Aigner ( viewtopic.php?p=244411 ) verwendet.
Ich möchte, wenn ich eine oder mehrere stelle ein Ziffer eintrage (z.B. eine eins) und wähle 1 bei der ComboBoxGadget, dass beim klicken auf "markieren" die Zellen kreuzweise markiert werden (Horizontal und Vertikal).
Leider bei mein Procedure colorSetAll werden nicht komplett die Zeilen, Spalten und Quadrat markiert.
Ich finde die Ursachen nicht.
ich möchte ein kleine Programm schreiben für Sudoku.
Als Base habe ich den Code "Sudoku Solver" von Alexander Aigner ( viewtopic.php?p=244411 ) verwendet.
Ich möchte, wenn ich eine oder mehrere stelle ein Ziffer eintrage (z.B. eine eins) und wähle 1 bei der ComboBoxGadget, dass beim klicken auf "markieren" die Zellen kreuzweise markiert werden (Horizontal und Vertikal).
Leider bei mein Procedure colorSetAll werden nicht komplett die Zeilen, Spalten und Quadrat markiert.
Ich finde die Ursachen nicht.
Code: Alles auswählen
; ------------------------------------------------------------------------------------
; Sudoku Solver
; Author: Alexander Aigner
; ------------------------------------------------------------------------------------
EnableExplicit
Structure SudEntry
Element.i
Available.b[9]
EndStructure
Global Dim Sudoku.SudEntry(8, 8), nummer
Define Clear, color, Event, Main, r, c, w, h, d, bd, x1, y1, x2, y2, ox
Define Farbe
Global colorUnsetVal = RGB(255, 255, 255)
Global colorSetVal = RGB(0, 255, 0)
Procedure NewSudoku()
Protected c, r, a
For r = 0 To 8
For c = 0 To 8
SetGadgetText(Sudoku(c, r)\Element, "")
SetGadgetColor(Sudoku(c, r)\Element, #PB_Gadget_BackColor, colorUnsetVal)
Next
Next
EndProcedure
Procedure colorSet(id)
SetGadgetColor(id, #PB_Gadget_BackColor, colorSetVal)
EndProcedure
Procedure colorUnSet(id)
SetGadgetColor(id, #PB_Gadget_BackColor, colorUnSetVal)
EndProcedure
Procedure colorSetAll(val0.s, r0, c0)
Define c, r, c1, r1, id
; horizontale
For c = 0 To 8
id = Sudoku(c, r0)\Element
colorSet(id)
Next
; vertikal
For r = 0 To 8
id = Sudoku(c0, r)\Element
colorSet(id)
Next
; quadrat
If c0 < 3
c1 = 0
ElseIf c0 > 5
c1 = 6
Else
c1 = 3
EndIf
If r0 < 3
r1 = 0
ElseIf r0 > 5
r1 = 6
Else
r1 = 3
EndIf
For c = c1 To c1 + 2
For r = r1 To r1 + 2
id = Sudoku(c, r)\Element
Debug id
colorSet(id)
Next
Next
EndProcedure
Procedure color()
Define a, val.s, isVal.s, r, c, id
val = GetGadgetText(nummer) ; Zifferauswahl
For r = 0 To 8
For c = 0 To 8
id = Sudoku(c, r)\Element
colorUnset(id)
isVal = GetGadgetText(id)
If isVal = val
colorSetAll(val, r, c)
EndIf
Next
Next
EndProcedure
x1 = 5
y1 = 5
w = 20
h = 20
d = 5
bd = 15
ox = x1
Define a, ev
Main = OpenWindow(#PB_Any, 0, 0, 250, 310, "Sudoku", #PB_Window_ScreenCentered | #PB_Window_SystemMenu | #PB_Window_Invisible)
color = ButtonGadget(#PB_Any, 5, 260, 240-100, 20, "markieren")
nummer = ComboBoxGadget(#PB_Any, 200, 260, 40, 20)
For a = 1 To 9
AddGadgetItem(nummer, -1,Str(a))
Next
SetGadgetText(nummer, "1")
Clear = ButtonGadget(#PB_Any, 5, 285, 240, 20, "Löschen")
; 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
ev = EventGadget()
Select ev
Case Clear
NewSudoku()
Case color
color()
Default
EndSelect
EndSelect
Until Event = #PB_Event_CloseWindow