{$APPTYPE CONSOLE}
{$R+,Q+,X-}
uses
System.SysUtils,
Windows;
const
FIELDSIZE: Byte = 7;
type
TSize = 1 .. 7;
TSTATE = (leer, Bombe);
TDIR = (Nord, NordOst, Ost, SüdOst, Süd, SüdWest, West, NordWest);
TFIELD =
array [TSize, TSize]
of TSTATE;
TVISIBLE =
array [TSize, TSize]
of Boolean;
const
OFFSET_X:
array [TDIR]
of integer = (0, 1, 1, 1, 0, -1, -1, -1);
OFFSET_Y:
array [TDIR]
of integer = (1, 1, 0, -1, -1, -1, 0, 1);
// Setzt die Ausgabeposition der Konsole auf die angegebene Koordinate.
// @param
// x,y - zu setzende Position in der Konsole an 0/0 = oben links
procedure setConsolePosition(x, y: Byte);
var
coord: _COORD;
begin
coord.x := x;
coord.y := y;
if SetConsoleCursorPosition(GetStdHandle(STD_OUTPUT_HANDLE), coord)
then;
end;
// Setzt die Textfarbe der Konsole
// @param
// color - zu setzender Farbwert
procedure setTextColor(color: word);
begin
if SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE), color)
then
end;
// Initialisiert das Feld leer und das Sichbarkeitsfeld mit 'false'
// Setzt in gerundet 10% aller Zellen eine Bombe
// @param
// field - Feld, welches initialisiert wird
// visible - zu setzendes Sichtbarkeitsfeld
procedure initField(
var field: TFIELD;
var visible: TVISIBLE);
var
x, y, r, s: integer;
begin
for x := 1
to FIELDSIZE
do
begin
for y := 1
to FIELDSIZE
do
begin
visible[x, y] := FALSE;
field[x, y] := leer;
end;
end;
r := (FIELDSIZE * FIELDSIZE)
div 10;
s := (FIELDSIZE * FIELDSIZE)
mod 10;
if s >= 5
then
inc(r);
// Bomben platzieren
randomize;
while r > 0
do
begin
x := Random(FIELDSIZE) + 1;
// Random liefert einen Wert 0..(FIELDSIZE - 1)
y := Random(FIELDSIZE) + 1;
if field[x, y] = leer
then
begin
field[x, y] := Bombe;
Dec(r);
end;
end;
end;
// Prüft, ob eine Koordinate gültig ist
// @param
// x,y - zu überprüfende Koordinatenwerte
// @out
// Überprüfung ob Koordinate im Bereich des Spielfeldes liegt
// @return
// true, wenn Koordinaten gültig sind
function isValidCoord(x, y: integer): Boolean;
begin
if ((x <= FIELDSIZE)
and (x >= 1))
then
if ((y <= FIELDSIZE)
and (y >= 1))
then
isValidCoord := TRUE
else
isValidCoord := FALSE;
end;
// Zeigt an, wie viele Bomben sich auf den Nachbarzellen, der übergebenen
// Koordinate befinden
// @param
// field - Spielfeld, welches geprüft wird
// x,y - Koordinaten
// @out
// Bestimmung der Nachbarzellen
// @return
// byte-Wert, wie viele Bomben in den Nachbarzellen existieren
function countBombs(field: TFIELD; x, y: TSize): Byte;
var
dir: TDIR;
xNachbar, yNachbar: integer;
n: Byte;
begin
n := 0;
for dir := low(TDIR)
to high(TDIR)
do
begin
xNachbar := x + OFFSET_X[dir];
yNachbar := y + OFFSET_Y[dir];
if ((xNachbar > 0)
and (xNachbar < 8)
and (yNachbar > 0)
and (yNachbar < 8))
then
if field[xNachbar, yNachbar] = Bombe
then
inc(n);
end;
countBombs := n;
end;
// Textausgabe des Spielfeldes in der Konsole
// @param
// field - Spielfeld, welches ausgegeben werden soll
// visible - augedeckte Zellen
procedure printField(field: TFIELD; visible: TVISIBLE);
var
x, y: TSize;
s:
string;
n, i, j: integer;
begin
setConsolePosition(0, 0);
for i := 0
to 10
do
begin
for j := 0
to 150
do
begin
write('
');
end;
writeln;
end;
setConsolePosition(0, 0);
for x := low(TSize)
to high(TSize)
do
begin
for y := low(TSize)
to high(TSize)
do
begin
if not visible[x, y]
then
begin
setTextColor(7);
s := '
▓'
end
else if not visible[x, y]
and (field[x, y] = Bombe)
then
s := '
ð'
else
begin
n := countBombs(field, x, y);
case n
of
0:
s := '
';
1:
begin
setTextColor(9);
s := '
1';
end;
2:
begin
setTextColor(2);
s := '
2';
end;
3:
begin
setTextColor(12);
s := '
3';
end;
4:
begin
setTextColor(1);
s := '
4';
end;
5:
begin
setTextColor(4);
s := '
5';
end;
6:
begin
setTextColor(3);
s := '
6';
end;
7:
begin
setTextColor(15);
s := '
7';
end;
end;
end;
write(s, '
');
end;
writeln;
end;
end;
// liest vom Benutzer Spalte und Zeile ein und prüft diese. Außerdem wird der
// Benutzer gefragt ob die gewählte Zelle aufgedeckt oder als Bombe markiert
// oder das Programm mit der Eingabe von x beendet werden soll
// @param
// x,y - x- und y-Koordinate des Spielfeldes
// cancel - soll das Spiel verlassen werden?
// bomb - soll eine Bombe markiert werden?
// @out
//
// @return
function readInput(
var x, y: TSize;
var cancel, bomb: Boolean): Boolean;
var
gueltig: Boolean;
eingabeX, eingabeY, eingabeZ: char;
visible: TVISIBLE;
field: TFIELD;
begin
gueltig := FALSE;
cancel := FALSE;
readInput := gueltig
or cancel
or bomb;
writeln;
writeln('
Bitte eine Zeile von 1 bis 7 eingeben oder ''
X''
für Abbruch: ');
readln(eingabeX);
eingabeX := upcase(eingabeX);
case eingabeX
of
'
X':
begin
cancel := TRUE;
readInput := TRUE;
end;
'
1' .. '
7':
begin
gueltig := TRUE;
x := StrToInt(eingabeX);
end;
else
readInput := FALSE;
end;
if not cancel
and gueltig
then
begin
gueltig := FALSE;
writeln('
Bitte eine Spalte von 1 bis 7 eingeben oder ''
X''
für Abbruch: ');
readln(eingabeY);
eingabeY := upcase(eingabeY);
case eingabeY
of
'
X':
begin
cancel := TRUE;
readInput := TRUE;
end;
'
1' .. '
7':
begin
gueltig := TRUE;
y := StrToInt(eingabeY);
end
else
readInput := FALSE;
end;
end;
if not cancel
and gueltig
and isValidCoord(x, y)
then
begin
writeln('
Bitte ein ''
B''
eingeben, wenn dort eine Bombe markiert werden ' +
'
soll, leer lassen zum Aufdecken oder ''
X''
für Abbruch: ');
readln(eingabeZ);
eingabeZ := upcase(eingabeZ);
case eingabeZ
of
'
B':
begin
if ((field[x, y] = Bombe)
and visible[x, y])
then
begin
bomb := TRUE;
if field[x, y] = Bombe
then
visible[x, y] := FALSE;
cancel := TRUE;
writeln('
PENG!!!');
end;
end;
'
X':
begin
readInput := TRUE;
cancel := TRUE;
end
else
begin
readInput := FALSE;
visible[x, y] := TRUE;
end;
end;
visible[x, y] := TRUE;
end;
end;
// Prüft, ob das gesamte Spielfeld mit Ausnahme der Bomben aufgedeckt ist
// @param
// field - Spielfeld, in dem geprüft werden soll
// visible -Sichtbarkeit der Zellen
// @out
//
// @return
// true, wenn alle Zellen außer die Bomben aufgedeckt sind
function isFieldSolved(field: TFIELD; visible: TVISIBLE): Boolean;
var
x, y: TSize;
z, b: integer;
begin
z := 0;
b := 0;
for x := 1
to FIELDSIZE
do
for y := 1
to FIELDSIZE
do
begin
if visible[x, y]
then
inc(z);
if field[x, y] = Bombe
then
inc(b);
end;
isFieldSolved := z = FIELDSIZE * FIELDSIZE - b;
end;
// -------------------------------------------------------------------------------
var
field: TFIELD;
visible: TVISIBLE;
cancel, bomb, gueltig: Boolean;
x, y: TSize;
dir: TDIR;
xNachbar, yNachbar: integer;
begin
gueltig := FALSE;
initField(field, visible);
repeat
while not cancel
do
begin
repeat
printField(field, visible);
setTextColor(15);
cancel := readInput(x, y, cancel, bomb);
visible[x, y] := TRUE;
// weitere Zellen werden aufgedeckt, wenn in keiner Nachbarzelle eine Bombe ist
if countBombs(field, x, y) = 0
then
for dir := low(TDIR)
to high(TDIR)
do
begin
xNachbar := x + OFFSET_X[dir];
yNachbar := y + OFFSET_Y[dir];
if ((xNachbar > 0)
and (xNachbar < 8)
and (yNachbar > 0)
and
(yNachbar < 8))
then
visible[xNachbar, yNachbar] := TRUE;
end;
until gueltig
or cancel;
if cancel
then
begin
writeln('
Ende');
readln;
end
// wenn eine Bombe aufgedeckt wird
end;
until isFieldSolved(field, visible)
or cancel;
writeln('
Tschüss! Bis zum nächsten Mal');
readln;
end.