Игра Судоку (PascalABC.net)

{$apptype windows} //запуск .exe файла без открытия окна консоли
uses WPFObjects;

const w = 76; //сторона квадрата
  Bit: array of integer = (0,1,2,4,8,16,32,64,128,256); //xor для доп.цифр подсказок
  Color: array of System.Windows.Media.Color = (Colors.Black, Colors.Lavender, 
  Colors.AntiqueWhite, Colors.DarkBlue,Colors.Khaki, ARGB(0,100,100,100), ARGB(80,100,100,100));

var
   //a[z].tag=true ячейка я[z] заблокирована на изменение, содержит загаданное, неизменное число
   a := new SquareWPF[81]; //массив загаданных и установленных чисел
   //a2[z].tag = 9 битов перключателей отображать или нет в подсказке числа 1..9
   a2 := new SquareWPF[81]; //массив с битами дополнительных чисел подсказок
   button := new SquareWPF[10]; //массив кнопок под полем
   button2 := new SquareWPF[10]; //массив кнопок под полем
   vib,vib2, //квадрат подстветки выбранной ячейки на поле для изменений
   dop,dop2, //дополнительные цифры изменяются или основные (правая нижняя кнопка)
   srazy, //кнопка "сразу вводимть цифру на поле\выбирать внизу
   del, newgame, win,levelb : SquareWPF;// кнопки вокруг поля
   grids := new integer[81]; //массив сгенерированного поля чисел
   otkrito, //количество открытых чисел
   Solve: integer; //количество возможных решений поля
   levels: integer := 1; //уровень сложности (количество попыток случайного удаления цифр с поля)
   alarm := |0,0,0|;//индекс клеткок в которых уже есть недопустимая вводимая цифра
   
 //Проверка на валидность числа в заданной ячейке
function CheckValidity(grid: array of integer; val: Integer; x: Integer; y: Integer): Boolean;
  begin
    for var i := 0 to 8 do 
      if (Grid[y * 9 + i] = val) or (Grid = val) then //не единственное в строке или столбце?
        begin Result := False; Exit end;
    for var i := (y div 3) * 3 to (y div 3) * 3 + 2 do
      for var j := (x div 3)*3 to (x div 3)*3 + 2 do
        if Grid = val then //не единственное в квадрате 3х3?
          begin Result := False; Exit end;
    Result := True;
 end;

//Поиск решений загаданного поля
//заполняем нулевые клетки перебирая все варианты, подсчет кол-ва вариантвов полей, выход
Procedure PlaceNumber(grid: array of integer; pos: Integer := 0);
begin
  if Pos = 81 then begin Solve += 1; Exit end;
  if Grid[pos] > 0 then begin PlaceNumber(grid, pos+1); Exit end;
  for var number := 1 to 9 do
    if CheckValidity(grid, number, pos mod 9, pos div 9) then begin
       Grid[pos] := number;
       PlaceNumber(grid, pos+1);
       Grid[pos] := 0;
    end;
end;

//Генератор нового поля
function PlaceNumberGen(grid: array of integer; pos: Integer := 0): Boolean;
begin
  if Pos = 81 then begin Result := True; Exit end;
  foreach var number in Arr(1..9).shuffle do
    if CheckValidity(grid, number, pos mod 9, pos div 9) then begin
       Grid[pos] := number;
       Result := PlaceNumberGen(grid, pos+1);
       if not Result then Grid[pos] := 0;
    end;
end;

Procedure PoleInit;
 begin
  PlaceNumberGen(grids); //Генерируем случайное поле-массив grids;

  //удаляем с игрового поля-массива grids числа рандомно 
  solve := 0;
  var time := Milliseconds; //удаляем числа не более 3 секунд
  var level := |1,4,9,16|[levels-1];
  while solve < 2 do begin
    solve := 0;  //количество решений при удалении очередного числа
    var ind := random(81); //индекс удаляемого числа
    var cDel := grids[ind]; //запоминаем убираемое с поля число, чтобы вернуть его потом
    grids[ind] := 0; //скрываем число с поля
    PlaceNumber(grids); //генерируем все возможные решения
    if solve > 1 then begin //если решений более одного, то 
      grids[ind] := cDel; //возвращаем последнее убранное число на место
      level -= 1; //колво попыток -1 
      if (level > 0) and (Milliseconds-time < 5000) then solve := 0;  //пробовать убрать другое число level раз
    end;
  end;

  foreach var z in grids.Indices(t-> t<>0) do begin //отмечаем оставшиеся заданные числа
      otkrito += 1;
      a[z].Tag  := true; //блокировать загаданное 
      a[z].Number := grids[z];
      a[z].Color := Color[1];
      button2[grids[z]].Number := button2[grids[z]].Number-1; 
  end;
