mainfrm.pas

Sudoku is a logic-based number placement puzzle. A deceptively simple game of logic, Sudoku is puzzl

// And sets FoundAt to be the index where we last found a possible for this value
Function TMainForm.PossiblesInCol(TheValue, nCol:Integer; VAR FoundAt:Integer):Integer;
var
    Index, n: Integer;
begin
    n := 0;
    FoundAt := 0;
    For Index := 1 To cMaxCells do begin
        If Squares[Index].nCol = nCol Then begin
            If Squares[Index].Possibles[TheValue] > 0 Then begin
                INC(n);
                FoundAt := Index;
            End;
        End;
    end;
    result := n;
end;


// Returns no of possibles for This Value in this row
// And sets FoundAt to be the index where we last found a possible for this value
Function TMainForm.PossiblesInRow(TheValue, nRow:Integer; VAR FoundAt:Integer):Integer;
var
    Index, n: Integer;
begin
    n := 0;
    FoundAt := 0;
    For Index := 1 To cMaxCells do begin
        If Squares[Index].nRow = nRow Then begin
            If Squares[Index].Possibles[TheValue] > 0 Then begin
                INC(n);
                FoundAt := Index;
            End;
        End;
    end;
    result := n;
end;


// Try all candidates for each col until we find something new
// If find a new one, stop, set the value and return True
// If no luck, return False
Function TMainForm.TryEachCol():Boolean;
Var
    iCol,iValue,n, nFoundAt:  Integer;
begin
    result := False;
    For iCol := 1 To ncSIZE do begin
        For iValue := 1 To ncSIZE do begin
            n := PossiblesInCol(iValue, iCol, nFoundAt);
            If n = 1 Then begin                           // Check this is not already set
               If Squares[nFoundAt].Value = 0 Then begin  // Hooray! We have solved this square
                  SetSquare(iValue, nFoundAt);
                  result := True; // ' Do not go any further now
                  Exit; // ------------------------do not like this
                End;
            End;
        end; // for ivalue
    end; // for icol
end;


Function TMainForm.TryEachRow():Boolean;
Var
    iRow,iValue,n, nFoundAt:  Integer;
begin
    result := False;
    For iRow := 1 To ncSIZE do begin
        For iValue := 1 To ncSIZE do begin
            n := PossiblesInRow(iValue, iRow, nFoundAt);
            If n = 1 Then begin                           // Check this is not already set
               If Squares[nFoundAt].Value = 0 Then begin  // Hooray! We have solved this square
                  SetSquare(iValue, nFoundAt);
                  result := True; // ' Do not go any further now
                  Exit; // ------------------------do not like this
                End;
            End;
        end; // for ivalue
    end; // for icol
end;


// Returns no of possibles for This Value in this box
// And sets FoundAt to be the index where we last found a possible for this value
Function TMainForm.PossiblesInBox(TheValue, nBox:Integer; VAR FoundAt:Integer):Integer;
VAR
    Idx,n: Integer;
begin
    n := 0;
    FoundAt := 0;
    For Idx := 1 To cMaxCells do begin
        If Squares[Idx].nBox = nBox Then begin
            If Squares[Idx].Possibles[TheValue] > 0 Then begin
                INC(n);
                FoundAt := Idx;
            End;
        End;
    end; // for idx
    Result := n;
end;


// Try all candidates for each box until we find something new
// If find a new one, stop, set the value and return True
// If no luck, return False
Function TMainForm.TryEachBox():Boolean;
VAR
    iBox,iValue,n,nFoundAt: Integer;
begin
    Result := False;
    For iBox := 1 To ncSIZE do begin
        For iValue := 1 To ncSIZE do begin
            n := PossiblesInBox(iValue, iBox, nFoundAt);
            if n = 1 Then begin  // Check this is not already set
                if Squares[nFoundAt].Value = 0 Then begin //Hooray! We have solved this square
                    SetSquare(iValue, nFoundAt);
                    Result := True;   //Do not go any further now
                    Exit; // --------------------------------------------------don't like this
                end;
            end;
        end; // for ivalue
    end; // for ibox
end;

// Set the square value and eliminate all possibles in same row, col and box
Function TMainForm.SetSquare(iValue, Idx:Integer):Boolean;
VAR
   i:  Integer;
begin
    Squares[Idx].Value      := iValue;
