Pascal/Turbo Pascal - ayuda con programa

{Mira esto te ayudara tienes todas las funciones y procedimientos necesarios para terminarlo suerte }

program sudoku;

 uses

   crt, dos;

 type

    sudoku_reg = record

          dificultac : integer;

          matriz : array[1..9,1..9] of integer;

           guego :  array[1..9,1..9] of integer;

         partida : array[1..9,1..9] of integer;

       end;

      archiv = record

               nom : array [1..120] of string[12];

              end;

     var

     cierto : array[1..9,1..9] of integer;

     dific, xpx, ypy, xpp, ypp, crear : integer;

     z3, cu1, z1, z2, l1, l2, con1, nn : integer;

     inx, iny, xk, yk, x, y, xx, yy : integer;

     tecla : char;

     archivos : archiv;

     dirinfo : searchrec;

     si, para, cagado, sudok : boolean;

     nombar : string;

     sudoku : sudoku_reg;

     f : file of sudoku_reg;

     linea, columna, i, j, cpt : integer;

     columna0, linea0 : integer;

     xp, yp, pl1, pl2 : integer;

     s, sav ,res : array[1..9,1..9] of integer;

     init : array [1..9,1..9] of boolean;

     fin, impossible : boolean;

     compteur, vide ,cpt1 : integer;

     d, u : integer;

     tepu, c, quit : char;

     sal, suite, appel : boolean;

     sm : string;

     fecha : string[8];

     difi_cul : string[18];

     iy, ix : integer;

     prueba : array[1..9,1..9] of char;

     origen : Integer;

     regs : registers;

     raton : boolean;

     pulsado : integer;

   procedure posicionnum(xw, yw : integer; var p1, p2 : integer);

   begin

      case yw of

    13 : begin

         p2 := 1;

         case xw of

       30 : p1 := 1;

       32 : p1 := 2;

       34 : p1 := 3;

       37 : p1 := 4;

       39 : p1 := 5;

       41 : p1 := 6;

       44 : p1 := 7;

       46 : p1 := 8;

       48 : p1 := 9;

         end;

       end;

    15 : begin

         p2 := 2;

         case xw of

       30 : p1 := 1;

       32 : p1 := 2;

       34 : p1 := 3;

       37 : p1 := 4;

       39 : p1 := 5;

       41 : p1 := 6;

       44 : p1 := 7;

       46 : p1 := 8;

       48 : p1 := 9;

         end;

       end;

    17 : begin

         p2 := 3;

         case xw of

       30 : p1 := 1;

       32 : p1 := 2;

       34 : p1 := 3;

       37 : p1 := 4;

       39 : p1 := 5;

       41 : p1 := 6;

       44 : p1 := 7;

       46 : p1 := 8;

       48 : p1 := 9;

         end;

       end;

    20 : begin

         p2 := 4;

         case xw of

       30 : p1 := 1;

       32 : p1 := 2;

       34 : p1 := 3;

       37 : p1 := 4;

       39 : p1 := 5;

       41 : p1 := 6;

       44 : p1 := 7;

       46 : p1 := 8;

       48 : p1 := 9;

         end;

       end;

    22 : begin

         p2 := 5;

         case xw of

       30 : p1 := 1;

       32 : p1 := 2;

       34 : p1 := 3;

       37 : p1 := 4;

       39 : p1 := 5;

       41 : p1 := 6;

       44 : p1 := 7;

       46 : p1 := 8;

       48 : p1 := 9;

         end;

       end;

    24 : begin

         p2 := 6;

         case xw of

       30 : p1 := 1;

       32 : p1 := 2;

       34 : p1 := 3;

       37 : p1 := 4;

       39 : p1 := 5;

       41 : p1 := 6;

       44 : p1 := 7;

       46 : p1 := 8;

       48 : p1 := 9;

         end;

       end;

    27 : begin

         p2 := 7;

         case xw of

       30 : p1 := 1;

       32 : p1 := 2;

       34 : p1 := 3;

       37 : p1 := 4;

       39 : p1 := 5;

       41 : p1 := 6;

       44 : p1 := 7;

       46 : p1 := 8;

       48 : p1 := 9;

         end;

       end;

    29 : begin

         p2 := 8;

         case xw of

       30 : p1 := 1;

       32 : p1 := 2;

       34 : p1 := 3;

       37 : p1 := 4;

       39 : p1 := 5;

       41 : p1 := 6;

       44 : p1 := 7;

       46 : p1 := 8;

       48 : p1 := 9;

         end;

       end;

    31 : begin

         p2 := 9;

         case xw of

       30 : p1 := 1;

       32 : p1 := 2;

       34 : p1 := 3;

       37 : p1 := 4;

       39 : p1 := 5;

       41 : p1 := 6;

       44 : p1 := 7;

       46 : p1 := 8;

       48 : p1 := 9;

         end;

       end;

    end;

   end;

   procedure cuadro(x3, y3, x4, y4 : integer);

   var

     xx, yy : integer;

     begin

        gotoxy(x3,y3);write('Ú');

        for xx := x3 + 1 to x4 - 1 do

        begin

        gotoxy(xx,y3);write('Ä');

        gotoxy(xx,y4);write('Ä');

        end;

        gotoxy(x4,y3);write('¿');

        gotoxy(x3,y4);write('À');

        gotoxy(x4,y4);write('Ù');

        for yy := y3 + 1 to y4 - 1 do

        begin

           gotoxy(x3,yy);write('³');

           gotoxy(x4,yy);write('³');

        end;

     end;

   procedure cuadros9(x9, y9 : integer);

   begin

         gotoxy(x9,y9);write('ÚÄÂÄÂÄÂÂÄÂÄÂÄÂÂÄÂÄÂÄ¿');

     gotoxy(x9,y9 + 1);write('³ ³ ³ ³³ ³ ³ ³³ ³ ³ ³');

     gotoxy(x9,y9 + 2);write('ÃÄÅÄÅÄ´ÃÄÅÄÅÄ´ÃÄÅÄÅÄ´');

     gotoxy(x9,y9 + 3);write('³ ³ ³ ³³ ³ ³ ³³ ³ ³ ³');

     gotoxy(x9,y9 + 4);write('ÃÄÅÄÅÄ´ÃÄÅÄÅÄ´ÃÄÅÄÅÄ´');

     gotoxy(x9,y9 + 5);write('³ ³ ³ ³³ ³ ³ ³³ ³ ³ ³');

     gotoxy(x9,y9 + 6);write('ÃÄÁÄÁÄ´ÃÄÁÄÁÄ´ÃÄÁÄÁÄ´');

     gotoxy(x9,y9 + 7);write('ÃÄÂÄÂÄ´ÃÄÂÄÂÄ´ÃÄÂÄÂÄ´');

     gotoxy(x9,y9 + 8);write('³ ³ ³ ³³ ³ ³ ³³ ³ ³ ³');

     gotoxy(x9,y9 + 9);write('ÃÄÅÄÅÄ´ÃÄÅÄÅÄ´ÃÄÅÄÅÄ´');

    gotoxy(x9,y9 + 10);write('³ ³ ³ ³³ ³ ³ ³³ ³ ³ ³');

    gotoxy(x9,y9 + 11);write('ÃÄÅÄÅÄ´ÃÄÅÄÅÄ´ÃÄÅÄÅÄ´');

    gotoxy(x9,y9 + 12);write('³ ³ ³ ³³ ³ ³ ³³ ³ ³ ³');

    gotoxy(x9,y9 + 13);write('ÃÄÁÄÁÄ´ÃÄÁÄÁÄ´ÃÄÁÄÁÄ´');

    gotoxy(x9,y9 + 14);write('ÃÄÂÄÂÄ´ÃÄÂÄÂÄ´ÃÄÂÄÂÄ´');

    gotoxy(x9,y9 + 15);write('³ ³ ³ ³³ ³ ³ ³³ ³ ³ ³');

    gotoxy(x9,y9 + 16);write('ÃÄÅÄÅÄ´ÃÄÅÄÅÄ´ÃÄÅÄÅÄ´');

    gotoxy(x9,y9 + 17);write('³ ³ ³ ³³ ³ ³ ³³ ³ ³ ³');

    gotoxy(x9,y9 + 18);write('ÃÄÅÄÅÄ´ÃÄÅÄÅÄ´ÃÄÅÄÅÄ´');

    gotoxy(x9,y9 + 19);write('³ ³ ³ ³³ ³ ³ ³³ ³ ³ ³');

    gotoxy(x9,y9 + 20);write('ÀÄÁÄÁÄÁÁÄÁÄÁÄÁÁÄÁÄÁÄÙ');

   end;

  function raton_presente : boolean;

  begin

      regs.ah := $00;

      regs.al := $00;

      intr($33,regs);

      if regs.ax <> 0 then

      raton_presente := true

    else

      raton_presente := false;

  end;

  procedure muestra_raton;

  begin

      raton := false;

      if raton_presente then

      begin

          regs.ah := $00;

          regs.al := $01;

          intr($33,regs);

          raton := true;

      end;

  end;

  procedure oculta_raton;

  begin

      if raton = true then

      begin

         regs.ah := $00;

         regs.al := $02;

         intr($33,regs);

         raton := false;

       end;

  end;

  function posx_raton : word;

  begin

      posx_raton := 0;

      regs.ah := $00;

      regs.al := $03;

      intr($33,regs);

      posx_raton := regs.cx div 8 + 1;

  end;

  function posy_raton : word;

  begin

      posy_raton := 0;

      regs.ah := $00;

      regs.al := $03;

      intr($33,regs);

      posy_raton := regs.dx div 8 + 1;

  end;

  function boton_raton : word;

  begin

      boton_raton := 0;

      regs.ah := $00;

      regs.al := $03;

      intr($33,regs);

      boton_raton := regs.bx

  end;

  procedure pon_posicion_raton(xp, yp : word);

  begin

      regs.ah := $00;

      regs.al := $04;

      regs.cx := xp;

      regs.dx := yp;

      intr($33,regs);

  end;

   function worstring(xe : word) : string;

   var

      s : string;

   begin

      fillchar(s,9,' ');

      s[0] := chr(8);

      str(xe,s);

      worstring := copy(s,1,length(s));

   end;

   function charinteger(dh : char) : integer;

   var

      da : string[8];

      ine, ouo : integer;

   begin

       charinteger := 0;

       da[0] := chr(1);

       da[1] := dh;

       val(da,ine,ouo);

       charinteger := ine;

   end;

   function fecha_hors : string;

   var

      y, m, d, dow : Word;

      h, m1, s, hund : Word;

      dato : string;

      mas : string;

   begin

        fecha_hors := ' ';

        GetDate(y,m,d,dow);

        dato := worstring(d) + worstring(m);

        GetTime(h,m1,s,hund);

        mas := worstring(m) + worstring(s);

        fecha_hors := dato + mas;

   end;

   function intstring(xe : integer) : string;

   var

      s : string;

   begin

      fillchar(s,9,' ');

      s[0] := chr(8);

      str(xe,s);

      intstring := copy(s,1,length(s));

   end;

   function wordchar(nd : word) : char;

   var

     s : string[8];

   begin

      str(nd,s);

      wordchar := s[1];

   end;

   function integerchar(nk : integer) : char;

   var

     s : string[8];

   begin

      str(nk,s);

      integerchar := s[1];

   end;

   function comprueva_linea(li : integer) : boolean;

   var

      t : array [0..9] of integer;

      j : integer;

   begin

      for j := 1 to 9 do

      t[j] := 0;

        for j := 1 to 9 do

        t[s[li,j]] := t[s[li,j]] + 1;

        comprueva_linea := true;

       for j := 1 to 9 do

        if t[j] > 1 then

        comprueva_linea := false;

      end;

  function comprueva_columna(co : integer) : boolean;

  var

  t : array [0..9] of integer;

  j : integer;

  begin

     for j := 1 to 9 do

     t[j] := 0;

      for j := 1 to 9 do

      t[s[j,co]] := t[s[j,co]] + 1;

      comprueva_columna := true;

     for j := 1 to 9 do

      if t[j] > 1 then

       comprueva_columna := false;

   end;

  function comprueva_linea_columna(li, co : integer) : boolean;

  var

     t : array [0..9] of integer;

     ch, cv, j  : integer;

    begin

    cv := (li - 1) div 3;

    ch := (co - 1) div 3;

    for j := 1 to 9 do

    t[j] := 0;

    for co := 1 to 3 do

     for li := 1 to 3 do

     t[s[li + cv * 3,co + ch * 3]] := t[s[li + cv * 3,co + ch * 3]] + 1;

     comprueva_linea_columna := true;

    for j := 1 to 9 do

     if t[j] > 1 then

     comprueva_linea_columna := false;

  end;

   function avanzar : boolean;

   var

      t: boolean;

    begin

       if columna = 9 then

       begin

         linea := linea + 1;

         columna := 1;

    end

  else

     columna := columna + 1;

     if linea = 10 then

     t := false

   else

     t := true;

     avanzar := t;

   if init[linea,columna] and t then

   avanzar := avanzar;

 end;

  function retroceder : boolean;

  var

     t : boolean;

     begin

      if columna = 1 then

      begin

         linea := linea - 1;

         columna := 9;

     end

   else

      columna := columna - 1;

      if linea = 0 then

      begin

         t := false;

    end

  else

     t := true;

     retroceder := t;

     if init[linea,columna] and t then

     retroceder := retroceder;

  end;

  function datos_correctos : boolean;

  begin

      fin := false;

      impossible := false;

	while not fin and not impossible do

        begin

         if s[linea,columna] < 9 then

        begin

    repeat

        s[linea,columna] := s[linea,columna] + 1;

    until (comprueva_linea(linea) and comprueva_columna(columna)

     and comprueva_linea_columna(linea,columna)) or (s[linea,columna] = 10);

       if s[linea,columna] < 10 then

       fin := not avanzar;

     end

   else

      begin

         s[linea,columna] := 0;

         impossible := not retroceder;

    end;

  end;

    if fin then

    datos_correctos := true;

     if impossible then

     datos_correctos := false;

  end;