end; 

//нажата кнопка НОВАЯ ИГРА
Procedure NewGameInit;
begin 
   for var z := 0 to 80 do begin
      grids[z] := 0;  a[z].Text := '';  a[z].Tag := false;  a[z].Color := EmptyColor;
      a2[z].Tag := 0; a2[z].Text := '     '#13#10'     '#13#10'     ';  
   end;
   for var zz := 1 to 9 do 
     begin button[zz].Color := Color[1]; button2[zz].Color := Color[5]; button2[zz].Number := 9; end;  
  otkrito := 0; win.Visible := false;vib.Visible := false;
  PoleInit;
end;

Procedure ColorX(digit:integer);
begin
   for var z := 0 to 80 do 
       if (digit<>0) and ((grids[z]=digit) or ((integer(a2[z].Tag) and Bit[digit]) <> 0)) then 
         a[z].Color := if boolean(a[z].Tag) then Color[4] else Color[2]
       else a[z].Color := if boolean(a[z].Tag) then Color[1] else EmptyColor;
   for var z := 1 to 9 do button[z].Color := z=digit ? Color[2] : Color[1];    
   if alarm.sum <>0 then foreach var d in alarm do if d>0 then 
     begin a[d].BorderColor := Colors.Red; a[d].BorderWidth := 5; end;
end;

Procedure Dopik(vibor,cifra: integer;del:boolean);
begin
    if (integer(a2[vibor].Tag) and Bit[cifra] = 0) and del then exit;
    var txt := a2[vibor].Text; 
    var ind := cifra*2 + (cifra*2-2) div 6 - 1;
    txt[ind] := ((integer(a2[vibor].Tag) and Bit[cifra]) <> 0) ? #32 : char(48+cifra);
    a2[vibor].Text := txt; a2[vibor].Tag := integer(a2[vibor].Tag) xor Bit[cifra];
end;

Function Check(grid: array of integer; val: Integer; x: Integer; y: Integer):boolean;
  begin
    for var i := 0 to 8 do //не единственное в строке или столбце?
      if (Grid[y * 9 + i] = val) then alarm[0] := y * 9 + i
      else if (Grid = val) then alarm[1] := i * 9 + x;
    for var i := (y div 3) * 3 to (y div 3) * 3 + 2 do
      for var j := (x div 3)*3 to (x div 3)*3 + 2 do
        if Grid = val then alarm[2] := i * 9 + j;//не единственное в квадрате 3х3?
  if alarm.Sum=0 then begin
    Result := true;
    if Result then begin
      for var i := 0 to 8 do begin //удалить доп.цифры в строке или столбце?
        Dopik(y * 9 + i,val,true); Dopik(i * 9 + x,val,true); end;
      for var i := (y div 3) * 3 to (y div 3) * 3 + 2 do
        for var j := (x div 3)*3 to (x div 3)*3 + 2 do
          Dopik(i * 9 + j,val,true);//удалить допик в квадрате 3х3?
    end;
  end;
end;

//подсветка клеток с текущей цифрой
Procedure Okno(digit: integer); 
begin
  var vibor := integer(vib.tag);
  if (grids[vibor] <> 0) then begin ColorX(0); exit; end;
  if boolean(dop.tag) then Dopik(vibor,integer(vib2.Tag),false)
  else 
    if Check(grids, integer(vib2.Tag), vibor mod 9, vibor div 9) then begin 
       grids[vibor] := integer(vib2.Tag); a[vibor].Number := Integer(vib2.tag);
       a2[vibor].Text :=  '     '#13#10'     '#13#10'     '; a2[vibor].Tag := 0;
       button2[integer(vib2.Tag)].Number := button2[integer(vib2.Tag)].Number - 1;
       if button2[integer(vib2.Tag)].Number = 0 then button2[integer(vib2.Tag)].Color := Color[6];
       otkrito += 1; if otkrito=81 then win.Visible := true;
    end;
  ColorX(digit);