////    Squares[Idx].GuessLevel := mnGuessLevel;
    For i := 1 to cMaxCells do begin
        If Squares[i].nRow = Squares[Idx].nRow Then begin
            Squares[i].Possibles[iValue] := 0;
        End;
        If Squares[i].nCol = Squares[Idx].nCol Then begin
            Squares[i].Possibles[iValue] := 0;
        End;
        If Squares[i].nBox = Squares[Idx].nBox Then begin
            Squares[i].Possibles[iValue] := 0;
        End;
    end;
    For i := 1 To ncSIZE do begin  // And make sure this square's Possibles are set properly
        Squares[Idx].Possibles[i] := 0;
    end;
    Squares[Idx].Possibles[iValue] := 1;
    Result := True;
end;


function TMainForm.GetSquare(Idx: Integer): Integer;
begin
   Result := Squares[Idx].Value;
end;


{  See if simple elimination of possibles yields us any solutions
   Returns True if made a change or False if no change on this pass}
Function TMainForm.SetKnownValues():Boolean;
VAR
    i, iValue:   Integer;
    bChanged:  Boolean;
begin
    bChanged  := False;
    For i := 1 To cMaxCells do begin
        If ((CountPossibles(i) = 1) and (Squares[i].Value = 0)) Then begin
            iValue := ThePossible(i); //    ' Found another answer
            UserMessage('Found Value (' + IntToStr(GetRow(i)) +','+
                                         IntToStr(GetCol(i))+')='+
                                         IntToStr(iValue));
            SetSquare(iValue,i); // Set the value (and remove more possibles)
            bChanged := True;
        end;
    end; // for i
    if bChanged then
       UserMessage('SetKnownValues: Found More ...')
    else begin
       UserMessage('SetKnownValues: No Changes this round.')
    end;
    result := bChanged;
end;


{ Count no of values that are possible for this square
  If one, we have the solution
  If zero, we have an error }
Function TMainForm.CountPossibles(idx:Integer):Integer;
Var
    i,n:  Integer;
begin
    n := 0;
    For i := 1 To ncSIZE do begin
        n := n + Squares[idx].Possibles[i];
    end;
    result := n;
end;

// return the first possible value for the given cell
Function TMainForm.ThePossible(idx:Integer):Integer;
Var
    i:  Integer;
begin
    result := 0;  // i added this line
    For i := 1 To ncSIZE do begin
       if Squares[idx].Possibles[i] = 1 then begin
          Result := i;
          Break;
       end;
    end;
end;

// Finds the nth possible value for this square (1-based)
Function TMainForm.TheNthPossible(idx, nth:Integer):Integer;
Var
    i,n,nVal:  Integer;
begin
   nVal  := 0;  // i added this line
   n     := nth;
   For i := 1 To ncSIZE do begin
      if Squares[idx].Possibles[i] = 1 then begin
         DEC(n);
         if n = 0 then begin
           nVal := i;
           Break;
         end;
      end;
   end;
   result := nVal;
end;

//  Returns zero if data is OK, else index of first error
Function TMainForm.IsDataOK():Integer;
VAR
   i: Integer;
begin
   Result := 0; //
   For i := 1 To cMaxCells do begin
      If ((Squares[i].Value > ncSIZE) OR
          (Squares[i].Value < 0)      OR
          (CountPossibles(i) <= 0))   Then begin
               Result := i;
               Break;
      end;  // if
   end; //for
end;

Function TMainForm.MissingValues():Integer;
VAR
   idx,n:  Integer;
begin
    n := 0;
    For Idx := 1 To cMaxCells do begin
        If Squares[idx].Value = 0 Then begin
           INC(n);
        End;
    end;
    result := n;
end;

// 0 if OK else index of square with problem
Function TMainForm.ReadInput():Integer;
var
    iRow, iCol, idx, iValue: Integer;
begin
    Result := 0;
    For iRow := 1 To ncSIZE do begin
        For iCol := 1 To ncSIZE do begin
//          iValue := Val(rng.Item(iRow, iCol))
            iValue := StrToIntDef(TMaskEdit(GridSudoku[GetIndex(iRow,iCol)]).Text,0);
            If iValue > 0 Then begin
//             Store given value in array
               idx := GetIndex(iRow, iCol);

//             If Not(SetSquareRC(iValue, iRow, iCol, True)) Then begin
               If Not(SetSquare(iValue,idx)) Then begin
                   UserMessage('Invalid input at (' + IntToStr(iRow) +','+
                                                      IntToStr(iCol)+')');
                   LblRC.Caption := 'Input ERR@Cell ('+IntToStr(iRow)+','+
                                                       IntToStr(iCol)+')';
                   PanelPossibleChoices.Caption  := '';
                   Result := idx;
                   exit; // Return zero ? -------------
               end;
            end;
        end;
    End;
    result := IsDataOK();
