1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
| unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, jpeg, ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
P1: TImage;
P2: TImage;
P3: TImage;
P5: TImage;
P4: TImage;
P6: TImage;
P7: TImage;
P8: TImage;
P9: TImage;
P10: TImage;
P11: TImage;
P12: TImage;
P13: TImage;
P14: TImage;
P15: TImage;
P16: TImage;
P17: TImage;
P18: TImage;
P19: TImage;
P20: TImage;
P21: TImage;
P22: TImage;
P23: TImage;
P24: TImage;
Start: TButton;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
procedure SchwarzSetzt(var anzahl_schwarz:integer);
procedure StartClick(Sender: TObject);
procedure WeissSetzt(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure pruefmuehle(farbe: string);
private
public
end;
var
Form1: TForm1;
anzahl_weiss, anzahl_schwarz: integer;
feld: array [1..24] of TImage;
linie: array [1..16] of boolean;
implementation
{$R *.dfm}
procedure TForm1.WeissSetzt(Sender: TObject);
begin
IF anzahl_weiss>=1 then
begin
IF TImage(Sender).Tag=0 then
begin
TImage(Sender).Picture.LoadFromFile('muehlstein_weiss.bmp');
TImage(Sender).Tag:=1;
anzahl_weiss:=anzahl_weiss-1;
Label2.Caption:=inttostr(anzahl_weiss);
SchwarzSetzt(anzahl_schwarz);
end
else
begin
IF (TImage(Sender).Tag=1) OR (TImage(Sender).Tag=2) then Application.MessageBox('Hier befindet sich bereits ein Stein, bitte wählen Sie einen freien Platz!','Bereits belegt',MB_OK);
end;
end;
end;
procedure TForm1.SchwarzSetzt(var anzahl_schwarz:integer);
var gesetzt: boolean;
i: integer;
begin
gesetzt:=false;
Repeat
i:=random(23)+1;
If feld[i].Tag=0 then
begin
feld[i].Picture.LoadFromFile('muehlstein_schwarz.bmp');
feld[i].Tag:=2;
gesetzt:=true;
anzahl_schwarz:=anzahl_schwarz-1;
Label4.Caption:=inttostr(anzahl_schwarz);
end;
Until gesetzt=true;
pruefmuehle('schwarz');
end;
procedure TForm1.pruefmuehle(farbe: string);
var i,j,f: integer;
begin
If farbe='schwarz' then f:=2;
If farbe='weiss' then f:=1;
i:=1;
j:=1;
Repeat
If (feld[i].Tag=f) and (feld[i+1].Tag=f) and (feld[i+2].Tag=f) and (linie[j]=false) then
begin
linie[j]:= true;
end;
i:=i+1;
inc(j);
Until j=16;
end;
procedure TForm1.StartClick(Sender: TObject);
var i: integer;
begin
For i:=1 To 24 Do
begin
feld[i].Picture.LoadFromFile('muehlstein_leer.bmp');
feld[i].Tag:=0;
end;
anzahl_schwarz:=9;
anzahl_weiss:=9;
Label2.Caption:=inttostr(9);
Label4.Caption:=inttostr(9);
end;
procedure TForm1.FormCreate(Sender: TObject);
var i: integer;
begin
feld[1]:=P1;
feld[2]:=P2;
feld[3]:=P3;
feld[4]:=P4;
feld[5]:=P5;
feld[6]:=P6;
feld[7]:=P7;
feld[8]:=P8;
feld[9]:=P9;
feld[10]:=P10;
feld[11]:=P11;
feld[12]:=P12;
feld[13]:=P13;
feld[14]:=P14;
feld[15]:=P15;
feld[16]:=P16;
feld[17]:=P17;
feld[18]:=P18;
feld[19]:=P19;
feld[20]:=P20;
feld[21]:=P21;
feld[22]:=P22;
feld[23]:=P23;
feld[24]:=P24;
For i:=1 To 16 Do
begin
linie[i]:=false;
end;
end;
end. |