end;

Procedure MouseDown(x,y: real; b: integer);
begin
   if alarm.sum<>0 then begin
     foreach var d in alarm do if d>0 then begin a[d].BorderColor := Color[0]; a[d].BorderWidth := 1; end;
     alarm := |0,0,0|;     
  end;
  if (x in 9.5*w..w*10.5) and (y in 10..w+10) then begin //нажата НОВАЯ ИГРА
     Redraw(() -> begin NewGameInit end); exit;end;  
  if (x in 9.5*w..w*10.5) and (y in 10+1.3*w..w*2+9) then//нажата кнопка levelb вверх
     if levels < 4 then begin levels += 1; levelb.Number := levels; ColorX(0); end;
   if (x in 9.5*w..w*10.5) and (y in 10+2*w..w*2.7+10) then//нажата кнопка levelb вниз
     if levels > 1 then begin levels -= 1; levelb.Number := levels; ColorX(0); end;   
  
  if (x in 10..9+9*w) and (y in 10..9+9*w) then begin //нажато окно на поле
    var z := trunc((y-10)/w)*9 + trunc((x-10)/w);
    vib.MoveTo(a[z].LeftTop.X.trunc - 2, a[z].LeftTop.Y.trunc-2); vib.tag := z;  vib.Visible := true; 
    if (grids[z] =0) and boolean(srazy.Tag) then begin Okno(grids[z]); Colorx(integer(vib2.Tag)) end;
    if (grids[z] =0) and not boolean(srazy.Tag) then Colorx(integer(vib2.Tag));
    if (grids[z]<>0) then ColorX(grids[z]);
  end;
  
  if (x in 10..9+9*w) and (y in w*9.5..w*9.5+w) then begin//нажато цифра под полем
    var z := trunc((x-10)/w)+1;
    vib2.MoveTo(8+w*(z-1), 9.5*w-2); vib2.Tag := z;
    button[z].Color := Color[2];
    if not boolean(srazy.Tag) then Okno(z);
    ColorX(z);
 end;
 
  if (x in 9.5*w..w*10.5) and (y in 9.5*w..w*10.5) then//нажато 'ввод основных\дополнительных'
    if boolean(dop.Tag) then 
      begin dop.FontColor := Color[0]; dop2.FontColor := EmptyColor; dop.Tag := false end
    else begin dop.FontColor := EmptyColor;  dop2.FontColor := Color[0]; dop.Tag := true end;
//10+w*z-w, w*9.5, w, Color[1], 1,Color[0]);    

  if (x in 9.5*w..w*10.5) and (y in 10+8*w..w*9+10) then//нажата кнопка СРАЗУ 
    if boolean(srazy.Tag) then begin srazy.Tag := false; srazy.Text := '/' end
    else begin srazy.Tag := true; srazy.Text := '=' end;
     
  if win.Visible = true then exit;

  if (x in 9.5*w..w*10.5) and (y in 10+6.5*w..w*7.5+10) then//нажата кнопка del
    if not boolean(a[integer(vib.tag)].Tag) then begin
      var ind := integer(vib.tag);
      if grids[ind] <> 0 then begin
          if button2[grids[ind]].Number = 0 then button2[grids[ind]].Color := Color[5];
          button2[grids[ind]].Number := button2[grids[ind]].Number + 1; otkrito -= 1;
      end;
      ColorX(0); grids[ind] := 0; a[ind].Text := ''; a2[ind].Text :=  '     '#13#10'     '#13#10'     ';  
      a2[ind].Tag := 0; a[ind].Color := EmptyColor;
   end;
end;

