unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Menus, jpeg, ExtCtrls, ComCtrls;
type Tfieldpic =
class(TImage)
private
FFieldx : Integer;
FFieldy : integer;
public
property Fieldx : integer
read FFieldx
write FFieldx;
property Fieldy : integer
read FFieldy
write FFieldy;
end;
type
TForm1 =
class(TForm)
MainMenu1: TMainMenu;
men1: TMenuItem;
Info1: TMenuItem;
Label1: TLabel;
Lbrown: TLabel;
Lblue: TLabel;
LTeamblue: TLabel;
LTeamBrown: TLabel;
Label3: TLabel;
Label2: TLabel;
Lbluepoints: TLabel;
Lbrownpoints: TLabel;
Lbluebaer: TLabel;
Lbluefuchs: TLabel;
Lbluejaeger: TLabel;
Lblueholzfaeller: TLabel;
Lblueente: TLabel;
Lbluefasan: TLabel;
Lbrownbaer: TLabel;
Lbrownfuchs: TLabel;
Lbrownjaeger: TLabel;
Lbrownholzfaeller: TLabel;
Lbrownfasan: TLabel;
Lbrownente: TLabel;
Lbrownbaum: TLabel;
StatusBar1: TStatusBar;
Image1: TImage;
Lbluecountd: TLabel;
Lbrowncountd: TLabel;
Itest: TImage;
procedure men1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
procedure Gamestart;
procedure ShowStartWindow;
procedure ShowCard(x,y: integer);
procedure OnImageClick(Sender: TObject);
end;
type Tcardtype = (jae, holzf, baer, fuchs, fasan, ente, nadel, laub, nocard);
Tteam = (blue, brown);
Tpic = (nopic, shown, hidden);
Tamount =
record
jae,
holzf,
baer,
fuchs,
fasan,
ente,
nadel,
laub,
hidden: integer;
end;
Tlastpos =
record
x,
y: integer;
end;
Tpicindex =
record
typ: integer;
mark: boolean;
end;
Tpicpos =
record
top,
left: integer;
end;
{ Tcoord = record
x,
y:integer;
end;
}
Tfield =
record
// coord: Tcoord;
typ : Tcardtype;
team: Tteam;
lastpos: Tlastpos;
value: integer;
picstatus: Tpic;
pic: Tfieldpic;
picindex: Tpicindex;
{0=jaeleft
1=jaeright
2=jaeup
3=jaedown
4=holzf
5=baer
6=fuchs
7=fasan
8=ente
9=rueck
10=none
11=nadel
12=laub }
picpos: Tpicpos;
end;
Tplayer =
record
name:
string;
team: Tteam;
amount: Tamount;
points: integer;
turnsleft: integer;
end;
var
Form1: TForm1;
plblue, plbrown: Tplayer;
totala:Tamount;
onturn: Tteam;
clickone, clicktwo: Tfield;
gameon: boolean;
fields:
array[1..7,1..7]
of Tfield;
//[1,1] ist oben links, erst x dann y
piclist:
array[0..12,0..1]
of Tbitmap;
Cjae, Cholzf, Cbaer, Cfuchs, Cfasan, Cente, Cnadel, Claub, Cnone: Tfield;
implementation
Uses Unit2;
{$R *.DFM}
procedure Tform1.Gamestart;
//legt Zustand beim Starten eines Spiels fest
var i, x, y:integer;
begin
Form1.Lblue.Caption:=plblue.
name;
Form1.Lbrown.Caption:=plbrown.
name;
with totala
do //legt die anzahl der Karten jeder Sorte fest
begin
jae := 8;
holzf:=2;
baer:=2;
fuchs:=6;
fasan:=8;
ente:=7;
nadel:=7;
laub:=8;
hidden:=48;
end;
onturn:=blue;
//Blau ist als Erstes am Zug
//Bilder der Bildliste zusweisen
for i:=0
to 9
do
begin
piclist[i,0]:=Tbitmap.create;
end;
for i:=11
to 12
do
begin
piclist[i,0]:=Tbitmap.create;
end;
for i:=0
to 8
do
begin
piclist[i,1]:=Tbitmap.create;
end;
piclist[0,0].Loadfromfile(ExtractFilePath(ParamStr(0)) + '
pictures\jaeleft.bmp');
piclist[1,0].Loadfromfile(ExtractFilePath(ParamStr(0)) + '
pictures\jaeright.bmp');
piclist[2,0].Loadfromfile(ExtractFilePath(ParamStr(0)) + '
pictures\jaeup.bmp');
piclist[3,0].Loadfromfile(ExtractFilePath(ParamStr(0)) + '
pictures\jaedown.bmp');
piclist[4,0].Loadfromfile(ExtractFilePath(ParamStr(0)) + '
pictures\holzf.bmp');
piclist[5,0].Loadfromfile(ExtractFilePath(ParamStr(0)) + '
pictures\baer.bmp');
piclist[6,0].Loadfromfile(ExtractFilePath(ParamStr(0)) + '
pictures\fuchs.bmp');
piclist[7,0].Loadfromfile(ExtractFilePath(ParamStr(0)) + '
pictures\fasan.bmp');
piclist[8,0].Loadfromfile(ExtractFilePath(ParamStr(0)) + '
pictures\ente.bmp');
piclist[9,0].Loadfromfile(ExtractFilePath(ParamStr(0)) + '
pictures\rueck.bmp');
piclist[11,0].Loadfromfile(ExtractFilePath(ParamStr(0)) + '
pictures\nadel.bmp');
piclist[12,0].Loadfromfile(ExtractFilePath(ParamStr(0)) + '
pictures\laub.bmp');
piclist[0,1].Loadfromfile(ExtractFilePath(ParamStr(0)) + '
pictures\jaeleftm.bmp');
piclist[1,1].Loadfromfile(ExtractFilePath(ParamStr(0)) + '
pictures\jaerightm.bmp');
piclist[2,1].Loadfromfile(ExtractFilePath(ParamStr(0)) + '
pictures\jaeupm.bmp');
piclist[3,1].Loadfromfile(ExtractFilePath(ParamStr(0)) + '
pictures\jaedownm.bmp');
piclist[4,1].Loadfromfile(ExtractFilePath(ParamStr(0)) + '
pictures\holzfm.bmp');
piclist[5,1].Loadfromfile(ExtractFilePath(ParamStr(0)) + '
pictures\baerm.bmp');
piclist[6,1].Loadfromfile(ExtractFilePath(ParamStr(0)) + '
pictures\fuchsm.bmp');
piclist[7,1].Loadfromfile(ExtractFilePath(ParamStr(0)) + '
pictures\fasanm.bmp');
piclist[8,1].Loadfromfile(ExtractFilePath(ParamStr(0)) + '
pictures\entem.bmp');
//Position für die Bilder auf den Feldern zuweisen
With fields[1,1]
do //erste Spalte
begin
picpos.top:=21;
picpos.left:=212;
end;
With fields[1,2]
do
begin
picpos.top:=107;
picpos.left:=212;
end;
With fields[1,3]
do
begin
picpos.top:=193;
picpos.left:=212;
end;
With fields[1,4]
do
begin
picpos.top:=280;
picpos.left:=212;
end;
With fields[1,5]
do
begin
picpos.top:=367;
picpos.left:=212;
end;
With fields[1,6]
do
begin
picpos.top:=453;
picpos.left:=212;
end;
With fields[1,7]
do
begin
picpos.top:=539;
picpos.left:=212;
end;
With fields[2,1]
do //zweite Spalte
begin
picpos.top:=21;
picpos.left:=299;
end;
With fields[2,2]
do
begin
picpos.top:=107;
picpos.left:=299;
end;
With fields[2,3]
do
begin
picpos.top:=193;
picpos.left:=299;
end;
With fields[2,4]
do
begin
picpos.top:=280;
picpos.left:=299;
end;
With fields[2,5]
do
begin
picpos.top:=366;
picpos.left:=299;
end;
With fields[2,6]
do
begin
picpos.top:=453;
picpos.left:=299;
end;
With fields[2,7]
do
begin
picpos.top:=539;
picpos.left:=299;
end;
With fields[3,1]
do //dritte Spalte
begin
picpos.top:=20;
picpos.left:=385;
end;
With fields[3,2]
do
begin
picpos.top:=107;
picpos.left:=385;
end;
With fields[3,3]
do
begin
picpos.top:=193;
picpos.left:=385;
end;
With fields[3,4]
do
begin
picpos.top:=280;
picpos.left:=385;
end;
With fields[3,5]
do
begin
picpos.top:=366;
picpos.left:=385;
end;
With fields[3,6]
do
begin
picpos.top:=453;
picpos.left:=385;
end;
With fields[3,7]
do
begin
picpos.top:=539;
picpos.left:=385;
end;
With fields[4,1]
do //vierte Spalte
begin
picpos.top:=20;
picpos.left:=471;
end;
With fields[4,2]
do
begin
picpos.top:=106;
picpos.left:=471;
end;
With fields[4,3]
do
begin
picpos.top:=193;
picpos.left:=471;
end;
With fields[4,4]
do
begin
picpos.top:=280;
picpos.left:=471;
end;
With fields[4,5]
do
begin
picpos.top:=366;
picpos.left:=471;
end;
With fields[4,6]
do
begin
picpos.top:=452;
picpos.left:=471;
end;
With fields[4,7]
do
begin
picpos.top:=538;
picpos.left:=471;
end;
With fields[5,1]
do // fünfte Spalte
begin
picpos.top:=20;
picpos.left:=556;
end;
With fields[5,2]
do
begin
picpos.top:=106;
picpos.left:=556;
end;
With fields[5,3]
do
begin
picpos.top:=192;
picpos.left:=556;
end;
With fields[5,4]
do
begin
picpos.top:=279;
picpos.left:=556;
end;
With fields[5,5]
do
begin
picpos.top:=365;
picpos.left:=556;
end;
With fields[5,6]
do
begin
picpos.top:=452;
picpos.left:=556;
end;
With fields[5,7]
do
begin
picpos.top:=537;
picpos.left:=556;
end;
With fields[6,1]
do //sechste Spalte
begin
picpos.top:=19;
picpos.left:=642;
end;
With fields[6,2]
do
begin
picpos.top:=106;
picpos.left:=642;
end;
With fields[6,3]
do
begin
picpos.top:=192;
picpos.left:=642;
end;
With fields[6,4]
do
begin
picpos.top:=279;
picpos.left:=642;
end;
With fields[6,5]
do
begin
picpos.top:=365;
picpos.left:=642;
end;
With fields[6,6]
do
begin
picpos.top:=452;
picpos.left:=642;
end;
With fields[6,7]
do
begin
picpos.top:=538;
picpos.left:=642;
end;
With fields[7,1]
do //siebte Spalte
begin
picpos.top:=18;
picpos.left:=728;
end;
With fields[7,2]
do
begin
picpos.top:=105;
picpos.left:=728;
end;
With fields[7,3]
do
begin
picpos.top:=191;
picpos.left:=728;
end;
With fields[7,4]
do
begin
picpos.top:=278;
picpos.left:=728;
end;
With fields[7,5]
do
begin
picpos.top:=364;
picpos.left:=728;
end;
With fields[7,6]
do
begin
picpos.top:=451;
picpos.left:=728;
end;
With fields[7,7]
do
begin
picpos.top:=537;
picpos.left:=728;
end;
//Alle Bilder zeigen Rückseite, außerdem Koordinaten zuweisen, sowie parent:=form1
for x:=1
to 7
do
begin
for y:=1
to 7
do
begin
with fields[x,y]
do
begin
pic:=Tfieldpic.create(Form1);
pic.parent:=form1;
pic.Left:=fields[x,y].picpos.left;
pic.top:=fields[x,y].picpos.top;
pic.picture.assign(piclist[9,0]);
pic.onclick := OnImageClick;
pic.fieldy:=y;
pic.fieldx:=x;
picstatus:=hidden;
picindex.typ:=9;
picindex.mark:=false;
end;
end;
end;
//Mittelfeld bleibt leer
with fields[4,4]
do
begin
pic.picture.assign(
nil);
picstatus:=nopic;
picindex.typ:=10;
end;
with Cjae
do
begin
typ:=jae;
team:=brown;
value:=5;
end;
end;
procedure Tform1.ShowStartWindow;
//Abfrage Fenster um Spielernamen und Spielerfarbe festzulegen
begin
Form2.Showmodal;
// Form2.Eplayer1.text :=''; //falls man leere EDIT-Fenster beim Starten haben will
// Form2.Eplayer2.Text :='';
end;
procedure Tform1.ShowCard(x,y: integer);
//Prozedur zum Umdrehen einer Karte , x und y um wieder das richtige Feld ansprechen zu können
var rand,rand2: integer;
begin
rand:=random(48)+1;
//1..8jae 9..10holzf 11..12baer 13..18fuchs 19..26fasan 27..33ente 34..40nadel 41..48laub
{die Zahlen 1-8 sollen das Umdrehen eines Jägers zur Folge haben, die Zahlen 9-10 das eines holzfällers, usw}
//jae tritt ein
if (rand=1)
or (rand=2)
or (rand=3)
or (rand=4)
or (rand=5)
or (rand=6)
or (rand=7)
or (rand=8)
then //falls rand 1-8 soll versucht werden einen Jaeger umzudrehen
begin
if totala.jae>0
then //falls noch Jäger im Spiel sind (es dürfen maximal 8 Jäger im Spiel sein)
begin
rand2:=random(4)+1;
//zweite Zufallsvariable, da Jäger in vier richtungen aufgedeckt werden können
//1=schussrichtung links, 2=Schussrichtung rechts, 3=schussrichtung oben, 4=schussrichtung unten
fields[x,y]:=Cjae;
// dem Feld werden die standardmäßigen Jäger eigenschaften zugewiesen
totala.jae:=totala.jae-1;
//1jaeleft 2jaeright 3jaeup 4jaedown
if rand2=1
then //Jaeger mit schuss nach links wird erzeugt
begin
fields[1,1].pic.picture.assign(piclist[0,0]);
//Bild mit dem nach linksgerichteten Jäger wird zugewiesen
fields[x,y].picindex.typ:=0;
//die dazugehörige Bildindexnummer wird zugewiesen
fields[x,y].picstatus:=shown;
end
else if rand2=2
then //Jaeger mit schuss nach rechts wird erzeugt (rest wie oben)
begin
fields[1,1].pic.picture.assign(piclist[1,0]);
fields[x,y].picindex.typ:=1;
fields[x,y].picstatus:=shown;
end
else if rand2=3
then
begin
fields[1,1].pic.picture.assign(piclist[2,0]);
fields[x,y].picindex.typ:=2;
fields[x,y].picstatus:=shown;
end
else if rand2=4
then
begin
fields[1,1].pic.picture.assign(piclist[3,0]);
fields[x,y].picindex.typ:=3;
fields[x,y].picstatus:=shown;
end;
end
else if totala.jae=0
then //falls schon alle Jäger aufgedeckt waren Prozedur nochmal ausführen (später führt dies zum aufdecken der anderen Karten)
begin
showmessage('
alle 8 jäger aufgedeckt');
ShowCard(x,y);
end;
end
//iwasanderes tritt ein
else
begin
showmessage('
kein Jäger');
end;
end;
procedure TForm1.OnImageClick(Sender: TObject);
//Beim Klicken auf ein Feld
var x,y: integer;
begin
x:=Tfieldpic(Sender).Fieldx;
//Feldkoordinaten von obenlinks aus gesehen zuweisen, sodass
y:=Tfieldpic(Sender).Fieldy;
// die Koordinaten verwendet werden können durch den Array eines
// Feldes das richtige Feld ansprechen zu können
if fields[x,y].picstatus=hidden
then //Falls Karte noch nicht aufgedeckt
begin
ShowCard(x,y);
//führe die Prozedur: Aufdecken der Karte aus , x und y werden übergeben damit das feld angesprochen werden kann auf das geklickt wurde
showmessage('
erfolgreicherdurchlauf');
end
else if fields[x,y].picstatus=nopic
then
begin
showmessage('
keine Karte')
end
else if fields[x,y].picstatus=shown
then
begin
showmessage('
nicht versteckt');
end;
end;
procedure TForm1.men1Click(Sender: TObject);
//"Neues Spiel"
var securetyquestion: integer;
begin
if gameon=true
then begin
securetyquestion:= MessageDlg('
Neues Spiel?',mtError, mbOKCancel, 0);
//sicherheisfrage nötig!
if securetyquestion = mrOK
then begin
Form1.ShowStartWindow;
end
else if securetyquestion = mrCancel
then begin
end;
end
else if gameon=false
then begin
Form1.ShowStartWindow;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
//beim Starten des Programms
begin
Lblue.Caption:='
Spieler 1';
Lbrown.Caption:='
Spieler2';
end;
procedure TForm1.FormClose(Sender: TObject;
var Action: TCloseAction);
//beim Schließen des Programms
var i,x,y:integer;
begin
//Speicherplatz für die Bilder wieder freigeben
for x:=1
to 7
do
begin
for y:=1
to 7
do
begin
fields[x,y].pic.free;
end;
end;
for i:=0
to 11
do
begin
piclist[i,0].free;
piclist[i,1].free;
end;
end;
end.