end;

Function TMainForm.GetIndex(iRow, iCol:Integer):Integer;
Begin
  // usage:GetIndex (iRow, iCol) return value of index (1..81)
    Result := (iRow - 1) * ncSIZE + iCol;
End;

Function TMainForm.GetRow(idx:Integer):Integer;
Begin
    Result := ((idx - 1) DIV ncSIZE) + 1;
End;

Function TMainForm.GetCol(idx:Integer):Integer;
Begin
    Result := ((idx - 1) MOD ncSIZE) + 1;
End;

Function TMainForm.GetBox(idx:Integer):Integer;
VAR
    nRow, nCol,nBand, nStack: Integer;
Begin
    nRow   := GetRow(idx);
    nCol   := GetCol(idx);
    nBand  := ((nRow - 1) DIV 3) + 1;
    nStack := ((nCol - 1) DIV 3) + 1;
    Result := ((nBand - 1) * 3) + nStack;
End;

Function TMainForm.InThisCol(TheValue, Idx:Integer):Boolean;
Var
    nCol, i:  Integer;
begin
    Result := False;
    nCol   := GetCol(idx);
    For i  := 1 To cMaxCells do begin
       If Squares[i].nCol = nCol then begin
          If Squares[i].Value = TheValue then begin
             result := True;
             Break;
          end;
       end;
    end;
end;

Function TMainForm.InThisRow(TheValue, Idx:Integer):Boolean;
Var
    nRow, i:  Integer;
begin
    Result := False;
    nRow   := GetRow(idx);
    For i  := 1 To cMaxCells do begin
       If Squares[i].nRow = nRow then begin
          If Squares[i].Value = TheValue then begin
             result := True;
             Break;
          end;
       end;
    end;
end;

Function TMainForm.InThisBox(TheValue, Idx:Integer):Boolean;
Var
    nBox, i:  Integer;
begin
    Result := False;
    nBox   := GetBox(idx);
    For i  := 1 To cMaxCells do begin
       If Squares[i].nBox = nBox then begin
          If Squares[i].Value = TheValue then begin
             result := True;
             Break;
          end;
       end;
    end;
end;


// Initialise the Squares matrix
Procedure TMainForm.InitPuzzle();
VAR
    iRow, iCol: Integer;
    Index: Integer;
    i: Integer;
begin
    For Index := 1 To cMaxCells do begin // Init all values
        Squares[Index].Value      := 0;
    end; //for index
    For i := 1 To ncGUESSEDMAX do begin
       Guessed[i] := 0;
    end;
    For Index := 1 To cMaxCells  do begin // Set all possibles to 1 someday to true;
       For i := 1 To ncSIZE do begin
           Squares[Index].Possibles[i] := 1;
       end;
    end;
    mnGuessLevel := 0;  //    Set global guess level
    mnDifficulty := 0;

{    Initialise the row, col and box numbers
     to speed up lookups
     (These could be done with constants, but this is easier)
     Stored row x column, base-1 }
    For iCol := 1 To ncSIZE do begin
       For iRow := 1 To ncSIZE do begin
           Index := GetIndex(iRow, iCol);
           Squares[Index].nRow := iRow;
           Squares[Index].nCol := iCol;
       end;
    end;
    // Set box numbers 1..9
    // (there's surely a simpler algorithm but this works...)
    For iRow := 1 To 3 do begin
       For iCol := 1 To 3 do begin
           Index := GetIndex(iRow, iCol);
           Squares[Index].nBox := 1;
       end;
       For iCol := 4 To 6 do begin
           Index := GetIndex(iRow, iCol);
           Squares[Index].nBox := 2;
       end;
       For iCol := 7 To 9 do begin
           Index := GetIndex(iRow, iCol);
           Squares[Index].nBox := 3;
       end;
    end;
    For iRow := 4 To 6 do begin
       For iCol := 1 To 3 do begin
           Index := GetIndex(iRow, iCol);
           Squares[Index].nBox := 4;
       end;
       For iCol := 4 To 6 do begin
           Index := GetIndex(iRow, iCol);
           Squares[Index].nBox := 5;
       end;
       For iCol := 7 To 9 do begin
           Index := GetIndex(iRow, iCol);
           Squares[Index].nBox := 6;
       end;
    end;
    For iRow := 7 To 9 do begin
       For iCol := 1 To 3 do begin
           Index := GetIndex(iRow, iCol);
           Squares[Index].nBox := 7;
       end;