program L1;
uses crt, graph,dos;
const n=10;
type field= array[1..n] of array [1..n] of boolean;
matrix= object
CellWidth:integer;
x,y,QuitX,QuitY:integer;
game_flag:byte;
xInit,yInit:integer;
NumofMines:integer;
colour,pattern,CellColour:word;
mines,marked: field;
constructor Init;
procedure DrawCounter(counter:string);
procedure DrawQuitButton;
procedure DrawMatrix;
procedure FillMines;
function MarkMines: boolean;
procedure GameOver;
procedure OpenCells(i,j:integer);
procedure DrawOpenedCells(i,j:integer);
function IsMine(a,b:integer):boolean;
function DetectMines(a,b:integer):integer;
end;
procedure show_mouse;
var reg:registers;
begin
reg.ax:=$01;
intr($33,reg);
end;
Procedure hide_mouse;
Inline( $B8/$02/$00/
$CD/$33);
procedure get_mouse_coordinates(var b:byte;var x,y:word);
var reg:registers;
begin
reg.ax:=$03;
intr($33,reg);
with reg do begin
b:=bl;
x:=cx;
y:=dx;
end;
end;
procedure mouse_goto(x,y:word);
var reg:registers;
begin
with reg do begin
ax:=$04;
cx:=x;
dx:=y;
end;
intr($33,reg);
end;
constructor matrix.Init;
var i,j:byte;
begin
CellWidth:=25;
CellColour:=11;
x:=GetMaxX div 3;
y:=GetMaxY div 3;
NumofMines:=15;
game_flag:=0;
xInit:=x; yInit:=y;
QuitX:=xInit;
QuitY:=yInit-CellWidth;
colour:=0;
pattern:=1;
for i:=1 to n do
for j:=1 to n do
marked[i][j]:=FALSE;
end;
procedure matrix.DrawCounter(counter:string);
var xF,yF:integer;
begin
xF:=xInit-2;
yF:=GetMaxY div 10;
SetColor(4);
SetFillStyle(8,12);
Bar3D(xF,yF,xF+CellWidth*n+7,yF+50,0,FALSE);
SetFillStyle(1,10);
Bar3D(xF+CellWidth*n div 3+10, yF+10, xF+CellWidth*n div 3+40,yF+40,0,FALSE);
SetTextStyle(4,0,3);
OutTextXY(xF+CellWidth*n div 3+12, yF+10,counter);
end;
procedure matrix.DrawQuitButton;
begin
SetColor(8);
SetFillStyle(1,7);
SetColor(0);
Bar3D(QuitX,QuitY,QuitX+CellWidth*n,QuitY+20,0,FALSE);
OutTextXY(QuitX+CellWidth*3,QuitY+2,'Quit');
end;
procedure matrix.DrawMatrix;
var i,j: integer;
begin
mouse_goto(colour,pattern);
show_mouse;
SetColor(colour);
SetFillStyle(pattern,CellColour);
for i:=1 to 10 do
begin
for j:=1 to 10 do
begin
Bar3D(x,y,x+CellWidth,y+CellWidth,0,FALSE);
x:=x+CellWidth;
end;
x:=x-CellWidth*10;
y:=y+CellWidth;
end;
end;
procedure matrix.FillMines;
var i,j,k:integer;
begin
for i:=1 to n do
for j:=1 to n do
mines[i][j]:=FALSE;
Randomize;
k:=0;
repeat
i:=Random(n-1)+1; j:=Random(n-1)+1;
if mines[i][j]<> TRUE then begin
mines[i][j]:=TRUE;
inc(k);
end;
until k=NumofMines;
end;
function matrix.IsMine(a,b:integer):boolean;
var i,j:integer;
begin
i:=(a-xInit)div CellWidth+1;
j:=(b-yInit)div CellWidth+1;
if mines[i][j]=TRUE then IsMine:=TRUE;
end;
function matrix.DetectMines(a,b:integer):integer;
var i,j,m:integer;
begin
m:=0;
i:=(a-xInit)div CellWidth+1;
j:=(b-yInit)div CellWidth+1;
if i+1<=n then
begin
if mines[i+1][j]=TRUE then inc(m);
if (j-1>0)and(mines[i+1][j-1]=TRUE) then inc(m);
if (j+1<=n)and(mines[i+1][j+1]=TRUE) then inc(m);
end;
if i-1>0 then
begin
if mines[i-1][j]=TRUE then inc(m);
if(j+1<=n)and(mines[i-1][j+1]=TRUE) then inc(m);
if (j-1>0) and(mines[i-1][j-1]=TRUE) then inc(m);
end;
if j+1<=n then
if mines[i][j+1]=TRUE then inc(m);
if j-1>0 then
if mines[i][j-1]=TRUE then inc(m);
DetectMines:=m;
end;
procedure matrix.DrawOpenedCells(i,j: integer);
var NM:string; NumofNearMines,a,b: integer;
begin
a:=xInit+CellWidth*(i-1);
b:=yInit+CellWidth*(j-1);
SetFillStyle(1,14);
Bar3D(a,b,a+CellWidth,b+CellWidth,0,FALSE);
NumofNearMines:=DetectMines(a,b);
if NumofNearMines>0 then
begin
Str(NumofNearMines,NM);
OutTextXY(a+CellWidth div 3,b+CellWidth div 3,NM);
end;
if mines[i][j]=TRUE then
begin
SetFillStyle(1,0);
FillEllipse(a+CellWidth div 2,b+CellWidth div 2,3,3);
end;
end;
procedure matrix.OpenCells(i,j:integer);
var a,b,t:integer;
begin
a:=xInit+CellWidth*(i-1);
b:=yInit+CellWidth*(j-1);
t := 0;
if (i < 1) or (j < 1) then t := 1;
if (i = n+1) or (j = n+1) then t := 1;
if t = 0 then
begin
if (marked[i][j] = FALSE) then
begin
if mines[i][j]=TRUE then exit;
marked[i][j] := TRUE;
DrawOpenedCells(i,j);
if mines[i][j] = FALSE then
begin
OpenCells(i+1,j);
OpenCells(i-1,j);
OpenCells(i,j-1);
OpenCells(i,j+1);
OpenCells(i-1,j-1);
OpenCells(i+1,j-1);
OpenCells(i-1,j+1);
OpenCells(i+1,j+1);
end;
end;
end;
end;
function matrix.MarkMines:boolean;
var mouseX,mouseY,TextX,TextY,H,M,S,S100:word;
i,j,x1,y1:integer; counter:string;
OpenOK,PressButton: boolean; Button:byte;
SFirst:longint;
begin
OpenOK:=FALSE; PressButton:=FALSE;
Str(NumofMines,counter);
DrawCounter(counter);
Init;
while TRUE do
begin
if game_flag=1 then
begin
MarkMines:=FALSE;
Exit;
end;
get_mouse_coordinates(Button,MouseX,MouseY);
if(Button>0)and(MouseX in [QuitX..QuitX+Cellwidth*n])and(MouseY in [QuitY..QuitY-CellWidth]) then Exit;
if (MouseX > xInit) and(MouseY >yInit) then
begin
i:= (MouseX-xInit)div CellWidth+1;
j:=(MouseY-yInit)div CellWidth+1;
case Button of
2: begin
if marked[i][j]<>TRUE then
begin
marked[i][j]:=TRUE;
dec(NumofMines);
Str(NumofMines,counter);
DrawCounter(counter);
TextX:=xInit+(CellWidth)*(i-1)+CellWidth div 3;
TextY:=yInit+(CellWidth)*(j-2)+CellWidth div 2;
OutTextXY(TextX,TextY,'*');
end;
end;
1: begin
if mines[i][j]=TRUE then begin
DrawOpenedCells(i,j);
MarkMines :=FALSE;
exit;
end;
SetTextStyle(0,0,1);
x:=xInit+CellWidth*(i-1);
y:=yInit+CellWidth*(j-1);
mouse_goto(x-CellWidth,y-CellWidth);
OpenCells(i,j);
end;
end;
end;
end;
end;
procedure matrix.GameOver;
begin
SetColor(4);
TextColor(128);
SetTextStyle(7,0,5);
OutTextXY(xInit,10,'GAME OVER');
end;
var mines,marked: ^field;
i,j,Err:integer; matrix1:^matrix;
begin
i:=detect;
InitGraph(i,j,'');
Err:=GraphResult;
if Err<>grOK then
WriteLn(GraphErrorMsg(Err))
else
begin
New(Matrix1,Init);
Matrix1^.DrawMatrix;
Matrix1^.DrawQuitButton;
Matrix1^.FillMines;
if Matrix1^.MarkMines=FALSE then Matrix1^.GameOver;
ReadLn;
Dispose(Matrix1);
CloseGraph;
end;
end.
end.