fehlerhaft Code mit SetGadgetColor

Anfängerfragen zum Programmieren mit PureBasic.
Benutzeravatar
marcelx
Beiträge: 429
Registriert: 19.02.2010 20:19
Wohnort: Darmstadt

fehlerhaft Code mit SetGadgetColor

Beitrag von marcelx »

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.

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
Win-10, PB 5.31 (Windows - x86)
Benutzeravatar
HeX0R
Beiträge: 3040
Registriert: 10.09.2004 09:59
Computerausstattung: AMD Ryzen 7 5800X
96Gig Ram
NVIDIA GEFORCE RTX 3060TI/8Gig
Win11 64Bit
G19 Tastatur
2x 24" + 1x27" Monitore
Glorious O Wireless Maus
PB 3.x-PB 6.x
Oculus Quest 2 + 3
Kontaktdaten:

Re: fehlerhaft Code mit SetGadgetColor

Beitrag von HeX0R »

Das liegt daran, dass Du bereits eingefärbte Felder in Deiner color() Prozedur teilweise auch wieder löschst.
Du musst erst alle löschen und dann einfärben, nicht alles in einer Schleife:

Code: Alles auswählen

Procedure color()
  Protected a, val.s, isVal.s, r, c, id

  val = GetGadgetText(nummer) ; Zifferauswahl
  
  For r = 0 To 8
  	For c = 0 To 8
  		colorUnset(Sudoku(c, r)\Element)
  	Next c
  Next r

  For r = 0 To 8
    For c = 0 To 8
      id = Sudoku(c, r)\Element
      isVal = GetGadgetText(id)
      If isVal = val
      	colorSetAll(val, r, c)
      EndIf
    Next
  Next       
EndProcedure
Benutzeravatar
marcelx
Beiträge: 429
Registriert: 19.02.2010 20:19
Wohnort: Darmstadt

Re: fehlerhaft Code mit SetGadgetColor

Beitrag von marcelx »

Ho, super danke HeXOR
Win-10, PB 5.31 (Windows - x86)
Antworten