Procedure Init;
begin  
  for var z := 0 to 80 do begin
      var (x,y) := (z div 9, z mod 9);
      a[z] := new SquareWPF(10+y*w,10+x*w,w, EmptyColor, 0.5,Color[0]);
      a[z].FontSize := 3*w div 5; a[z].Tag := false;
      a2[z] := new SquareWPF(10+y*w+w div 16,10+x*w+w div 16,w-2*w div 16, EmptyColor);
      a2[z].TextAlignment := Alignment.CenterTop; a2[z].FontName := 'Courier New';
      a2[z].FontSize := w * 28 div 100; a2[z].Text :=  '     '#13#10'     '#13#10'     '; a2[z].Tag := 0;
   end;
  for var x := 0 to 3 do begin
    var gor:= new LineWPF(10+x*3*w,10,10+x*3*w,10+w*9,Color[0]); gor.SetLineWidth(3);
    var ver:= new LineWPF(10,10+x*3*w,10+w*9,10+x*3*w,Color[0]); ver.SetLineWidth(3);
  end;

  vib := new SquareWPF(8,8,w+4, EmptyColor,5,Color[3]); //выделение ячейки на поле (выбор)
  vib.Visible := false; vib.Tag := integer(0);

  
  for var z := 1 to 9 do begin
    button[z] := new SquareWPF(10+w*z-w, w*9.5, w, Color[1], 1,Color[0]);
    button[z].FontSize := 3*w div 5; button[z].Number := z;
    button2[z] := new SquareWPF(10+w*z-w+3, w*9.5+3, w-6, Color[1], 1,Color[0]);
    button2[z].BorderColor := EmptyColor; button2[z].FontSize := w * 28 div 100;
    button2[z].TextAlignment := Alignment.RightBottom; button2[z].Color := Color[5];
    button2[z].Number := 9;
  end;
  
  vib2 := new SquareWPF(8,9.5*w-2,w+4, EmptyColor,5,Color[3]); //выделение ячейки под полем)
  vib2.Tag := 1;

   dop := new SquareWPF(w*9.5, w*9.5, w, Color[1], 1,Color[0]);
   dop.FontSize := 3*w div 5; dop.Tag := false; dop.Text := '1-9';
   dop2 := new SquareWPF(w*9.5,w*9.5+w div 16,w, EmptyColor);
   dop2.TextAlignment := Alignment.CenterTop; dop2.FontName := 'Courier New';
   dop2.FontColor := EmptyColor; dop2.FontSize := w * 28 div 100;
   dop2.Text :=  '1 2 3'#13#10'4 5 6'#13#10'7 8 9';  
   
   srazy := new SquareWPF(w*9.5, 10+8*w, w, Color[1], 1,Color[0]);
   srazy.FontSize := 3*w div 5; srazy.Tag := true; srazy.Text := '=';
   
   del := new SquareWPF(w*9.5, 10+6.5*w, w, Color[1], 1,Color[0]);
   del.FontSize := 3*w div 5; del.Text := 'del';

  newgame := new SquareWPF(w*9.5,10,w,Color[1],1,Color[0]); //кнопка Новая Игра
  newgame.Text := 'НОВАЯ'#13#10'  ИГРА'; newgame.FontSize := w div 4; 

  var levelsq := new SquareWPF(w*9.5,10+1.5*w,w,Color[1],1,Color[0]); //кнопка УРОВЕНЬ СЛОЖНОСТИ
  levelsq.RotateAngle := 45;
  levelb := new SquareWPF(w*9.5,10+1.5*w,w,EmptyColor,0,EmptyColor); //цифра уровеня
  levelb.FontSize := 3*w div 5; levelb.number := levels;
  
  win := new SquareWPF(w*9.5,w*3+10,w,Colors.White);//слово ПОБЕДА
  win.Text := 'ПОБЕДА'; win.FontSize := w div 4; win.FontColor := Colors.Red; win.Visible := false; 
end;

begin
  Window.SetSize(w*11,w*11);
  Window.CenterOnScreen;
  Window.Caption := 'СУДОКУ';
  Redraw(() -> begin Init; PoleInit end);
  OnMouseDown += MouseDown;
end.