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

   
Vista:

ayuda con el juego de PICA y FAMA

Publicado por kelvin kelvin_contrera_1@hotmail.com (8 intervenciones) el 14/01/2016 04:36:06
ayudaaaa lo he itentado hacer pero no me sale alguien plissss




El juego de PICA y FAMA consiste en deducir un número entero oculto de cuatro (4) dígitos denominado clave secreta, a partir de pistas obtenidas por números que suministra el jugador que intenta descubrir la clave. Así, se define como una FAMA la coincidencia entre un digito de la clave y uno del número suministrado, tanto del valor como de la posición que ocupa ese digito y como una PICA, la coincidencia entre un digito de la clave y una del número suministrado, en valor más no en la posición.

Elabore un programa en Pascal que permita jugar PICA y FAMA, de tal forma que el jugador, en a lo sumo cuatro (4) intentos, trate de deducir la clave. Muestre los resultados obtenidos en cada intento.

EJEMPLO:

Clave Secreta: 1236
1er Intento 6257 1 PICA y 1 FAMA
2do Intento 1273 1 PICA y 2 FAMAS
3er Intento 1236 4 FAMAS Ganaste!!!

NOTAS:
- Ninguno de los números debe tener dígitos repetidos (Validar dicha condición para el usuario)
- Implementar la función generadora de claves utilizando Random
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
información
Otras secciones de LWP con contenido de Pascal/Turbo Pascal
- Código fuente de Pascal/Turbo Pascal
- Cursos de Pascal/Turbo Pascal
- Temas de Pascal/Turbo Pascal
- Chat de Pascal/Turbo Pascal
información
Códigos de Pascal/Turbo Pascal
- Numeros Primos
- Numeros Primos
- Radar

ayuda con el juego de PICA y FAMA