{Parte 2}

  function confirma : boolean;

   var

     t : boolean;

  begin

      t := true;

      for linea := 1 to 9 do

        for columna := 1 to 9 do

        begin

          t := t and comprueva_linea(linea);

          t := t and comprueva_columna(columna);

          t := t and comprueva_linea_columna(linea,columna);

     end;

       confirma := t;

  end;

  procedure genera_sudoku(dific : integer);

   var

    dificultad : integer;

   begin

      randomize;

   case dific of

  0 : dificultad := 10;

  1 : dificultad := 20;

  2 : dificultad := 30;

  3 : dificultad := 35;

   end;

  if dificultad in[30,35] then

  begin

   repeat

       repeat

        for linea := 1 to 9 do

           for columna := 1 to 9 do

           begin

              s[linea,columna] := 0;

              init[linea,columna] := false;

           end;

        for i := 1 to 10 do

        begin

          linea := random(9) + 1;

          columna := random(9) + 1;

          s[linea,columna] := random(9) + 1;

          init[linea,columna] := true;

       end;

   until confirma;

   linea := 0;

   columna := 9;

   avanzar;

   until datos_correctos;

   for i:=1 to 9do

      for j:=1 to 9 do

      begin

          sav[i,j] := s[i,j];

          init[i,j] := true;

    end;

     for i := 1 to 9 do

       for j := 1 to 9 do

    begin

       sudoku.matriz[i,j] := s[i,j];

       sudoku.guego[i,j] := s[i,j];

    end;

	cpt:=0;

    while cpt < dificultad do

    begin

       i := random(9) + 1;

       j := random(9) + 1;

       if s[i,j] <> 0 then

       begin

          s[i,j] := 0;

          init[i,j] := false;

          cpt := cpt + 1;

          s[10 - i,10 - j] := 0;

          init[10 - i,10 - j] := false;

          d := s[i,j];

          if d = 0 then

          sudoku.guego[i,j] := 0;

     end;

   end;

      for i := 1 to 9 do

       for j := 1 to 9 do

        if s[i,j] = 0 then

         res[i,j] := sav[i,j]

   else

       res[i,j] := 0;

     end

   else

      begin

          crear := 0;

      end;

  end;

  procedure continua_sudoku;

   var

    h, b, dificultad : integer;

   begin

      randomize;

   repeat

       repeat

        for linea := 1 to 9 do

           for columna := 1 to 9 do

           begin

              s[linea,columna] := 0;

              init[linea,columna] := false;

      end;

        for h := 1 to 9 do

           for b := 1 to 9 do

           begin

              s[h,b] := sudoku.guego[h,b];

           end;

        for i := 1 to 10 do

        begin

          linea := random(9) + 1;

          columna := random(9) + 1;

          if s[linea,columna] = 0 then

          begin

          s[linea,columna] := random(9) + 1;

          init[linea,columna] := true;

          end

        else

           begin

             s[linea,columna] := sudoku.guego[linea,columna];

             init[linea,columna] := true;

          end;

       end;

   until confirma;

   linea := 0;

   columna := 9;

   avanzar;

   until datos_correctos;

   for i := 1 to 9 do

      for j:=1 to 9 do

      begin

          sav[i,j] := s[i,j];

          init[i,j] := true;

    end;

     for i := 1 to 9 do

       for j := 1 to 9 do

    begin

       u := s[i,j];

       if u = 0 then

       begin

          sudoku.matriz[i,j] := 0;

       end

     else

       begin

          sudoku.matriz[i,j] := u;

       end;

    end;

      for i := 1 to 9 do

       for j := 1 to 9 do

        if s[i,j] = 0 then

         res[i,j] := sav[i,j]

   else

       res[i,j] := 0;

  end;

   procedure termina_sudoku(ds : sudoku_reg);

   var

      cont, z, v : integer;

   begin

        textcolor(15);

        continua_sudoku;

        for z := 1 to 9 do

         for v := 1 to 9 do

         begin

            ds.guego[z,v] := sudoku.matriz[z,v];

         end;

       for z := 1 to 9 do

         for v := 1 to 9 do

         begin

             sudoku.guego[z,v] := 0;

         end;

       cont := 1;

       randomize;

    repeat

       z := random(9) + 1;

       v := random(9) + 1;

       sudoku.guego[z,v] :=  sudoku.matriz[z,v];

      inc(cont);

    until cont > dific;

   end;

  procedure patalla_inicio;

  begin

     clrscr;

     iny := 1;

     para := false;

     cuadro(1,1,79,3);

     cuadro(1,4,79,6);

     gotoxy(32,2);write('****** SUDOKU ******');

     gotoxy(2,5);write('        [CARGAR]   [SEGIR P.]  [CREAR]',

                                  '   [SUDOKU AUTOMATICO]   [SALIR]');

     gotoxy(29,48);write('ELIJA OPCION CON EL MOUSE');

     cuadros9(29,12);

     genera_sudoku(1);

  end;

  procedure borra(xx,yy,xxx : integer);

  var

   v : integer;

  begin

      for v := xx to xxx do

      begin

         gotoxy(v,yy);write(' ');

      end;

  end;

  procedure rellana_sudok(xa, ya : integer);

  var

    b, c, a1, a2 : integer;

    begin

      c := 0;

      b := 0;

      for a1 := 1 to 9 do

      begin

       for a2 := 1 to 9 do

       begin

          if s[a1,a2] <> 0 then

          begin

          gotoxy(xa + (a2 * 2) + b,ya + (a1 * 2) + c);write(s[a1,a2]);

          end;

          if a2 = 3 then

          b := 1;

          if a2 = 6 then

          b := 2;

       end;

        if a1 = 3 then

        c := 1;

        if a1 = 6 then

        c := 2;

        b := 0;

      end;

    end;

    procedure cargasudoku;

    begin

    end;

    function soluccion : boolean;

   var

      oke : array[1..9,1..9] of integer;

      rx, ry : integer;

   begin

       soluccion := false;

       for ry := 1 to 9 do

          for rx := 1 to 9 do

          oke[rx,ry] := 2;

     for ry := 1 to 9 do

       for rx := 1 to 9 do

       begin

          if sudoku.guego[rx,ry] <> sudoku.matriz[rx,ry] then

          oke[rx,ry] := 1

        else

          oke[rx,ry] := 0;

       end;

       ry := 1;

     repeat

       rx := 1;

       repeat

           if oke[rx,ry]  = 0 then

           begin

           end;

       rx := rx + 1;

       until (rx > 9) or (oke[rx,ry] = 1);

      ry := ry + 1;

     until (ry > 9) or (oke[rx,ry] = 1);

     if ry > 9 then

     soluccion := true

    else

     soluccion := false;

   end;

  begin

     origen := lastmode;

     TextMode(c80 + Font8x8);

     patalla_inicio;

     if raton_presente then

     begin

        muestra_raton;

        ix := posx_raton;

        iy := posy_raton;

        sal := false;

      repeat

         if (ix <> posx_raton) or (iy <> posy_raton) then

         begin

           ix := posx_raton;

           iy := posy_raton;

         end;

       if boton_raton = 1 then

       begin

         case iy of

      5 : begin

            case ix of

         11..17 : begin

                    sudok := false;

                    cargasudoku;

                    if sudok = true then

                    begin

                      genera_sudoku(2);

                    if soluccion = true then

                    begin

                    end;

                  end;

                end;

         21..30 :;

         33..39 :;

         43..61 : begin

                  gotoxy(44,8);write('Dificultad 0,1,2,3 : ');

                  readln(dific);

                  gotoxy(44,8);clreol;

                  genera_sudoku(dific);

                  rellana_sudok(28,11);

                  gotoxy(33,7);write('Sudoku Activado Salir Boton Raton Izq.');

                  muestra_raton;

                  x := posx_raton;

                  y := posy_raton;

                 repeat

                    if (x <> posx_raton) or (y <> posy_raton) then

                    begin

                       x := posx_raton;

                       y := posy_raton;

                    end;

                    if boton_raton = 1 then

                    begin

                if ((x > 29) and (x < 50)) and ((y > 12) and (y < 33)) then

                 begin

                       posicionnum(x, y, pl1, pl2);

                       if s[pl2,pl1] = 0 then

                       begin

                       gotoxy(44,8);write('Numero : ');

                       gotoxy(53,8);readln(nn);

                       borra(44,8,55);

                       s[pl2,pl1] := nn;

                       rellana_sudok(28,11);

                       end

                    else

                       begin

                          borra(44,8,55);

                          gotoxy(44,8);write('Cuadro Ocupado Pulse Una Tecla');

                          readkey;

                          borra(44,8,74);

                       end;

                    end;

                  end;

                 until boton_raton = 2;

                 borra(33,7,70);

                 if soluccion = true then

                 begin

                 gotoxy(33,7);write('Soluccion Ok  Pulse Una Tecla');

                 end

              else

                 begin

                    gotoxy(33,7);write('Soluccion No Ok  Pulse Una Tecla');

                 end;

                   readkey;

                   borra(33,7,70);

                end;

         65..71 : sal := true;

            end;

          end;

        end;

       end;

      until sal = true;

        oculta_raton;

     end

   else

      begin

        clrscr;

        writeln('    Mouse No Detectado Erros Pulse Una Tecla');

        readkey;

      end;

     TextMode(origen);

  end.