Alguien me podria pasar un sudoku en pascal?
[paquete 1]
{funciona pero falta revisarlo bien}
{tiene que separar la unidad mouse del finas de sudoku3}
{En modo grafico}
{te lo mando en 4 paquetes segun deves colocarlos no medeja mandarlo en 1}
program sudoku3;
uses
crt, dos, graph, unimous;
type
archiv = record
nom : array [1..120] of string[12];
end;
creado = record
nume : string[12];
matr : array[1..9,1..9] of char;
juego : array[1..9,1..9] of char;
partida : array[1..9,1..9] of char;
end;
matriz = array[1..9,1..9] of char;
control = array[1..9] of char;
linea = array[1..9] of char;
const
fondo : FillPatternType = ($FF, $FF, $FF,
$FF, $FF, $FF, $FF, $FF);
var
crear : integer;
lin : linea;
ff : file of creado;
crea : creado;
reg_sud : creado;
con1, drive, modo : integer;
inx, iny, xk, yk, x, y, xx, yy : integer;
tecla : char;
OldPattern : FillPatternType;
archivos : archiv;
dirinfo : searchrec;
si, para, cagado, sudok : boolean;
nombar : string;
matri : matriz;
contro : control;
i, j, line2, columna, cpt : integer;
res, sav, s : array[1..9,1..9] of integer;
init : array[1..9,1..9] of boolean;
final, sepuede : boolean;
sm : string;
fecha : string[8];
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 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;
procedure graph_ini;
begin
drive := detect;
initgraph(drive,modo,'c:\tp\bgi');
if graphresult <> 0 then
begin
halt(1);
end;
GetFillPattern(OldPattern);
SetFillPattern(fondo, 0);
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;
procedure pantalla;
begin
x := 2;
setcolor(2);
repeat
y := 2;
repeat
rectangle((getmaxx div 2) - (9 * 10) + x,(getmaxy div 2) - (9 * 10) + y,
(getmaxx div 2) - (9 * 10) + x + 20,(getmaxy div 2) - (9 * 10) + y + 20);
inc(y,20);
until y > (9 * 20);
inc(x,20);
until x > (9 * 20);
setcolor(3);
line((getmaxx div 2) - (9 * 10) + 62,(getmaxy div 2) - (9 * 10) + 2,
(getmaxx div 2) - (9 * 10) + 62,(getmaxy div 2) - (9 * 10) + 182);
line((getmaxx div 2) - (9 * 10) + 61,(getmaxy div 2) - (9 * 10) + 2,
(getmaxx div 2) - (9 * 10) + 61,(getmaxy div 2) - (9 * 10) + 182);
line((getmaxx div 2) - (9 * 10) + 122,(getmaxy div 2) - (9 * 10) + 2,
(getmaxx div 2) - (9 * 10) + 122,(getmaxy div 2) - (9 * 10) + 182);
line((getmaxx div 2) - (9 * 10) + 123,(getmaxy div 2) - (9 * 10) + 2,
(getmaxx div 2) - (9 * 10) + 123,(getmaxy div 2) - (9 * 10) + 182);
line((getmaxx div 2) - (9 * 10) + 182,(getmaxy div 2) - (9 * 10) + 2,
(getmaxx div 2) - (9 * 10) + 182,(getmaxy div 2) - (9 * 10) + 182);
line((getmaxx div 2) - (9 * 10) + 183,(getmaxy div 2) - (9 * 10) + 1,
(getmaxx div 2) - (9 * 10) + 183,(getmaxy div 2) - (9 * 10) + 183);
line((getmaxx div 2) - (9 * 10) + 2,(getmaxy div 2) - (9 * 10) + 2,
(getmaxx div 2) - (9 * 10) + 2,(getmaxy div 2) - (9 * 10) + 182);
line((getmaxx div 2) - (9 * 10) + 1,(getmaxy div 2) - (9 * 10) + 1,
(getmaxx div 2) - (9 * 10) + 1,(getmaxy div 2) - (9 * 10) + 183);
line((getmaxx div 2) - (9 * 10) + 2,(getmaxy div 2) - (9 * 10) + 2,
(getmaxx div 2) - (9 * 10) + 182,(getmaxy div 2) - (9 * 10) + 2);
line((getmaxx div 2) - (9 * 10) + 1,(getmaxy div 2) - (9 * 10) + 1,
(getmaxx div 2) - (9 * 10) + 183,(getmaxy div 2) - (9 * 10) + 1);
line((getmaxx div 2) - (9 * 10) + 2,(getmaxy div 2) - (9 * 10) + 62,
(getmaxx div 2) - (9 * 10) + 182,(getmaxy div 2) - (9 * 10) + 62);
line((getmaxx div 2) - (9 * 10) + 2,(getmaxy div 2) - (9 * 10) + 61,
(getmaxx div 2) - (9 * 10) + 182,(getmaxy div 2) - (9 * 10) + 61);
line((getmaxx div 2) - (9 * 10) + 2,(getmaxy div 2) - (9 * 10) + 122,
(getmaxx div 2) - (9 * 10) + 182,(getmaxy div 2) - (9 * 10) + 122);
line((getmaxx div 2) - (9 * 10) + 2,(getmaxy div 2) - (9 * 10) + 121,
(getmaxx div 2) - (9 * 10) + 182,(getmaxy div 2) - (9 * 10) + 121);
line((getmaxx div 2) - (9 * 10) + 2,(getmaxy div 2) - (9 * 10) + 182,
(getmaxx div 2) - (9 * 10) + 182,(getmaxy div 2) - (9 * 10) + 182);
line((getmaxx div 2) - (9 * 10) + 1,(getmaxy div 2) - (9 * 10) + 183,
(getmaxx div 2) - (9 * 10) + 183,(getmaxy div 2) - (9 * 10) + 183);
setcolor(15);
end;
procedure presenta_pantalla_inicio;
begin
SetFillPattern(fondo, 11);
bar(1,1,getmaxx - 1,20);
SetFillPattern(fondo, 7);
bar(1,20,getmaxx - 1,40);
SetFillPattern(fondo, 7);
bar(1,getmaxy - 20,getmaxx - 1,getmaxy);
SetFillPattern(fondo, 7);
rectangle(1,1,getmaxx,getmaxy);
rectangle(2,2,getmaxx - 1,getmaxy - 1);
rectangle(3,3,getmaxx - 2,getmaxy - 2);
setcolor(1);
outtextxy((getmaxx div 2) - 90,8,'****** SUDOKU ******');
outtextxy(10,28,'[ ] [ ] [ ]');
setcolor(0);
outtextxy(10,28,' CARGAR CREAR SALIR');
setcolor(1);
outtextxy(342,28,'[ ]');
setcolor(0);
outtextxy(342,28,' SEGIR P. ');
setcolor(1);
outtextxy(470,28,'[ ]');
setcolor(0);
outtextxy(470,28,' SUDOKU AUTOMATICO ');
setcolor(14);
outtextxy(10,getmaxy - 14,'ELIJA OPCION');
pantalla;
setcolor(12);
outtextxy((getmaxx div 2) - (7 * 10),(getmaxy div 2) - (10 * 10) + 2,
'TABLERO DEL SUDOKU');
setcolor(11);
outtextxy(30,80,'*** INSTRUCIONES DEL PASATIEMPOS *** ');
setcolor(14);
outtextxy(15,88,'Setrata de completar');
outtextxy(15,98,'el tablero de 81 casillas');
outtextxy(15,108,'dispuestas en 9 filas');
outtextxy(15,118,'y 9 columnas rellenando');
outtextxy(15,128,'las celdas vacias con los');
outtextxy(15,138,'numeros del 1 al 9, de modo');
outtextxy(15,148,'que no se repitan ninguna');
outtextxy(15,158,'cifra en cada fila ni en');
outtextxy(15,168,'cadacolumna, ver muestra.');
setcolor(7);
line(15,180,100,180);
line(15,181,100,181);
line(15,180,15,276);
line(16,180,16,276);
line(25,180,25,276);
line(34,180,34,276);
line(43,180,43,276);
line(44,180,44,276);
line(53,180,53,276);
line(62,180,62,276);
line(71,180,71,276);
line(72,180,72,276);
line(81,180,81,276);
line(90,180,90,276);
line(99,180,99,276);
line(100,180,100,276);
line(15,192,100,192);
line(15,202,100,202);
line(15,212,100,212);
line(15,213,100,213);
line(15,223,100,223);
line(15,234,100,234);
line(15,244,100,244);
line(15,245,100,245);
line(15,255,100,255);
line(15,265,100,265);
line(15,275,100,275);
line(15,276,100,276);
setcolor(11);
outtextxy(18,183,'5');
setcolor(14);
outtextxy(27,183,'1');
outtextxy(36,183,'7');
setcolor(11);
outtextxy(46,183,'2');
outtextxy(55,183,'6');
outtextxy(64,183,'3');
outtextxy(74,183,'9');
outtextxy(83,183,'4');
setcolor(14);
outtextxy(92,183,'8');
setcolor(11);
outtextxy(18,194,'2');
outtextxy(27,194,'8');
outtextxy(36,194,'4');
outtextxy(46,194,'7');
setcolor(14);
outtextxy(55,194,'9');
setcolor(11);
outtextxy(65,194,'5');
setcolor(14);
outtextxy(74,194,'3');
setcolor(11);
outtextxy(83,194,'1');
outtextxy(92,194,'6');
setcolor(14);
outtextxy(18,204,'9');
outtextxy(27,204,'6');
setcolor(11);
outtextxy(36,204,'3');
setcolor(14);
outtextxy(46,204,'1');
setcolor(11);
outtextxy(55,204,'8');
outtextxy(64,204,'4');
outtextxy(74,204,'5');
outtextxy(83,204,'2');
setcolor(14);
outtextxy(92,204,'7');
setcolor(11);
outtextxy(18,215,'8');
outtextxy(27,215,'9');
setcolor(14);
outtextxy(36,215,'1');
outtextxy(46,215,'5');
setcolor(11);
outtextxy(55,215,'3');
outtextxy(64,215,'6');
outtextxy(74,215,'2');
setcolor(14);
outtextxy(83,215,'7');
setcolor(11);
outtextxy(92,215,'4');
setcolor(14);
outtextxy(18,226,'7');
setcolor(11);
outtextxy(27,226,'5');
outtextxy(36,226,'2');
outtextxy(46,226,'8');
setcolor(14);
outtextxy(55,226,'4');
setcolor(11);
outtextxy(64,226,'1');
outtextxy(74,226,'6');
outtextxy(83,226,'9');
setcolor(14);
outtextxy(92,226,'3');
setcolor(11);
outtextxy(18,236,'4');
outtextxy(27,236,'3');
setcolor(14);
outtextxy(36,236,'6');
setcolor(11);
outtextxy(46,236,'9');
setcolor(14);
outtextxy(55,236,'7');
setcolor(11);
outtextxy(64,236,'2');
setcolor(14);
outtextxy(74,236,'1');
setcolor(11);
outtextxy(83,236,'8');
outtextxy(92,236,'5');
setcolor(14);
outtextxy(18,247,'6');
setcolor(11);
outtextxy(27,247,'2');
outtextxy(36,247,'9');
outtextxy(46,247,'4');
outtextxy(55,247,'5');
outtextxy(64,247,'7');
outtextxy(74,247,'8');
setcolor(14);
outtextxy(83,247,'3');
setcolor(11);
outtextxy(92,247,'1');
setcolor(14);
outtextxy(18,257,'1');
setcolor(11);
outtextxy(27,257,'7');
outtextxy(36,257,'5');
setcolor(14);
outtextxy(46,257,'3');
setcolor(11);
outtextxy(55,257,'2');
setcolor(14);
outtextxy(64,257,'8');
setcolor(11);
outtextxy(74,257,'4');
setcolor(14);
outtextxy(83,257,'6');
setcolor(11);
outtextxy(92,257,'9');
outtextxy(18,267,'3');
setcolor(14);
outtextxy(27,267,'4');
setcolor(11);
outtextxy(36,267,'8');
outtextxy(46,267,'6');
outtextxy(55,267,'1');
setcolor(14);
outtextxy(64,267,'9');
setcolor(11);
outtextxy(74,267,'7');
outtextxy(83,267,'5');
setcolor(14);
outtextxy(92,267,'2');
setcolor(11);
setcolor(14);
outtextxy(258,158,'1');
outtextxy(279,158,'7');
outtextxy(398,158,'8');
outtextxy(318,179,'9');
outtextxy(358,179,'3');
outtextxy(258,198,'6');
outtextxy(298,198,'1');
outtextxy(238,198,'9');
outtextxy(398,198,'7');
outtextxy(278,219,'1');
outtextxy(318,239,'4');
outtextxy(238,239,'7');
outtextxy(298,219,'5');
outtextxy(318,258,'7');
outtextxy(278,258,'6');
outtextxy(378,218,'7');
outtextxy(398,239,'3');
outtextxy(358,258,'1');
outtextxy(238,279,'6');
outtextxy(378,279,'3');
outtextxy(238,298,'1');
outtextxy(298,298,'3');
outtextxy(338,298,'8');
outtextxy(378,298,'6');
outtextxy(258,318,'4');
outtextxy(338,318,'9');
outtextxy(398,318,'2');
setcolor(15);
outtextxy(192,397,'<<<<<< SUDOKU Y SOLUCION >>>>>>');
end;
function adelante : boolean;
var
t : boolean;
begin
if columna = 9 then
begin
line2 := line2 + 1;
columna := 1;
end
else
columna := columna + 1;
if line2 = 10 then
t := false
else
t := true;
adelante := t;
if init[line2,columna] and t then
adelante := adelante;
end;
function atras : boolean;
var
k : boolean;
begin
if columna = 1 then
begin
line2 := line2 - 1;
columna := 9;
end
else
columna := columna - 1;
if line2 = 0 then
begin
k := false;
end
else
k := true;
atras := k;
if init[line2,columna] and k then
atras := atras;
end;