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:
171:
172:

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  StdCtrls;

const
  N = 5;
type
  TFeld = array[0..N-1, 0..N-1] of Boolean;

  { TForm1 }

  TForm1 = class(TForm)
    ckAutomatik: TCheckBox;
    Ende: TButton;
    Shape1: TShape;
    Shape10: TShape;
    Shape11: TShape;
    Shape12: TShape;
    Shape13: TShape;
    Shape14: TShape;
    Shape15: TShape;
    Shape16: TShape;
    Shape17: TShape;
    Shape18: TShape;
    Shape19: TShape;
    Shape2: TShape;
    Shape20: TShape;
    Shape21: TShape;
    Shape22: TShape;
    Shape23: TShape;
    Shape24: TShape;
    Shape25: TShape;

    Timer: TTimer;
    procedure btnLesenClick(Sender: TObject);
    procedure btnRechnenClick(Sender: TObject);
    procedure btnSchreibenClick(Sender: TObject);
    procedure ckAutomatikChange(Sender: TObject);
    procedure EndeClick(Sender: TObject);
    procedure Shape1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure TimerTimer(Sender: TObject);

  private

  public
    Feld: TFeld; // das ist der interne Speicher für die Zellen (=Shapes in der GUI)
    function LebtNachbar(x, y: Integer): Boolean;
    function AnzahlLebenderNachbarn(const x, y: Integer): Integer;
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

function TForm1.LebtNachbar(x, y: Integer): Boolean;
begin
  if (x < 0) then
    x := x +N;
  if (y < 0) then
    y := y +N;
   if (x > (N-1)) then
    x := x -N;
  if (y > (N-1)) then
    y := y -N;
  Result := Feld[x, y];
end;

function TForm1.AnzahlLebenderNachbarn(const x, y: Integer): Integer;
  var
    dx, dy: Integer;
begin
  Result := 0;
  for dy := -1 to 1 do
    for dx := -1 to 1 do begin
     if not ((dx=0) and (dy=0)) then
         if LebtNachbar(x +dx, y +dy) then
        Inc(Result);
    end;
end;


procedure TForm1.btnSchreibenClick(Sender: TObject);
var  x, y, snr: Integer;
    Shape: TShape;
begin
   for y := 0 to N-1 do
       for x := 0 to N-1 do begin
           snr := x +y *N +1;
           Shape := TShape(FindComponent('Shape' +IntToStr(snr)));
           if (feld[x,y]) then
              shape.brush.color := clblack
           else
             shape.brush.color := clwhite;
       end;

end;

procedure TForm1.ckAutomatikChange(Sender: TObject);
begin
    if ckAutomatik.Checked then begin // Haken reingeklickt
    btnLesenClick(Self); // Feld einlesen
    Timer.Enabled := True; // Timer einschalten
  end
  else // Haken rausgeklickt
    Timer.Enabled := False; // Timer ausschalten
end;

procedure TForm1.EndeClick(Sender: TObject);
begin
  close;
end;


procedure TForm1.Shape1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var  ThisShape: TShape;
begin
  ThisShape := (Sender as TShape);
  if (ThisShape.Brush.Color = clWhite) then
     ThisShape.Brush.Color := clBlack
  else
     ThisShape.Brush.Color := clWhite;
end;

procedure TForm1.TimerTimer(Sender: TObject);
begin
  btnrechnenClick(Self);
end;

procedure TForm1.btnLesenClick(Sender: TObject);
var x, y, snr: Integer;
    Shape: TShape;
begin
    for y := 0 to N-1 do // von unten nach oben
        for x := 0 to N-1 do begin // von rechts nach links
            snr := x +y *N +1;
            Shape := TShape(FindComponent('Shape' +IntToStr(snr)));
            if (Shape.Brush.Color = clBlack) then
               Feld[x, y] := True
            else
               Feld[x, y] := False;
        end;

end;

procedure TForm1.btnRechnenClick(Sender: TObject);
  var
    x, y: Integer;
    FeldNeu: TFeld;
begin
  for y := 0 to N-1 do
    for x := 0 to N-1 do
      if Feld[x, y] then // lebende Zelle
        FeldNeu[x, y] := (AnzahlLebenderNachbarn(x, y) in [2..3]) // Überleben
      else // tote Zelle
        FeldNeu[x, y] := (AnzahlLebenderNachbarn(x, y) = 3); // Geburt
  Feld := FeldNeu;
  btnSchreibenClick(Self); // virtuell auf den Button klicken

end;
end.					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:

function TForm1.LebtNachbar(x, y: Integer): Boolean;
begin
  if (x < 0) then
    x := x +N;
  if (y < 0) then
    y := y +N;
   if (x > (N-1)) then
    x := x -N;
  if (y > (N-1)) then
    y := y -N;
  Result := Feld[x, y];
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:

x  | x mod N
------------
0  |
1  |
2  |
3  |
4  |
5  |
6  |
17 |					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:

x  | x mod N
------------
0  |0
1  |1
2  |2
3  |3
4  |4
5  |5
6  |1
17 |2					

1:
2:
3:
4:

procedure TForm1.btnTestClick(Sender: TObject);
begin
  ShowMessageFmt('x=%d, N=%d, x mod N=%d', [0, 5, 0 mod 5]); // das ist praktisch die erste Zeile aus der Tabelle
end;