Miny z Windows v grafike

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Kategórie:
mines2.pngAutor: Soul-Draco
web: www.soul-draco.tk

Program: Mines2.pasMouse.pas
Soubor exe: Mines2.exe
Potřebné: Egavga.bgi

Toto sú presne tie isté miny ktoré poznáte z OS Windows. Naprogramované v grafike tak aby sa verne podobali tým vo Windows. Máte za úlohu označiť políčka s mínami. Jediným pomocníkom je že na odkrytom políčku sa zobrazuje počet mín okolo.
{ 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.