Publicado por ramon (2072 intervenciones) el 23/01/2016 11:59:54
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
{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.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

ayuda con el juego de PICA y FAMA

Publicado por kelvin Kelvin_contrera_1@hotmail.com (8 intervenciones) el 25/01/2016 19:44:15
buenas tardes si me ayudaste con el juego gracias ahora me mandaron hacer un sudoku de 3x3 lo estoy haciendo pero no me corre muy bien espero tu ayuda muchas gracias
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

ayuda con el juego de PICA y FAMA

Publicado por ramon (2072 intervenciones) el 26/01/2016 13:50:58
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
{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;
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

ayuda con el juego de PICA y FAMA

Publicado por ramon (2072 intervenciones) el 26/01/2016 13:53:32
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
{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;
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

ayuda con el juego de PICA y FAMA

Publicado por ramon (2072 intervenciones) el 26/01/2016 13:55:28
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
{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.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

ayuda con el juego de PICA y FAMA

Publicado por ramon (2072 intervenciones) el 26/01/2016 14:05:00
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
{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;
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

ayuda con el juego de PICA y FAMA

Publicado por ramon (2072 intervenciones) el 26/01/2016 14:07:01
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
{cuatro 3 del archivo sudoku}
 
 
 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;
      if ((xs > 222) and (xs < 410)) and ((ys > 154) and (ys < 329)) then
      begin
         oculta_raton;
         case ys of
       154..168 : begin
                   case xs of
                 233..248 : begin
                               xk := 233;
                               yk := 154;
                               xx := 1;
                               yy := 1;
                            end;
                 252..268 : begin
                               xk := 252;
                               yk := 154;
                               xx := 2;
                               yy := 1;
                            end;
                 273..289 : begin
                               xk := 273;
                               yk := 154;
                               xx := 3;
                               yy := 1;
                            end;
                 293..308 : begin
                               xk := 293;
                               yk := 154;
                               xx := 4;
                               yy := 1;
                            end;
                 313..328 : begin
                               xk := 313;
                               yk := 154;
                               xx := 5;
                               yy := 1;
                            end;
                 333..349 : begin
                               xk := 333;
                               yk := 154;
                               xx := 6;
                               yy := 1;
                            end;
                 352..368 : begin
                               xk := 352;
                               yk := 154;
                               xx := 7;
                               yy := 1;
                            end;
                 373..388 : begin
                               xk := 373;
                               yk := 154;
                               xx := 8;
                               yy := 1;
                            end;
                 392..408 : begin
                               xk := 392;
                               yk := 154;
                               xx := 9;
                               yy := 1;
                            end;
                       end;
                  end;
       174..188 : begin
                   case xs of
                 233..248 : begin
                               xk := 233;
                               yk := 174;
                               xx := 1;
                               yy := 2;
                            end;
                 252..268 : begin
                               xk := 252;
                               yk := 174;
                               xx := 2;
                               yy := 2;
                            end;
                 273..289 : begin
                               xk := 273;
                               yk := 174;
                               xx := 3;
                               yy := 2;
                            end;
                 293..308 : begin
                               xk := 293;
                               yk := 174;
                               xx := 4;
                               yy := 2;
                            end;
                 313..328 : begin
                               xk := 313;
                               yk := 174;
                               xx := 5;
                               yy := 2;
                            end;
                 333..349 : begin
                               xk := 333;
                               yk := 174;
                               xx := 6;
                               yy := 2;
                            end;
                 352..368 : begin
                               xk := 352;
                               yk := 174;
                               xx := 7;
                               yy := 2;
                            end;
                 373..388 : begin
                               xk := 373;
                               yk := 174;
                               xx := 8;
                               yy := 2;
                            end;
                 392..408 : begin
                               xk := 392;
                               yk := 174;
                               xx := 9;
                               yy := 2;
                            end;
                       end;
                  end;
       194..208 : begin
                   case xs of
                 233..248 : begin
                               xk := 233;
                               yk := 194;
                               xx := 1;
                               yy := 3;
                            end;
                 252..268 : begin
                               xk := 252;
                               yk := 194;
                               xx := 2;
                               yy := 3;
                            end;
                 273..289 : begin
                               xk := 273;
                               yk := 194;
                               xx := 3;
                               yy := 3;
                            end;
                 293..308 : begin
                               xk := 293;
                               yk := 194;
                               xx := 4;
                               yy := 3;
                            end;
                 313..328 : begin
                               xk := 313;
                               yk := 194;
                               xx := 5;
                               yy := 3;
                            end;
                 333..349 : begin
                               xk := 333;
                               yk := 194;
                               xx := 6;
                               yy := 3;
                            end;
                 352..368 : begin
                               xk := 352;
                               yk := 194;
                               xx := 7;
                               yy := 3;
                            end;
                 373..388 : begin
                               xk := 373;
                               yk := 194;
                               xx := 8;
                               yy := 3;
                            end;
                 392..408 : begin
                               xk := 392;
                               yk := 194;
                               xx := 9;
                               yy := 3;
                            end;
                       end;
                  end;
       214..228 : begin
                   case xs of
                 233..248 : begin
                               xk := 233;
                               yk := 214;
                               xx := 1;
                               yy := 4;
                            end;
                 252..268 : begin
                               xk := 252;
                               yk := 214;
                               xx := 2;
                               yy := 4;
                            end;
                 273..289 : begin
                               xk := 273;
                               yk := 214;
                               xx := 3;
                               yy := 4;
                            end;
                 293..308 : begin
                               xk := 293;
                               yk := 214;
                               xx := 4;
                               yy := 4;
                            end;
                 313..328 : begin
                               xk := 313;
                               yk := 214;
                               xx := 5;
                               yy := 4;
                            end;
                 333..349 : begin
                               xk := 333;
                               yk := 214;
                               xx := 6;
                               yy := 4;
                            end;
                 352..368 : begin
                               xk := 352;
                               yk := 214;
                               xx := 7;
                               yy := 4;
                            end;
                 373..388 : begin
                               xk := 373;
                               yk := 214;
                               xx := 8;
                               yy := 4;
                            end;
                 392..408 : begin
                               xk := 392;
                               yk := 214;
                               xx := 9;
                               yy := 4;
                            end;
                       end;
                  end;
       234..248 : begin
                   case xs of
                 233..248 : begin
                               xk := 233;
                               yk := 234;
                               xx := 1;
                               yy := 5;
                            end;
                 252..268 : begin
                               xk := 252;
                               yk := 234;
                               xx := 2;
                               yy := 5;
                            end;
                 273..289 : begin
                               xk := 273;
                               yk := 234;
                               xx := 3;
                               yy := 5;
                            end;
                 293..308 : begin
                               xk := 293;
                               yk := 234;
                               xx := 4;
                               yy := 5;
                            end;
                 313..328 : begin
                               xk := 313;
                               yk := 234;
                               xx := 5;
                               yy := 5;
                            end;
                 333..349 : begin
                               xk := 333;
                               yk := 234;
                               xx := 6;
                               yy := 5;
                            end;
                 352..368 : begin
                               xk := 352;
                               yk := 234;
                               xx := 7;
                               yy := 5;
                            end;
                 373..388 : begin
                               xk := 373;
                               yk := 234;
                               xx := 8;
                               yy := 5;
                            end;
                 392..408 : begin
                               xk := 392;
                               yk := 234;
                               xx := 9;
                               yy := 5;
                            end;
                       end;
                  end;
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

ayuda con el juego de PICA y FAMA

Publicado por ramon (2072 intervenciones) el 26/01/2016 14:09:11
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
{cuatro 4 del archivo sudoku}
 
 254..268 : begin
                  case xs of
                 233..248 : begin
                               xk := 233;
                               yk := 254;
                               xx := 1;
                               yy := 6;
                            end;
                 252..268 : begin
                               xk := 252;
                               yk := 254;
                               xx := 2;
                               yy := 6;
                            end;
                 273..289 : begin
                               xk := 273;
                               yk := 254;
                               xx := 3;
                               yy := 6;
                            end;
                 293..308 : begin
                               xk := 293;
                               yk := 254;
                               xx := 4;
                               yy := 6;
                            end;
                 313..328 : begin
                               xk := 313;
                               yk := 254;
                               xx := 5;
                               yy := 6;
                            end;
                 333..349 : begin
                               xk := 333;
                               yk := 254;
                               xx := 6;
                               yy := 6;
                            end;
                 352..368 : begin
                               xk := 352;
                               yk := 254;
                               xx := 7;
                               yy := 6;
                            end;
                 373..388 : begin
                               xk := 373;
                               yk := 254;
                               xx := 8;
                               yy := 6;
                            end;
                 392..408 : begin
                               xk := 392;
                               yk := 254;
                               xx := 9;
                               yy := 6;
                            end;
                       end;
                 end;
     274..288 : begin
                 case xs of
                 233..248 : begin
                               xk := 233;
                               yk := 274;
                               xx := 1;
                               yy := 7;
                            end;
                 252..268 : begin
                               xk := 252;
                               yk := 274;
                               xx := 2;
                               yy := 7;
                            end;
                 273..289 : begin
                               xk := 273;
                               yk := 274;
                               xx := 3;
                               yy := 7;
                            end;
                 293..308 : begin
                               xk := 293;
                               yk := 274;
                               xx := 4;
                               yy := 7;
                            end;
                 313..328 : begin
                               xk := 313;
                               yk := 274;
                               xx := 5;
                               yy := 7;
                            end;
                 333..349 : begin
                               xk := 333;
                               yk := 274;
                               xx := 6;
                               yy := 7;
                            end;
                 352..368 : begin
                               xk := 352;
                               yk := 274;
                               xx := 7;
                               yy := 7;
                            end;
                 373..388 : begin
                               xk := 373;
                               yk := 274;
                               xx := 8;
                               yy := 7;
                            end;
                 392..408 : begin
                               xk := 393;
                               yk := 274;
                               xx := 9;
                               yy := 7;
                            end;
                       end;
                end;
    294..308 : begin
                case xs of
                 233..248 : begin
                               xk := 233;
                               yk := 294;
                               xx := 1;
                               yy := 8;
                            end;
                 252..268 : begin
                               xk := 252;
                               yk := 294;
                               xx := 2;
                               yy := 8;
                            end;
                 273..289 : begin
                               xk := 273;
                               yk := 294;
                               xx := 3;
                               yy := 8;
                            end;
                 293..308 : begin
                               xk := 293;
                               yk := 294;
                               xx := 4;
                               yy := 8;
                            end;
                 313..328 : begin
                               xk := 313;
                               yk := 294;
                               xx := 5;
                               yy := 8;
                            end;
                 333..349 : begin
                               xk := 333;
                               yk := 294;
                               xx := 6;
                               yy := 8;
                            end;
                 352..368 : begin
                               xk := 352;
                               yk := 294;
                               xx := 7;
                               yy := 8;
                            end;
                 373..388 : begin
                               xk := 373;
                               yk := 294;
                               xx := 8;
                               yy := 8;
                            end;
                 392..408 : begin
                               xk := 392;
                               yk := 294;
                               xx := 9;
                               yy := 8;
                            end;
                         end;
                     end;
    314..328 : begin
                case xs of
                 233..248 : begin
                               xk := 233;
                               yk := 314;
                               xx := 1;
                               yy := 9;
                            end;
                 252..268 : begin
                               xk := 252;
                               yk := 314;
                               xx := 2;
                               yy := 9;
                            end;
                 273..289 : begin
                               xk := 273;
                               yk := 314;
                               xx := 3;
                               yy := 9;
                            end;
                 293..308 : begin
                               xk := 293;
                               yk := 314;
                               xx := 4;
                               yy := 9;
                            end;
                 313..328 : begin
                               xk := 313;
                               yk := 314;
                               xx := 5;
                               yy := 9;
                            end;
                 333..349 : begin
                               xk := 333;
                               yk := 314;
                               xx := 6;
                               yy := 9;
                            end;
                 352..368 : begin
                               xk := 352;
                               yk := 314;
                               xx := 7;
                               yy := 9;
                            end;
                 373..388 : begin
                               xk := 373;
                               yk := 314;
                               xx := 8;
                               yy := 9;
                            end;
                 392..408 : begin
                               xk := 392;
                               yk := 314;
                               xx := 9;
                               yy := 9;
                            end;
                       end;
                  end
              else
                  begin
                      xx := 0;
                      yy := 0;
                  end;
               end;
     if (xx in[1..9]) or (yy in[1..9]) then
     begin
        SetFillPattern(fondo, 7);
        bar(xk + 4,yk + 3,xk + 11,yk + 12);
        tecla := readkey;
    if tecla in['1'..'9'] then
    begin
     if cual = 1 then
     begin
        sudoku.guego[xx,yy] := tecla;
     end;
     if cual = 2 then
     begin
         if (sudoku.guego[xx,yy] > ' ') and (prueba[xx,yy] <> ' ') then
         begin
            no := true;
            SetFillPattern(fondo, 0);
            bar(xk + 4,yk + 3,xk + 11,yk + 12);
            setcolor(14);
            outtextxy(xk + 5, yk + 4,sudoku.guego[xx,yy]);
         end
      else
         begin
            sudoku.guego[xx,yy] := tecla;
            {setcolor(10);
            outtextxy(5 + (xk div 4), yk + 4,sudoku.matriz[xx,yy]);
            setcolor(15);}
        end;
     end;
      if no = false then
      begin
        SetFillPattern(fondo, 0);
        bar(xk + 4,yk + 3,xk + 11,yk + 12);
        setcolor(15);
        outtextxy(xk + 5, yk + 4,tecla);
        SetFillPattern(fondo, 0);
       end;
     end;
   end;
        muestra_raton;
        pon_posicion_raton(xs,ys);
        setcolor(15);
        end;
       end;
 
     if keypressed then
     begin
     tec := readkey;
     end;
     xk := 0;
     yk := 0;
     xx := 0;
     yy := 0;
    until ((tec = #13) and (cual = 1)) or (tec = #27);
 
    if (tec = #13) and (cual = 1) then
    begin
        termina_sudoku(sudoku);
        for z1 := 1 to 9 do
          for z2 := 1 to 9 do
          begin
          sudoku.guego[z1,z2] := sudoku.matriz[z1,z2];
          outtextxy(z1 * 12,210 + z2 * 12,sudoku.matriz[z1,z2]);
          end;
      z1 := 1;
      z2 := 1;
      randomize;
    repeat
      z1 := random(9) + 1;
      z3 := random(9) + 1;
      sudoku.guego[z1,z3] := ' ';
    z2 := z2 + 1;
    until z2 > dific;
    SetFillPattern(fondo, 0);
    bar(4,41,getmaxx - 4,getmaxy - 21);
    pantalla;
          pl1 := 1;
          xp := ((getmaxx div 2) - (9 * 10)) + 9;
          yp := ((getmaxy div 2) - (9 * 10)) + 9;
          repeat
              pl2 := 1;
              repeat
                  setcolor(12);
                  outtextxy(xp, yp,sudoku.guego[pl2,pl1]);
                  setcolor(15);
              inc(pl2);
              inc(xp,20);
              until pl2 > 9;
          inc(pl1);
          inc(yp,20);
          xp := ((getmaxx div 2) - (9 * 10)) + 9;
          until pl1 > 9;
 
        bar((getmaxx div 2) - (26 * 10) + 2,(getmaxy div 2) - (8 * 10) + 190,
           (getmaxx div 2) + (28 * 10),(getmaxy div 2) - (8 * 10) + 228);
        outtextxy((getmaxx div 2) - (11 * 10) + 2,(getmaxy div 2) - (8 * 10) + 182,
        'DESEA GUARDARLO [S/N]');
    repeat
        tec:= readkey;
        if tec in ['s','S','n','N'] then
        begin
        end
      else
         begin
            write(^G);
         end;
    until tec in ['s','S','n','N'];
    if tec in ['s','S'] then
    begin
        bar((getmaxx div 2) - (11 * 10) + 2,(getmaxy div 2) - (8 * 10) + 182,
           (getmaxx div 2) + (11 * 10) + 2,(getmaxy div 2) - (8 * 10) + 218);
        outtextxy((getmaxx div 2) - (11 * 10) + 2,(getmaxy div 2) - (8 * 10) + 182,
        'ENTRE NIVEL : ');
        u := 1;
      repeat
        tec := readkey;
        if tec in['A'..'Z','a'..'z','¤','¥'] then
        begin
            sudoku.dificultac[0] := chr(u);
            sudoku.dificultac[u] := upcase(tec);
            outtextxy(((getmaxx div 2) - (11 * 10) + 115) + (u * 8) ,(getmaxy div 2) - (8 * 10) + 182,
                        sudoku.dificultac[u]);
            inc(u);
            if u > 255 then
            begin
                dec(u);
            end;
       end;
         if tec = #8 then
         begin
            dec(u);
            if u < 1 then
            begin
                u := 1;
            end;
            sudoku.dificultac[0] := chr(u);
            sudoku.dificultac[u] := ' ';
            outtextxy(((getmaxx div 2) - (11 * 10) + 115) + (u * 8) ,(getmaxy div 2) - (8 * 10) + 182,
                        sudoku.dificultac[u]);
         end;
      until tec = #13;
      i := 1;
      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 := ii;
            nombre := 'sudoku' + intstring(i) + '.suk';
            assign(f,nombre);
            rewrite(f);
            seek(f,0);
            write(f,sudoku);
            close(f);
          end;
      end;
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

ayuda con el juego de PICA y FAMA

Publicado por ramon (2072 intervenciones) el 26/01/2016 14:11:13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
{cuatro 5 del archivo sudoku}
 
 bar((getmaxx div 2) - (26 * 10) + 2,(getmaxy div 2) - (8 * 10) + 190,
           (getmaxx div 2) + (28 * 10),(getmaxy div 2) - (8 * 10) + 228);
      oculta_raton;
  end;
 
  procedure carga_juego_guardado;
  var
  conta, w, ii, yt, g, t : integer;
  tec : char;
  valot : word;
  begin
      fillchar(archivos.nom,sizeof(archivos.nom),' ');
      ii := 1;
      findfirst('*.jug',archive,dirinfo);
     while doserror = 0 do
     begin
         archivos.nom[ii] := dirinfo.name;
         inc(ii);
         if ii > 120 then
         ii := 120;
         findnext(dirinfo);
     end;
      conta := 0;
      conta := ii - 1;
      if conta = 0 then
      begin
          outtextxy((getmaxx div 2) - 180,55,'*** NO TIENE FICHEROS GUARDADOS ***');
          delay(3000);
          bar((getmaxx div 2) - 180,55,(getmaxx div 2) + 180,65);
      end
    else
       begin
      rectangle((getmaxx div 2) - 80,55,
           (getmaxx div 2) + 80,55 + (12 * conta));
 
      for w := 1 to ii do
      begin
          setcolor(15);
          outtextxy((getmaxx div 2) - 74,58 + ((w - 1) * 10),archivos.nom[w]);
      end;
      SetFillPattern(fondo, 7);
      bar((getmaxx div 2) - 76,57,
           (getmaxx div 2) + 77,65);
      SetFillPattern(fondo, 0);
      setcolor(15);
      w := 1;
      yt := 0;
      outtextxy((getmaxx div 2) - 74,58 + yt,archivos.nom[w]);
      para := false;
    repeat
        tec := readkey;
        if tec = #0 then
        valot := word(ord(readkey)) shl 8
      else
        valot := ord(tec);
     if valot = 20480 then
     begin
      SetFillPattern(fondo, 0);
      bar((getmaxx div 2) - 76,57 + yt,
           (getmaxx div 2) + 77,65 + yt);
      outtextxy((getmaxx div 2) - 74,58 + yt ,archivos.nom[w]);
         inc(w);
         inc(yt,10);
         if w > conta then
         begin
             dec(w);
             dec(yt,10);
         end;
         SetFillPattern(fondo, 7);
       bar((getmaxx div 2) - 76,57 + yt,
           (getmaxx div 2) + 77,65 + yt);
       setcolor(15);
       outtextxy((getmaxx div 2) - 74,58 + yt ,archivos.nom[w]);
     end;
     if valot = 18432 then
     begin
      SetFillPattern(fondo, 0);
      bar((getmaxx div 2) - 76,57 + yt,
           (getmaxx div 2) + 77,65 + yt);
       setcolor(15);
       outtextxy((getmaxx div 2) - 74,58 + yt ,archivos.nom[w]);
         dec(yt,10);
         dec(w);
         if w < 1 then
         begin
             inc(w);
             inc(yt,10);
         end;
        SetFillPattern(fondo, 7);
       bar((getmaxx div 2) - 76,57 + yt,
           (getmaxx div 2) + 77,65 + yt);
       setcolor(15);
       outtextxy((getmaxx div 2) - 74,58 + yt ,archivos.nom[w]);
     end;
     until (valot = 13) or (valot = 27);
     if valot = 13 then
     begin
      assign(f,archivos.nom[w]);
      reset(f);
      seek(f,0);
      read(f,sudoku);
      close(f);
      cagado := true;
     g := 1;
     nombar := archivos.nom[w];
      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);
      bar((getmaxx div 2) - 80,55,
           (getmaxx div 2) + 80,55 + (12 * conta));
      para := true;
      for w := 1 to 9 do
        for ii := 1 to 9 do
        begin
          prueba[w,ii] := sudoku.guego[w,ii];
        end;
      crea_sudocu(2);
    end;
  end;
 end;
 
   function intchar(n : integer) : char;
   var
      s : string[2];
   begin
       str(n,s);
       intchar := s[1];
   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;
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

ayuda con el juego de PICA y FAMA

Publicado por ramon (2072 intervenciones) el 26/01/2016 14:12:45
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
{cuatro 6 del archivo sudoku}
 
 procedure menu_generacion_sudoku;
  var
     pulsa : char;
     valori : word;
     xmp, ymp : integer;
     opcion : integer;
  begin
      pantalla;
      setcolor(10);
      outtextxy(20,50,'<<< GENERACION AUTOMATICA >>>');
      setcolor(15);
      rectangle(75,65,200,135);
      setcolor(7);
      rectangle(76,66,201,156);
      rectangle(75,136,200,157);
      rectangle(76,136,200,157);
      setcolor(15);
      outtextxy(88,72,' NIVEL BAJO  ');
      outtextxy(88,87,' NIVEL MEDIO ');
      outtextxy(88,102,' NIVEL ALTO  ');
     outtextxy(88,118,'    SALIR    ');
      setcolor(14);
      outtextxy(78,142,'* ELEJA NIVEL *');
      opcion := 1;
    repeat
        case opcion of
  1 : begin
          SetFillPattern(fondo, 0);
          bar(88,70,189,128);
          setcolor(15);
          outtextxy(88,72,' NIVEL BAJO  ');
          outtextxy(88,87,' NIVEL MEDIO ');
          outtextxy(88,102,' NIVEL ALTO  ');
          outtextxy(88,118,'    SALIR    ');
          SetFillPattern(fondo, 7);
          bar(88,71,186,81);
          setcolor(1);
          outtextxy(88,72,' NIVEL BAJO  ');
          setcolor(15);
      end;
  2 : begin
          SetFillPattern(fondo, 0);
          bar(88,70,198,128);
          setcolor(15);
          outtextxy(88,72,' NIVEL BAJO  ');
          outtextxy(88,87,' NIVEL MEDIO ');
          outtextxy(88,102,' NIVEL ALTO  ');
          outtextxy(88,118,'    SALIR    ');
          SetFillPattern(fondo, 7);
          bar(88,84,186,96);
          setcolor(1);
          outtextxy(88,87,' NIVEL MEDIO ');
          setcolor(15);
      end;
  3 : begin
          SetFillPattern(fondo, 0);
          bar(88,70,198,128);
          setcolor(15);
          outtextxy(88,72,' NIVEL BAJO  ');
          outtextxy(88,87,' NIVEL MEDIO ');
          outtextxy(88,102,' NIVEL ALTO  ');
          outtextxy(88,118,'    SALIR    ');
          SetFillPattern(fondo, 7);
          bar(88,100,186,110);
          setcolor(1);
          outtextxy(88,102,' NIVEL ALTO  ');
          setcolor(15);
      end;
  4 : begin
          SetFillPattern(fondo, 0);
          bar(88,70,198,128);
          setcolor(15);
          outtextxy(88,72,' NIVEL BAJO  ');
          outtextxy(88,87,' NIVEL MEDIO ');
          outtextxy(88,102,' NIVEL ALTO  ');
          outtextxy(88,118,'    SALIR    ');
          SetFillPattern(fondo, 7);
          bar(88,116,186,126);
          setcolor(1);
          outtextxy(88,118,'    SALIR    ');
          setcolor(15);
      end;
   end;
        pulsa := readkey;
        if pulsa = #0 then
        valori := word(ord(readkey)) shl 8
     else
        valori := ord(pulsa);
    if valori = 18432 then  {abajo}
    begin
        dec(opcion);
        if opcion < 1 then
        opcion := 1;
    end;
    if valori = 20480 then {arriba}
    begin
        inc(opcion);
        if opcion > 4 then
        opcion := 4;
    end;
    until (valori = 13) or (valori = 27);
    SetFillPattern(fondo, 0);
    bar(3,45,getmaxx - 2,getmaxy - 2);
    if valori = 13 then
    begin
       crear := opcion;
    end
  else
      begin
         crear := 0;
      end;
      setcolor(15);
  end;
 
  procedure pantalla_windows;
   var
      salimos : boolean;
      tecl : char;
      pulsado : integer;
  begin
      presenta_pantalla_inicio;
      muestra_raton;
      x := posx_raton;
      y := posy_raton;
      salimos := false;
      pulsado := 0;
 
    repeat
       if (x <> posx_raton) or (y <> posy_raton) then
       begin
           x := posx_raton;
           y := posy_raton;
       end;
      pulsado := boton_raton;
   if pulsado = 1 then
   begin
      oculta_raton;
   case y of
      28..34 : begin
           case x of
         13..69 : begin
                  SetFillPattern(fondo, 0);
                  bar(4,41,getmaxx - 4,getmaxy - 21);
                  sudok := false;
                  cargasudoku;
                  if sudok = true then
                  begin
                  crea_sudocu(2);
                  SetFillPattern(fondo, 0);
                  bar(150,getmaxy - 50,382,getmaxy - 40);
                  SetFillPattern(fondo, 0);
                  setcolor(15);
                  if soluccion = true then
                  begin
                  outtextxy(150,getmaxy - 50,'PARTIDA [OK] PULSA UNA[TECLA]');
                  for iy := 1 to 9 do
                    for ix := 1 to 9 do
                    outtextxy(16 + ix * 12,96 + iy * 12,sudoku.matriz[ix,iy]);
                  end
                else
                  begin
                  outtextxy(150,getmaxy - 50,'PARTIDA [NOK] PULSA UNA[TECLA]');
                  end;
                   repeat until keypressed;
                  end;
                  SetFillPattern(fondo, 0);
                  bar(4,41,getmaxx - 4,getmaxy - 21);
                  presenta_pantalla_inicio;
                  end;
       117..165 : begin
                  SetFillPattern(fondo, 0);
                  bar(4,41,getmaxx - 4,getmaxy - 21);
                  crea_sudocu(1);
                  SetFillPattern(fondo, 0);
                  bar(4,41,getmaxx - 4,getmaxy - 21);
                  presenta_pantalla_inicio;
                  end;
       214..261 : begin
                     salimos := true;
                  end;
       346..416 : begin
                   SetFillPattern(fondo, 0);
                   bar(4,41,getmaxx - 4,getmaxy - 21);
                   carga_juego_guardado;
                   SetFillPattern(fondo, 0);
                   bar(4,41,getmaxx - 4,getmaxy - 21);
                   presenta_pantalla_inicio;
                   end;
       473..617 : begin
                   SetFillPattern(fondo, 0);
                   bar(4,41,getmaxx - 4,getmaxy - 21);
                   menu_generacion_sudoku;
                   genera_sudoku(30);
                   if crear > 0 then
                   begin
                  case crear of
                 1 : begin
                        sudoku.dificultac := 'NIVEL BAJO';
                     end;
                 2 : begin
                        sudoku.dificultac := 'NIVEL MEDIO';
                     end;
                 3 : begin
                        sudoku.dificultac := 'NIVEL ALTO';
                     end;
                  end;
                   crea_sudocu(3);
                   if soluccion = true then
                   begin
                      outtextxy((getmaxx div 2) - 88,(getmaxy div 2) + 100,
                      '***** SOLUCCION OK *****');
                   end
                   else
                      begin
                       outtextxy((getmaxx div 2) - 88,(getmaxy div 2) + 100,
                      '***** SOLUCCION NO OK *****');
                      end;
                   setcolor(1);
                   outtextxy(20,getmaxy - 40,'** SOLUCION SUDOKU ** PULSE UNA TECLA');
                   repeat until keypressed;
                   end;
                   SetFillPattern(fondo, 0);
                   bar(4,41,getmaxx - 4,getmaxy - 21);
                   presenta_pantalla_inicio;
                  end;
               end;
             end;
         end;
        muestra_raton;
        pon_posicion_raton(x,y);
   end;
    if keypressed then
    begin
    tecl := readkey;
    end;
    until (salimos = true) or (tecl = #27);
    oculta_raton;
      setcolor(15);
      SetFillPattern(fondo, 0);
  end;
 
 
 
   begin
      graph_ini;
      iny := 1;
      para := false;
      pantalla_windows;
      SetFillPattern(OldPattern,0);
      CloseGraph;
   end.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

ayuda con el juego de PICA y FAMA

Publicado por ramon (2072 intervenciones) el 26/01/2016 14:17:03
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
{se compone de dos unidades y el programa}
 
unit sudokV;
 interface
 uses
     crt, dos,  graph;
  type
 
     sudoku_reg = record
          dificultac : string[15];
          matriz : array[1..9,1..9]of char;
           guego :  array[1..9,1..9]of char;
         partida : array[1..9,1..9]of char;
       end;
 
    archiv = record
               nom : array [1..120] of string[12];
              end;
 
   const
        fondo : FillPatternType = ($FF, $FF, $FF,
                                     $FF, $FF, $FF, $FF, $FF);
 
 
   var
     cierto : array[1..9,1..9] of integer;
     dific, xpx, ypy, xpp, ypp, crear : integer;
     z3, cu1, z1, z2, l1, l2, 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;
     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 : string;
     tepu, c, quit : char;
     suite, appel : boolean;
     sm : string;
     fecha : string[8];
     difi_cul : string[18];
 
    function worstring(xe : word) : string;
    function charinteger(dh : char) : integer;
    function fecha_hors : string;
    procedure graph_ini;
    function intstring(xe : integer) : string;
    function wordchar(nd : word) : char;
    function integerchar(nk : integer) : char;
    procedure pantalla;
    procedure presenta_pantalla_inicio;
 
   implementation
   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;
 
   procedure graph_ini;
   begin
       drive := detect;
       initgraph(drive,modo,' ');
       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;
  begin
  end.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

ayuda con el juego de PICA y FAMA

Publicado por kelvin (8 intervenciones) el 26/01/2016 15:29:32
gracias pero solo se unas partes basicas del programa que es lo que me han enseñado, lo que se quiere comporbar las lineas de las columnas y eso y cuando se ejecute el programa salga las matriz normal luego que salga otra mostrando solo los numeros que salgan utilizando random que modificaria con eso que me diste
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar