Pascal/Turbo Pascal - ayuda con el juego de PICA y FAMA

{Mira esto}

 program clave;

  uses

    crt;

  const

     num = 4;

     inten = 4;

  type

    string4 = string[4];

    string7 = string[7];

  var

    numero : integer;

    intentos : array[1..inten] of record

               num : integer;

               pica : integer;

               fama : integer;

              end;

    cont : integer;

    caden : array[1..num] of integer;

    function numeroclave : string4;

    var

      t, k, nu : integer;

      existe : boolean;

      cla : string4;

    begin

       t := 1;

     repeat

         existe := false;

         nu := random(9);

         for k := 1 to t do

         begin

            if caden[k] = nu then

            existe := true;

         end;

        if existe = false then

        begin

           caden[t] := nu;

           t := t + 1;

        end;

     until t > num;

     for k := 1 to num do

     begin

     cla[k] := chr(caden[k] + 48);

     cla[0] := chr(k);

     end;

     numeroclave := copy(cla,1,length(cla));

    end;

   function famas(nt, cl : string4) : integer;

   var

     mm, p, erro, nn : integer;

   begin

     mm := 0;

     famas := 0;

     for p := 1 to num do

     begin

      if nt[p] = cl[p] then

      begin

         mm := mm + 1;

      end;

    end;

     famas := mm;

   end;

   function picas(nt, cl : string4) : integer;

   var

     mm, p, nn : integer;

    begin

      p := 0;

      picas := 0;

      for mm := 1 to num do

      begin

       for nn := 1 to num do

       if nt[mm] = cl[nn] then

       begin

          if mm = nn then

         else

           p := p + 1;

       end;

      end;

       picas := p;

    end;

   function ganador(nt, cl : string4) : string7;

   var

     mm : integer;

     gano : boolean;

    begin

      gano := true;

      for mm := 1 to num do

      begin

        if nt[mm] <> cl[mm] then

        gano := false;

      end;

       if gano = true then

       begin

         ganador := 'acierto';

         ganador[0] := chr(7);

       end

     else

       ganador := ' ';

    end;

   procedure PICA_y_FAMA;

   var

    tecla : char;

    erro, p, i, intet : integer;

    entrado, numclav : string4;

    begin

      numclav := copy(numeroclave,1,4);

      gotoxy(12,2);write('El Numero Clave Es =  ****  ');

      intet := 1;

    repeat

      gotoxy(18,2 + intet);write('  Intento Num. ',intet,' ');

      i := 1;

      repeat

        repeat

          tecla :=  readkey;

       until tecla in['0'..'9',#8];

        if  tecla in['0'..'9'] then

        begin

          entrado[i] := tecla;

          entrado[0] := chr(i);

          gotoxy(37,2 + intet);write(entrado);

          i := i + 1;

        end;

        if tecla = #8 then

         begin

            i := i - 1;

            if i < 1 then

            i := 1;

            entrado[i] := ' ';

            entrado[0] := chr(i);

            gotoxy(37,2 + intet);write(entrado);

         end;

      until i > 4;

      intentos[intet].fama := famas(entrado, numclav);

      intentos[intet].pica := picas(entrado, numclav);

      val(entrado,intentos[intet].num,erro);

      if erro <> 0 then

      begin

        repeat

        delete(entrado,erro,1);

        val(entrado,intentos[intet].num,erro);

        until erro = 0;

      end;

      gotoxy(37,2 + intet);write(entrado,'  Fama = ',intentos[intet].fama,

      '  Pica = ',intentos[intet].pica);

      if ganador(entrado, numclav) = 'acierto' then

      begin

        gotoxy(37,3 + intet);write('Ganaste!!! Pulsa Una Tecla');

        readkey;

        intet := num + 1;

        break;

      end;

      intet := intet + 1;

    until intet > num;

    clrscr;

      gotoxy(34,2);write(' Numero Clave = ',numclav);

      for p := 1 to num do

      begin

      gotoxy(34,6 + p);write(p,'  = ',intentos[p].num,'  Fama = ',

      intentos[p].fama,'  Pica = ',intentos[p].pica);

      end;

      readkey;

    end;

  begin

     clrscr;

     randomize;

     PICA_y_FAMA;

  end.

{Mira esto}

 program sudoko;

 uses

    {$M 16192, 16192, 655360}

    crt, dos, graph, unimous, sudokV;

   var

     iy, ix : integer;

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

   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;

  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 crear of

  0 : dificultad := 0;

  1 : dificultad := 30;

  2 : dificultad := 35;

  3 : dificultad := 40;

  4 : dificultad := 0;

   end;

  if dificultad in[30,35,40] 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] := integerchar(s[i,j]);

       sudoku.guego[i,j] := integerchar(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 := integerchar(s[i,j]);

          if d[1] = '0' then

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

     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] := charinteger(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] := charinteger(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

       str(s[i,j],u);

       if u[1] = '0' then

       begin

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

       end

     else

       begin

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

       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

        setcolor(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] := ' ';

         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 cargasudoku;

  var

     i, locgx, locgy : integer;

     w, ii, xc, yc : integer;

     toma : char;

  begin

      fillchar(archivos.nom,sizeof(archivos.nom),' ');

      ii := 1;

     findfirst('*.suk',archive,dirinfo);

     while doserror = 0 do

     begin

         archivos.nom[ii] := dirinfo.name;

         inc(ii);

         if ii > 120 then

         ii := 120;

         findnext(dirinfo);

     end;

      i := 1;

      locgx := 45 + 110;

      if (ii - 1) < 7 then

        locgy := 45 + (19 * (ii - 1))

      else

      locgy := 45 + (16 * (ii - 1));

      if locgy > 420 then

      begin

          locgy := 420;

          locgx := 45 + 220;

      end;

      if ii = 1 then

      begin

         outtextxy(25,locgy + 12,'NO HAY ARCHIVOS');

         outtextxy(25,locgy + 21,'PULSE [ESC]');

         repeat

             toma := readkey;

         until toma = #27;

      end

   else

      begin

      bar3d(45,55,locgx,locgy,(locgx - 44) div 12, TopOn);

      outtextxy(25,locgy + 12,'USE LAS TECLAS DE FLECHA');

      outtextxy(25,locgy + 21,'Y PULSE [ENTER] O [ESC]');

      xc := 0;

      yc := 0;

      for i := 1 to ii - 1 do

      begin

          outtextxy(50 + xc,63 + yc,archivos.nom[i]);

          inc(yc,14);

          if yc > 400 then

          begin

               yc := 0;

               xc := 110;

          end;

      end;

        i := 1;

        xc := 0;

        yc := 0;

     repeat

         SetFillPattern(fondo, 7);

         bar(48,60 + yc,locgx - 4,71 + yc);

         SetFillPattern(fondo, 0);

         setcolor(1);

         outtextxy(50 + xc,63 + yc,archivos.nom[i]);

         toma := readkey;

       if toma = #80 then

       begin

           delay(160);

           SetFillPattern(fondo, 0);

           bar(48,60 + yc,locgx - 4,71 + yc);

           setcolor(15);

           outtextxy(50 + xc,63 + yc,archivos.nom[i]);

           inc(i);

           inc(yc,14);

           if i > (ii - 1) then

           begin

              i := (ii - 1);

              dec(yc,14);

           end;

{dos}

 SetFillPattern(fondo, 7);

           bar(48,60 + yc,locgx - 4,71 + yc);

           setcolor(1);

           outtextxy(50 + xc,63 + yc,archivos.nom[i]);

       end;

       if toma = #72 then

       begin

           delay(160);

           SetFillPattern(fondo, 0);

           bar(48,60 + yc,locgx - 4,71 + yc);

           setcolor(15);

           outtextxy(50 + xc,63 + yc,archivos.nom[i]);

           dec(i);

           dec(yc,14);

           if i < 1 then

           begin

               i := 1;

               inc(yc,14);

           end;

           SetFillPattern(fondo, 7);

           bar(48,60 + yc,locgx - 4,71 + yc);

           setcolor(1);

           outtextxy(50 + xc,63 + yc,archivos.nom[i]);

       end;

    until (toma = #13) or (toma = #27);

    if toma = #27 then

    begin

        sudok := false;

    end;

    if toma = #13 then

    begin

        sudok := true;

      if (archivos.nom[i][1] = 'S') and (archivos.nom[i][2] = 'K') then

      begin

        for l1 := 1 to 9 do

           for l2 := 1 to 9 do

           begin

               sudoku.matriz[l2,l1] := ' ';

               sudoku.guego[l2,l1] := ' ';

               sudoku.partida[l2,l1] := ' ';

           end;

        assign(f,archivos.nom[i]);

     {$i-} reset(f); {$i+}

     if ioresult <> 0 then

     begin

         exit;

     end

    else

       begin

        seek(f,0);

        read(f,sudoku);

        close(f);

        for w := 1 to 9 do

        for ii := 1 to 9 do

        begin

          prueba[w,ii] := sudoku.guego[w,ii];

        end;

      end;

        setcolor(1);

        outtextxy(10,28,'[      ]     [     ]     [     ]');

        setcolor(15);

        outtextxy(10,28,' CARGAR       CREAR       SALIR  ');

        outtextxy(470,28,' SUDOKU AUTOMATICO ');

        SetFillPattern(fondo, 7);

        bar(342,28,408,38);

        SetFillPattern(fondo, 0);

        setcolor(1);

        outtextxy(342,28,'[      ]');

        setcolor(0);

        outtextxy(342,28,' SALVAR ');

    end;

   end;

  end;

      SetFillPattern(fondo, 0);

      bar(4,41,locgx + 80,locgy + 32);

  end;

  procedure guarda_partida;

  var

      nomb : string;

      tcl : char;

      valo : word;

      n, m, xl, yl, l : integer;

      label salto;

  begin

    if para = false then

    begin

      rectangle(400,50,600,62);

      outtextxy(408,53,'NOMBRE : ');

      l := 1;

      xl := 473;

      yl := 53;

     repeat

      tcl := readkey;

      if tcl = #0 then

      valo := word(ord(readkey)) shl 8

    else

      valo := ord(tcl);

      if valo in [65..90,97..122,164,165,92,58,49..57,95] then

      begin

          nomb[0] := chr(l);

          nomb[l] := upcase(chr(valo));

          outtextxy(xl,yl,nomb[l]);

          inc(l);

          inc(xl,8);

          if l > 25 then

          begin

             l := 25;

             dec(xl,8);

          end;

      end;

      if valo in [8] then

      begin

          dec(l);

          dec(xl,8);

          if l < 1 then

          begin

             inc(l);

             inc(xl,8);

          end;

          nomb[0] := chr(l);

          nomb[l] := ' ';

          SetFillPattern(fondo, 0);

          bar(xl,yl,xl + 8,yl + 8);

      end;

     until (valo = 13) or (valo = 27);

     if valo = 13 then

     begin

         assign(f,nomb + '.jug');

    {$i-} reset(f); {$i+}

    if ioresult <> 0  then

    begin

       rewrite(f);

       seek(f,0);

       write(f,sudoku);

       close(f);

    end

  else

      begin

        close(f);

        goto salto;

     salto:

        outtextxy(348,73,'EL ARCHIVO ESISTE ENTRE OTRO NOMBRE');

        delay(2000);

        SetFillPattern(fondo, 0);

        bar(347,72,634,84);

        bar(472,49,598,59);

        guarda_partida;

      end;

    end;

   end

  else

     begin

     assign(f,nombar);

     rewrite(f);

       seek(f,0);

       write(f,sudoku);

       close(f);

     end;

  end;

  procedure crea_sudocu(cual : integer);

  var

     tm, tec : char;

     ii, u : integer;

     nombre : string;

     xp, yp, pl1, pl2, raton_boton, xs, ys, i : integer;

     no, salir : boolean;

  begin

      pantalla;

      if cual = 1 then

      begin

          setcolor(10);

          outtextxy((getmaxx div 2) - (13 * 10) + 2,(getmaxy div 2) - (11 * 10) + 2,

                     '*** CREACION O COPIA DE SUDOKU ***');

          setcolor(14);

          outtextxy((getmaxx div 2) - 280,(getmaxy div 2) - 12,'DIFICULTAD');

          setcolor(15);

          outtextxy((getmaxx div 2) - 280,getmaxy div 2,'Normal');

          outtextxy((getmaxx div 2) - 280,(getmaxy div 2) + 12,'Media');

          outtextxy((getmaxx div 2) - 280,(getmaxy div 2) + 24,'Alta');

          setcolor(4);

          outtextxy((getmaxx div 2) - 280,(getmaxy div 2) + 36,'PULSE LETRA');

          outtextxy((getmaxx div 2) - 280,(getmaxy div 2) + 48,'N/M/A');

          setcolor(15);

          repeat

              tepu := readkey;

              if tepu in['n','N','m','M','a','A'] then

              begin

              end

            else

               begin

                   sound(120);

                   delay(120);

                   nosound;

               end;

          until tepu in['n','N','m','M','a','A'];

          case tepu of

       'n','N' : begin

                   dific := 40;

                   difi_cul := 'DIFICULTAD NORMAL';

                 end;

       'm','M' : begin

                   dific := 80;

                   difi_cul := 'DIFICULTAD MEDIA';

                   end;

       'a','A' : begin

                   dific := 120;

                   difi_cul := 'DIFICULTAD ALTA';

                   end;

       end;

          SetFillPattern(fondo, 0);

          bar((getmaxx div 2) - 280,(getmaxy div 2) - 12,(getmaxx div 2) - 180,(getmaxy div 2) + 88);

          setcolor(12);

          outtextxy((getmaxx div 2) - (11 * 10) + 2,(getmaxy div 2) - (13 * 10) + 2,difi_cul);

          setcolor(14);

          outtextxy((getmaxx div 2) - (26 * 10) + 2,(getmaxy div 2) - (8 * 10) + 190,

          'PONGA EL RATON EN LA CASILLA Y PULSE BOTON IZQUIERDO [ENTER] FINAL');

          outtextxy((getmaxx div 2) - (26 * 10) + 2,(getmaxy div 2) - (8 * 10) + 208,

          '[ESC] AVANDONA ENTRADA SUDOKU');

          setcolor(3);

          outtextxy((getmaxx div 2) - (26 * 10) + 434,(getmaxy div 2) - (8 * 10) + 190,

          'ENTER');

          setcolor(15);

          fillchar(sudoku.guego,sizeof(sudoku.guego),' ');

          setcolor(15);

      end;

      if cual = 2 then

      begin

          outtextxy((getmaxx div 2) - (13 * 8) + 2,(getmaxy div 2) - (11 * 10) + 2,

                     '*** COMPLETA EL SUDOKU ***');

          outtextxy((getmaxx div 2) - (21 * 10) + 2,(getmaxy div 2) + (11 * 10) + 2,

                     'Elija la casilla con el raton y entre Numero  [Esc] = SALIR');

          pl1 := 1;

          xp := ((getmaxx div 2) - (9 * 10)) + 9;

          yp := ((getmaxy div 2) - (9 * 10)) + 9;

          repeat

              pl2 := 1;

              repeat

                  setcolor(9);

                  outtextxy(xp, yp,sudoku.guego[pl2][pl1]);

                  setcolor(15);

               if cagado = true then

               begin

                  setcolor(15);

                  outtextxy(xp, yp,sudoku.partida[pl2][pl1]);

               end;

              inc(pl2);

              inc(xp,20);

              until pl2 > 9;

          inc(pl1);

          inc(yp,20);

          xp := ((getmaxx div 2) - (9 * 10)) + 9;

          until pl1 > 9;

          setcolor(14);

          outtextxy((getmaxx div 2) - (13 * 3) + 2,(getmaxy div 2) - (11 * 12) + 2,

                    'NIVEL : ' + sudoku.dificultac);

          setcolor(15);

      end;

      if cual = 3 then

      begin

           pl1 := 1;

          xp := ((getmaxx div 2) - (9 * 10)) + 9;

          yp := ((getmaxy div 2) - (9 * 10)) + 9;

          repeat

              pl2 := 1;

              repeat

                  setcolor(9);

                  if sudoku.guego[pl1,pl2] <> '0' then

                  outtextxy(xp, yp,sudoku.guego[pl2,pl1]);

                  setcolor(15);

               if cagado = true then

               begin

                  setcolor(15);

                  if sudoku.partida[pl1,pl2] <> '0' then

                  outtextxy(xp, yp,sudoku.partida[pl2,pl1]);

               end;

              inc(pl2);

              inc(xp,20);

              until pl2 > 9;

          inc(pl1);

          inc(yp,20);

          xp := ((getmaxx div 2) - (9 * 10)) + 9;

          until pl1 > 9;

          setcolor(14);

          outtextxy((getmaxx div 2) - (13 * 3) + 2,(getmaxy div 2) - (11 * 12) + 2,

                    'NIVEL : ' + sudoku.dificultac);

          setcolor(15);

          rectangle(9,55,149,95);

          setcolor(7);

          rectangle(10,56,148,94);

          setcolor(14);

          outtextxy(14,59,'DESEA GUARDARLO');

          outtextxy(14,72,'Y SEGIR [S/N]  ');

          setcolor(15);

        repeat

            tm := readkey;

            if tm in['n','N','S','s'] then

            begin

            end

         else

            begin

                write(^G);

            end;

        until tm in['n','N','S','s'];

        SetFillPattern(fondo, 0);

        bar(8,54,150,100);

        if tm in['N','n'] then

        begin

            exit;

        end

      else

           begin

               fecha := fecha_hors;

               nombre := 'SK' + fecha + '.SUK';

               assign(f,nombre);

               rewrite(f);

               seek(f,0);

               write(f,sudoku);

               close(f);

               outtextxy((getmaxx div 2) - (13 * 8) + 2,(getmaxy div 2) - (11 * 10) + 2,

                     '*** COMPLETA EL SUDOKU ***');

          outtextxy((getmaxx div 2) - (21 * 10) + 2,(getmaxy div 2) + (11 * 10) + 2,

                     'Elija la casilla con el raton y entre Numero  [Esc] = SALIR');

              SetFillPattern(fondo, 7);

            bar(342,28,448,38);

            setcolor(15);

            outtextxy(10,28,' CARGAR       CREAR       SALIR  ');

            outtextxy(470,28,' SUDOKU AUTOMATICO ');

            setcolor(1);

            outtextxy(342,28,'[      ]');

            setcolor(0);

            outtextxy(342,28,' SALVAR ');

            SetFillPattern(fondo, 0);

           end;

      end;

      muestra_raton;

      pon_posicion_raton(500,200);

      xs := posx_raton;

      ys := posy_raton;

      raton_boton := 0;

      xk := 0;

      yk := 0;

      delay(160);

      setcolor(15);

    repeat

      if (xs <> posx_raton) or (ys <> posy_raton) then

      begin

         xs := posx_raton;

         ys := posy_raton;

      end;

      raton_boton := boton_raton;

    if raton_boton = 1 then

      begin

      no := false;

      if (cual = 2) or (cual = 3) then

      begin

          case ys of

       29..37 : begin

                case xs of

             343..391 : begin

                          guarda_partida;

                          tec := #27;

                      end;

                   end;

               end;

          end;

      end;

{tres}

unit unimous;

 interface

 uses

    dos;

 type

    G_Mouse=Record

	   SCREENMASK,CURSORMASK:Array[0..15] OF WORD;

	   HOTX,HOTY:Integer;

          End;

 const

    Mano:G_Mouse=

 (SCREENMASK: ($F3FF,$E1FF,$E1FF,$E1FF,$E1FF,$E049,$E000,$8000,$0000,$0000,

	       $07FC,$07F8,$9FF9,$8FF1,$C003,$E007);

 CURSORMASK: ($0C00,$1200,$1200,$1200,$1200,$13B6,$1249,$7249,$9249,$9001,

	       $9001,$8001,$4002,$4002,$2004,$1FF8);

 HOTX:$0005;  HOTY:$0006);

 Flecha:G_Mouse=

 (SCREENMASK: ($3FFF,$1FFF,$0FFF,$07FF,$03FF,$01FF,$00FF,$007F,$003F,$001F,

	       $01FF,$10FF,$30FF,$F87F,$F87F,$FC3F);

  CURSORMASK: ($0000,$4000,$6000,$7000,$7800,$7C00,$7E00,$7F00,$7F80,$7FC0,

	       $7FC0,$4600,$0600,$0300,$0300,$0000);

  HOTX:$0001;  HOTY:$0001);

 Paloma:G_Mouse=

 (SCREENMASK: ($FFF0,$FFE0,$FFC0,$FF81,$FF03,$0607,$000F,$001F,$803F,$C07F,

	       $E0FF,$F1FF,$FFFF,$FFFF,$FFFF,$FFFF);

  CURSORMASK: ($0000,$0006,$000C,$0018,$0030,$0060,$70C0,$3980,$1F00,$0E00,

	       $0400,$0000,$0000,$0000,$0000,$0000);

  HOTX:$0002;  HOTY:$0003);

 Cruz:G_Mouse=

 (SCREENMASK: ($F01F,$E00F,$C007,$8003,$0441,$0C61,$0381,$0381,$0381,$0C61,

	       $0441,$8003,$C007,$E00F,$F01F,$FFFF);

  CURSORMASK: ($0000,$07C0,$0920,$1110,$2108,$4004,$4004,$783C,$4004,$4004,

	       $2108,$1110,$0920,$07C0,$0000,$0000);

  HOTX:$0007;  HOTY:$0007);

  IbeamCruz:G_Mouse=

  (SCREENMASK: ($E187,$E007,$F81F,$FC3F,$FC3F,$FC3F,$FC3F,$FC3F,$FC3F,$FC3F,

		$FC3F,$FC3F,$FC3F,$F81F,$E007,$E187);

   CURSORMASK: ($0C30,$0240,$0180,$0180,$0180,$0180,$0180,$0180,$0180,$0180,

		$0180,$0180,$0180,$0180,$0240,$0C30);

   HOTX:$0007;  HOTY:$0007);

   Reloj_Arena:G_Mouse=

   (SCREENMASK: ($FFFF,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF,

                 $FFFF,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF);

    CURSORMASK: ($FFFF,$FFFF,$C003,$6006,$300C,$1FF8,$0FF0,$07E0,$07E0,$0DB0,

                 $1998,$310C,$63C6,$C7E3,$FFFF,$FFFF);

    HOTX:$0005;  HOTY:0005);

 var

   regs : registers;

   mouse, raton : boolean;

   pulsado : integer;

   texgraf : byte;

   esist : boolean;

  procedure initmouse(como : byte);

  function raton_presente : boolean;

  procedure muestra_raton;

  procedure oculta_raton;

  function posx_raton : word;

  function posy_raton : word;

  function boton_raton : word;

  procedure pon_posicion_raton(xp, yp : word);

  function posx_texto : word;

  function posy_texto : word;

  function estado_boton_derecho : byte;

  procedure pon_posicion_raton_texto(xt, yt : word);

  procedure ventana_raton(xv, yv, xxv, yyv : word);

  procedure sensib_raton(xs, ys : word);

  procedure pulsa_boton(var pulsado : integer; boton : byte);

  procedure relacion_pixel_mickeys(px, py : integer);

  function soltar_boton_raton(bot : byte) : byte;

  Procedure Tipo_de_Mouse(cursor : g_mouse);

  implementation

  procedure initmouse(como : byte);

   begin

       texgraf := como;

       regs.ax := $00;

       intr($33,regs);

       esist := regs.ax <> $00;

       if texgraf = 1 then

        if not mouse then

        mouse := true;

   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

  end;

  function posy_raton : word;

  begin

      posy_raton := 0;

      regs.ah := $00;

      regs.al := $03;

      intr($33,regs);

      posy_raton := regs.dx

  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 posx_texto : word;

  begin

     regs.ax := $03;

     intr($33,regs);

     posx_texto := regs.cx div 8 + 1;

  end;

  function posy_texto : word;

  begin

     regs.ax := $03;

     intr($33,regs);

     posy_texto := regs.dx div 8 + 1;

  end;

  function estado_boton_derecho : byte;

  begin

      regs.ax := $03;

      intr($33,regs);

      estado_boton_derecho := regs.bx;

  end;

  procedure pon_posicion_raton_texto(xt, yt : word);

  begin

      regs.ax := $04;

      regs.cx := (xt - 1) * 8;

      regs.dx := (yt - 1) * 8;

      intr($33,regs);

  end;

  procedure ventana_raton(xv, yv, xxv, yyv : word);

  begin

      regs.ah := $00;

      regs.al := $07;

      regs.cx := xv;

      regs.dx := xxv;

      intr($33,regs);

      regs.ah := $00;

      regs.al := $08;

      regs.cx := yv;

      regs.dx := yyv;

      intr($33,regs);

  end;

  procedure sensib_raton(xs, ys : word);

  begin

      regs.ah := $00;

      regs.al := $1A;

      regs.bx := xs;

      regs.cx := ys;

      regs.dx := 32;

      intr($33,regs);

  end;

  procedure pulsa_boton(var pulsado : integer; boton : byte);

  begin

      regs.ah := $00;

      regs.al := $05;

      regs.bx := boton;

      intr($33,regs);

      pulsado := regs.bx;

  end;

  procedure relacion_pixel_mickeys(px, py : integer);

  begin

      regs.ah := $00;

      regs.al := $0f;

      regs.cx := px;

      regs.dx := py;

      intr($33,regs);

  end;

  function soltar_boton_raton(bot : byte) : byte;

  begin

     regs.ah := $00;

     regs.al := $06;

     regs.bx := bot;

     intr($33,regs);

     soltar_boton_raton := regs.bx;

  end;

  Procedure Tipo_de_Mouse(cursor : g_mouse);

  Begin

     regs.ah := $00;

     regs.al := $09;

     regs.bx := cursor.hotx;

     regs.cx := cursor.hoty;

     regs.dx := ofs(cursor.screenmask);

     regs.es := seg(cursor.screenmask);

     Intr($33,regs)

End;

 begin

 end.

{cuatro 2 del archivo sudoku}

SetFillPattern(fondo, 7);

           bar(48,60 + yc,locgx - 4,71 + yc);

           setcolor(1);

           outtextxy(50 + xc,63 + yc,archivos.nom[i]);

       end;

       if toma = #72 then

       begin

           delay(160);

           SetFillPattern(fondo, 0);

           bar(48,60 + yc,locgx - 4,71 + yc);

           setcolor(15);

           outtextxy(50 + xc,63 + yc,archivos.nom[i]);

           dec(i);

           dec(yc,14);

           if i < 1 then

           begin

               i := 1;

               inc(yc,14);

           end;

           SetFillPattern(fondo, 7);

           bar(48,60 + yc,locgx - 4,71 + yc);

           setcolor(1);

           outtextxy(50 + xc,63 + yc,archivos.nom[i]);

       end;

    until (toma = #13) or (toma = #27);

    if toma = #27 then

    begin

        sudok := false;

    end;

    if toma = #13 then

    begin

        sudok := true;

      if (archivos.nom[i][1] = 'S') and (archivos.nom[i][2] = 'K') then

      begin

        for l1 := 1 to 9 do

           for l2 := 1 to 9 do

           begin

               sudoku.matriz[l2,l1] := ' ';

               sudoku.guego[l2,l1] := ' ';

               sudoku.partida[l2,l1] := ' ';

           end;

        assign(f,archivos.nom[i]);

     {$i-} reset(f); {$i+}

     if ioresult <> 0 then

     begin

         exit;

     end

    else

       begin

        seek(f,0);

        read(f,sudoku);

        close(f);

        for w := 1 to 9 do

        for ii := 1 to 9 do

        begin

          prueba[w,ii] := sudoku.guego[w,ii];

        end;

      end;

        setcolor(1);

        outtextxy(10,28,'[      ]     [     ]     [     ]');

        setcolor(15);

        outtextxy(10,28,' CARGAR       CREAR       SALIR  ');

        outtextxy(470,28,' SUDOKU AUTOMATICO ');

        SetFillPattern(fondo, 7);

        bar(342,28,408,38);

        SetFillPattern(fondo, 0);

        setcolor(1);

        outtextxy(342,28,'[      ]');

        setcolor(0);

        outtextxy(342,28,' SALVAR ');

    end;

   end;

  end;

      SetFillPattern(fondo, 0);

      bar(4,41,locgx + 80,locgy + 32);

  end;

  procedure guarda_partida;

  var

      nomb : string;

      tcl : char;

      valo : word;

      n, m, xl, yl, l : integer;

      label salto;

  begin

    if para = false then

    begin

      rectangle(400,50,600,62);

      outtextxy(408,53,'NOMBRE : ');

      l := 1;

      xl := 473;

      yl := 53;

     repeat

      tcl := readkey;

      if tcl = #0 then

      valo := word(ord(readkey)) shl 8

    else

      valo := ord(tcl);

      if valo in [65..90,97..122,164,165,92,58,49..57,95] then

      begin

          nomb[0] := chr(l);

          nomb[l] := upcase(chr(valo));

          outtextxy(xl,yl,nomb[l]);

          inc(l);

          inc(xl,8);

          if l > 25 then

          begin

             l := 25;

             dec(xl,8);

          end;

      end;

      if valo in [8] then

      begin

          dec(l);

          dec(xl,8);

          if l < 1 then

          begin

             inc(l);

             inc(xl,8);

          end;

          nomb[0] := chr(l);

          nomb[l] := ' ';

          SetFillPattern(fondo, 0);

          bar(xl,yl,xl + 8,yl + 8);

      end;

     until (valo = 13) or (valo = 27);

     if valo = 13 then

     begin

         assign(f,nomb + '.jug');

    {$i-} reset(f); {$i+}

    if ioresult <> 0  then

    begin

       rewrite(f);

       seek(f,0);

       write(f,sudoku);

       close(f);

    end

  else

      begin

        close(f);

        goto salto;

     salto:

        outtextxy(348,73,'EL ARCHIVO ESISTE ENTRE OTRO NOMBRE');

        delay(2000);

        SetFillPattern(fondo, 0);

        bar(347,72,634,84);

        bar(472,49,598,59);

        guarda_partida;

      end;

    end;

   end

  else

     begin

     assign(f,nombar);

     rewrite(f);

       seek(f,0);

       write(f,sudoku);

       close(f);

     end;

  end;

  procedure crea_sudocu(cual : integer);

  var

     tm, tec : char;

     ii, u : integer;

     nombre : string;

     xp, yp, pl1, pl2, raton_boton, xs, ys, i : integer;

     no, salir : boolean;

  begin

      pantalla;

      if cual = 1 then

      begin

          setcolor(10);

          outtextxy((getmaxx div 2) - (13 * 10) + 2,(getmaxy div 2) - (11 * 10) + 2,

                     '*** CREACION O COPIA DE SUDOKU ***');

          setcolor(14);

          outtextxy((getmaxx div 2) - 280,(getmaxy div 2) - 12,'DIFICULTAD');

          setcolor(15);

          outtextxy((getmaxx div 2) - 280,getmaxy div 2,'Normal');

          outtextxy((getmaxx div 2) - 280,(getmaxy div 2) + 12,'Media');

          outtextxy((getmaxx div 2) - 280,(getmaxy div 2) + 24,'Alta');

          setcolor(4);

          outtextxy((getmaxx div 2) - 280,(getmaxy div 2) + 36,'PULSE LETRA');

          outtextxy((getmaxx div 2) - 280,(getmaxy div 2) + 48,'N/M/A');

          setcolor(15);

          repeat

              tepu := readkey;

              if tepu in['n','N','m','M','a','A'] then

              begin

              end

            else

               begin

                   sound(120);

                   delay(120);

                   nosound;

               end;

          until tepu in['n','N','m','M','a','A'];

          case tepu of

       'n','N' : begin

                   dific := 40;

                   difi_cul := 'DIFICULTAD NORMAL';

                 end;

       'm','M' : begin

                   dific := 80;

                   difi_cul := 'DIFICULTAD MEDIA';

                   end;

       'a','A' : begin

                   dific := 120;

                   difi_cul := 'DIFICULTAD ALTA';

                   end;

       end;

          SetFillPattern(fondo, 0);

          bar((getmaxx div 2) - 280,(getmaxy div 2) - 12,(getmaxx div 2) - 180,(getmaxy div 2) + 88);

          setcolor(12);

          outtextxy((getmaxx div 2) - (11 * 10) + 2,(getmaxy div 2) - (13 * 10) + 2,difi_cul);

          setcolor(14);

          outtextxy((getmaxx div 2) - (26 * 10) + 2,(getmaxy div 2) - (8 * 10) + 190,

          'PONGA EL RATON EN LA CASILLA Y PULSE BOTON IZQUIERDO [ENTER] FINAL');

          outtextxy((getmaxx div 2) - (26 * 10) + 2,(getmaxy div 2) - (8 * 10) + 208,

          '[ESC] AVANDONA ENTRADA SUDOKU');

          setcolor(3);

          outtextxy((getmaxx div 2) - (26 * 10) + 434,(getmaxy div 2) - (8 * 10) + 190,

          'ENTER');

          setcolor(15);

          fillchar(sudoku.guego,sizeof(sudoku.guego),' ');

          setcolor(15);

      end;

      if cual = 2 then

      begin

          outtextxy((getmaxx div 2) - (13 * 8) + 2,(getmaxy div 2) - (11 * 10) + 2,

                     '*** COMPLETA EL SUDOKU ***');

          outtextxy((getmaxx div 2) - (21 * 10) + 2,(getmaxy div 2) + (11 * 10) + 2,

                     'Elija la casilla con el raton y entre Numero  [Esc] = SALIR');

          pl1 := 1;

          xp := ((getmaxx div 2) - (9 * 10)) + 9;

          yp := ((getmaxy div 2) - (9 * 10)) + 9;

          repeat

              pl2 := 1;

              repeat

                  setcolor(9);

                  outtextxy(xp, yp,sudoku.guego[pl2][pl1]);

                  setcolor(15);

               if cagado = true then

               begin

                  setcolor(15);

                  outtextxy(xp, yp,sudoku.partida[pl2][pl1]);

               end;

              inc(pl2);

              inc(xp,20);

              until pl2 > 9;

          inc(pl1);

          inc(yp,20);

          xp := ((getmaxx div 2) - (9 * 10)) + 9;

          until pl1 > 9;

          setcolor(14);

          outtextxy((getmaxx div 2) - (13 * 3) + 2,(getmaxy div 2) - (11 * 12) + 2,

                    'NIVEL : ' + sudoku.dificultac);

          setcolor(15);

      end;

      if cual = 3 then

      begin

           pl1 := 1;

          xp := ((getmaxx div 2) - (9 * 10)) + 9;

          yp := ((getmaxy div 2) - (9 * 10)) + 9;

          repeat

              pl2 := 1;

              repeat

                  setcolor(9);

                  if sudoku.guego[pl1,pl2] <> '0' then

                  outtextxy(xp, yp,sudoku.guego[pl2,pl1]);

                  setcolor(15);

               if cagado = true then

               begin

                  setcolor(15);

                  if sudoku.partida[pl1,pl2] <> '0' then

                  outtextxy(xp, yp,sudoku.partida[pl2,pl1]);

               end;

              inc(pl2);

              inc(xp,20);

              until pl2 > 9;

          inc(pl1);

          inc(yp,20);

          xp := ((getmaxx div 2) - (9 * 10)) + 9;

          until pl1 > 9;

          setcolor(14);

          outtextxy((getmaxx div 2) - (13 * 3) + 2,(getmaxy div 2) - (11 * 12) + 2,

                    'NIVEL : ' + sudoku.dificultac);

          setcolor(15);

          rectangle(9,55,149,95);

          setcolor(7);

          rectangle(10,56,148,94);

          setcolor(14);

          outtextxy(14,59,'DESEA GUARDARLO');

          outtextxy(14,72,'Y SEGIR [S/N]  ');

          setcolor(15);

        repeat

            tm := readkey;

            if tm in['n','N','S','s'] then

            begin

            end

         else

            begin

                write(^G);

            end;

        until tm in['n','N','S','s'];

        SetFillPattern(fondo, 0);

        bar(8,54,150,100);

        if tm in['N','n'] then

        begin

            exit;

        end

      else

           begin

               fecha := fecha_hors;

               nombre := 'SK' + fecha + '.SUK';

               assign(f,nombre);

               rewrite(f);

               seek(f,0);

               write(f,sudoku);

               close(f);

               outtextxy((getmaxx div 2) - (13 * 8) + 2,(getmaxy div 2) - (11 * 10) + 2,

                     '*** COMPLETA EL SUDOKU ***');

          outtextxy((getmaxx div 2) - (21 * 10) + 2,(getmaxy div 2) + (11 * 10) + 2,

                     'Elija la casilla con el raton y entre Numero  [Esc] = SALIR');

              SetFillPattern(fondo, 7);

            bar(342,28,448,38);

            setcolor(15);

            outtextxy(10,28,' CARGAR       CREAR       SALIR  ');

            outtextxy(470,28,' SUDOKU AUTOMATICO ');

            setcolor(1);

            outtextxy(342,28,'[      ]');

            setcolor(0);

            outtextxy(342,28,' SALVAR ');

            SetFillPattern(fondo, 0);

           end;

      end;

      muestra_raton;

      pon_posicion_raton(500,200);

      xs := posx_raton;

      ys := posy_raton;

      raton_boton := 0;

      xk := 0;

      yk := 0;

      delay(160);

      setcolor(15);

    repeat

      if (xs <> posx_raton) or (ys <> posy_raton) then

      begin

         xs := posx_raton;

         ys := posy_raton;

      end;