{ MINES2.PAS Copyright (c) Soul-Draco } { } { Mines v 1.0 } { =========== } { Created by soul_draco www.soul-draco.tk } { Program na hratie min simulujuce Mines z Windows. } { } { Datum:02.06.2005 http://www.trsek.com } uses crt,graph,mouse; const mines = 200; { pocet min v poli } width = 42; { sirka pole ( v polickach ) max 42 } height = 32; { sirka pole ( v polickach ) max 32 } size = 15; { strana policka } type tfield = record content : shortint; { policko, jak je ve skutecnosti } visible : shortint; { policko, jak ho hrac vidi } onscreen : shortint; { policko, jak je vykreslene } end; var gd,gm,i,j : integer; ch : char; field : array[-2..43,-2..33] of tfield; { hodnoty ve field : 0 - nezname policko 1 - 8 - cislice znacici pocet prilehlych min 9 - mina 10 - praporek 11 - prazdne policko } { inicializuje grafiku, generator nahodnych cisel a mys } procedure init; var gd,gm : integer; begin randomize; gd:=detect; initgraph(gd,gm,''); limitmousex(0,639); limitmousey(0,479); end; { *************************************************************************** Prace s polem *************************************************************************** } { spocita miny prilehle k policku[x,y]. pokud je policko samo mina, vrati 9 } function countadjacentmines(x,y : integer) : shortint; var i,j,counter : integer; begin counter:=0; if (field[x,y].content = 9) then begin countadjacentmines:=9; exit; end; for j:=(y - 1) to (y + 1) do for i:=(x - 1) to (x + 1) do if (field[i,j].content = 9) then inc(counter); if (counter = 0) then counter:=11; countadjacentmines:=counter; end; { odhali vsechna policka prilehla k policku[x,y] pokud jsou jiz vsechna odhalena, vrati false } function showadjancedfields(x,y : integer) : boolean; var i,j : integer; b : boolean; begin b:=false; for j:=(y - 1) to (y + 1) do for i:=(x - 1) to (x + 1) do if (field[i,j].visible <> field[i,j].content) then begin field[i,j].visible:=field[i,j].content; b:=true; end; showadjancedfields:=b; end; { vygeneruje nove pole } procedure generatefield; var i,j : integer; begin { ********************* vyprazdneni pole onscreen ************************* } for j:=-1 to height do for i:=-1 to width do field[i,j].onscreen:=99; { nesmysl - musi prekreslit } { *********************** generovani pole VISIBLE ************************* } { vyplneni celeho pole neznamymy policky } for j:=-1 to height do for i:=-1 to width do field[i,j].visible:=0; { *********************** generovani pole CONTENT ************************* } { vyplneni celeho pole prazdnymi policky } for j:=-1 to height do for i:=-1 to width do field[i,j].content:=11; { vygenerovani min . . . potom predelat, aby nesly pres sebe } for i:=0 to (mines - 1) do field[random(width),random(height)].content:=9; { vygenerovani cislic oznacujicich pocet min } for j:=-1 to height do for i:=-1 to width do field[i,j].content:=countadjacentmines(i,j); end; { projede pole a okolo kazdeho prazdneho policka odkryje prilehla policka } procedure a; var i,j : integer; b : boolean; begin b:=false; for j:=-1 to height do for i:=-1 to width do if (field[i,j].visible = 11) then begin if showadjancedfields(i,j) then a; end; end; { *************************************************************************** Vykresleni jednotlivych policek *************************************************************************** } procedure drawunknown(x,y : integer); begin setcolor(white); line(x,y,x + (size - 1),y); line(x,y,x,y + (size - 1)); line(x,y + 1,x + (size - 1) - 1,y + 1); line(x + 1,y,x + 1,y + (size - 1) - 1); setcolor(darkgray); line(x + (size - 1),y,x + (size - 1),y + (size - 1)); line(x,y + (size - 1),x + (size - 1),y + (size - 1)); line(x + (size - 1) - 1,y + 1,x + (size - 1) - 1,y + (size - 1)); line(x + 1,y + (size - 1) - 1,x + (size - 1) - 1,y + (size - 1) - 1); setfillstyle(1,lightgray); bar(x + 2,y + 2,x + (size - 1) - 2,y + (size - 1) - 2); end; procedure drawempty(x,y : integer); begin setfillstyle(1,lightgray); bar(x + 1,y + 1,x + (size - 1),y + (size - 1)); setcolor(darkgray); line(x,y,x + (size - 1),y); line(x,y,x,y + (size - 1)); end; procedure drawmine(x,y : integer); begin drawempty(x - 7,y - 7); setcolor(black); setfillstyle(1,black); fillellipse(x,y,3,3); line(x - 3,y - 3,x + 3,y + 3); line(x - 3,y + 3,x + 3,y - 3); line(x - 5,y,x + 5,y); line(x,y - 5,x,y + 5); setcolor(white); rectangle(x - 1,y - 1,x,y); end; procedure drawflag(x,y : integer); begin setcolor(black); line(x + 6,y + 9,x + 8,y + 9); line(x + 5,y + 10,x + 9,y + 10); line(x + 7,y + 2,x + 7,y + 8); setcolor(red); line(x + 3,y + 4,x + 7,y + 2); line(x + 3,y + 4,x + 7,y + 5); line(x + 3,y + 4,x + 7,y + 4); line(x + 4,y + 3,x + 7,y + 3); end; { vypise ciselo oznacujucich pocet prilehlych min } procedure drawnumber(x,y,number : integer); var s : string; begin drawempty(x,y); case number of 1 : setcolor(blue); 2 : setcolor(green); 3 : setcolor(lightred); 4 : setcolor(blue); 5 : setcolor(lightred); 6 : setcolor(cyan); 7 : setcolor(blue); 8 : setcolor(blue); end; str(number,s); outtextxy(x + 4,y + 4,s); end; { vrati x souradnici policka, na kterem je mys } function getmousex : integer; begin getmousex:=mousex div size; end; { vrati y souradnici policka, na kterem je mys } function getmousey : integer; begin getmousey:=mousey div size; end; procedure redrawfield; var i,j : integer; begin setmousecursor(vypnuto); for j:=0 to (height - 1) do for i:=0 to (width - 1) do { zjisteni, zda je policko potreba prekreslit } if (field[i,j].visible <> field[i,j].onscreen) then begin case field[i,j].visible of 0 : drawunknown(i * size,j * size); 1 : drawnumber(i * size,j * size,1); 2 : drawnumber(i * size,j * size,2); 3 : drawnumber(i * size,j * size,3); 4 : drawnumber(i * size,j * size,4); 5 : drawnumber(i * size,j * size,5); 6 : drawnumber(i * size,j * size,6); 7 : drawnumber(i * size,j * size,7); 8 : drawnumber(i * size,j * size,8); 9 : drawmine((i * size) + (size div 2),(j * size) + (size div 2)); 10 : drawflag(i * size,j * size); 11 : drawempty(i * size,j * size); end; field[i,j].onscreen:=field[i,j].visible; end; setmousecursor(zapnuto); end; procedure win; var x,y,sizex,sizey : integer; begin x:=200; y:=200; sizex:=220; sizey:=50; setcolor(white); line(x,y,x + (sizex - 1),y); line(x,y,x,y + (sizey - 1)); line(x,y + 1,x + (sizex - 1) - 1,y + 1); line(x + 1,y,x + 1,y + (sizey - 1) - 1); setcolor(darkgray); line(x + (sizex - 1),y,x + (sizex - 1),y + (sizey - 1)); line(x,y + (sizey - 1),x + (sizex - 1),y + (sizey - 1)); line(x + (sizex - 1) - 1,y + 1,x + (sizex - 1) - 1,y + (sizey - 1)); line(x + 1,y + (sizey - 1) - 1,x + (sizex - 1) - 1,y + (sizey - 1) - 1); setfillstyle(1,lightgray); bar(x + 2,y + 2,x + (sizex - 1) - 2,y + (sizey - 1) - 2); setcolor(black); outtextxy(x + 55,y + 10,'!! YOU WON !!'); outtextxy(x + 10,y + 30,'press any key to continue'); readkey; ch:=#13; end; procedure checkfield; var i,j,counter : integer; begin counter:=0; for j:=0 to height - 1 do for i:=0 to width - 1 do begin if (field[i,j].content <> field[i,j].visible) then inc(counter); if (field[i,j].content = 9) and (field[i,j].visible = 10) then dec(counter); end; if (counter = 0) then win; end; { odhali vsechny miny a zepta se na pokracovani } procedure gameover; var i,j : integer; begin for j:=-1 to height do for i:=-1 to width do if (field[i,j].content = 9) then begin field[i,j].visible:=9; end; redrawfield; readkey; ch:=#13; end; begin init; generatefield; redrawfield; setmousecursor(zapnuto); repeat ch:=#0; { pri kliknuti } if mousebut(1) then begin { odhaleni policka } field[getmousex,getmousey].visible:=field[getmousex,getmousey].content; if (field[getmousex,getmousey].visible = 9) then gameover; {} a; redrawfield; checkfield; end; if mousebut(2) then begin { odhaleni policka } if (field[getmousex,getmousey].visible = 0) then field[getmousex,getmousey].visible:=10 else if (field[getmousex,getmousey].visible = 10) then field[getmousex,getmousey].visible:=0; {} a; redrawfield; checkfield; delay(200); end; if keypressed then ch:=readkey; if ch = #13 then begin generatefield; redrawfield; end; until ch = #27; setmousecursor(vypnuto); closegraph; end.