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:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:

unit snake;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, startsetting, MMSystem, IdHTTP;

const
  farben: Array [0..2] of TColor = (clBlack, clLime, clRed);
  raster: integer = 10;
  breite: integer = 32;
  hoehe: integer = 32;
type
  TForm1 = class(TForm)
  start: TButton;
  hoch: TButton;
  links: TButton;
  rechts: TButton;
  runter: TButton;
  Timer1: TTimer;
  PaintBox1: TPaintBox;
    Panel1: TPanel;
    ptext: TLabel;
    punkte: TLabel;
    Edit1: TEdit;
    sendscore: TButton;
    showscore: TButton;
    settings: TButton;
  procedure startClick(Sender: TObject);
  procedure Timer1Timer(Sender: TObject);
  procedure hochClick(Sender: TObject);
  procedure linksClick(Sender: TObject);
  procedure rechtsClick(Sender: TObject);
  procedure runterClick(Sender: TObject);
  procedure FormCreate(Sender: TObject);
  procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  procedure settingsClick(Sender: TObject);
  procedure showscoreClick(Sender: TObject);
  procedure sendscoreClick(Sender: TObject);
private
  map: Array [0..32] of Array [0..32] of Integer;
  kopf,
  richtung,
  futter: TPoint;
  laenge: Integer;
  ende: Boolean;
  procedure game_over;
  procedure new_food;
  procedure draw_map;
  procedure snake;
  procedure PaintFromFile;
public
  function SendPostData(Ahttp: TIdHTTP; const AtoURL: string;
  const aParams: TStrings): string;
end;

var
  Form1: TForm1;
  p:integer;

implementation

uses score;

{$R *.dfm}
{$R source.RES}     //(BRC32 -r datei.rc) zur Erstellung der Resourcen-Datei

//Anfang functions

function ShowMessageNew(const AText, ACaption: string; const ResID: Integer; Style: Cardinal = MB_OK): Cardinal;
var
  lpMsgBoxParams : MsgBoxParams;
begin
with lpMsgBoxParams do
begin
  cbSize             := SizeOf(lpMsgBoxParams);
  hwndOwner          := Application.Handle;
  hInstance          := SysInit.hInstance;
  lpszText           := PChar(AText);
  lpszCaption        := PChar(ACaption);
  dwStyle            := MB_USERICON or MB_TOPMOST or Style;
  lpszIcon           := MAKEINTRESOURCE(ResID);
  dwContextHelpID    := 0;
  lpfnMsgBoxCallback := nil;
  dwLanguageId       := LANG_ENGLISH;
end;
  Result := Cardinal(MessageBoxIndirect(lpMsgBoxParams));
end;

function TForm1.SendPostData(Ahttp: TIdHTTP; const AtoURL: string;
const aParams: TStrings): string;
  //Ahttp: Die HTTP Komponente von Indy 9.0
  //AtoURL: An diese URL werden die Informationen gesendet
  //Result: HTML-Antwort
Var
  lStream: TMemoryStream; //HTML-Result des PHP-Scripts
  lParams: TStringStream;
  I: Integer;
begin
  Result:='';
if not Assigned(aHttp) then
  exit;
  lStream := TMemoryStream.create;
  lParams := TStringStream.create('');
try
  AHTTP.Request.ContentType := 'application/x-www-form-urlencoded';
for I:=0 to aParams.Count-1 do
  lParams.WriteString(aParams[I] + '&');       //Streamdaten erzeugen
try
  AHTTP.Post(AtoURL, lParams, lStream);        //Stream mit php verknüpfen
except
  MessageBox(Self.Handle, 'Es konnte nicht auf die Online ' +
  'Highscoreliste zugegriffen werden. Bitte stellen sie sicher, ' +
  'das eine Verbindung zum Internet besteht.', 'Fehler', MB_OK or MB_ICONSTOP);
end;
  SetLength(Result,lStream.Size);
  lStream.Position:=0;
  lStream.ReadBuffer(Result[1],lStream.Size);
finally
  lParams.Free;
  lStream.Free;
end;
end;

//Ende Functions - Anfang procedures

procedure TForm1.FormCreate(Sender: TObject);
begin
  randomize;
  sound := True;
  Form1.Color:=RGB(83,126,7);
  Panel1.Color:=RGB(201,126,7);
  ptext.Color:=RGB(201,126,7);
  punkte.Color:=RGB(201,126,7);
  speed:=100;
  end;

procedure TForm1.draw_map;
var i,j: integer; col:TColor;
begin
for i := 0 to breite do
for j := 0 to hoehe do
begin
case map[i, j] of
  -1: col := farben[1];
   0: col := farben[0];
else
      col := farben[2];
end;
  PaintBox1.Canvas.Brush.Color:=col;
  PaintBox1.Canvas.FillRect(Rect(i*raster, j*raster, (i+1)*raster, (j+1)*raster));
end;
end;

procedure TForm1.snake;
var i,j: Integer;
begin
for i := 0 to breite do
for j := 0 to hoehe do
if map[i,j]>0 then
  Dec(map[i,j]);
  Inc(kopf.X, richtung.X);
  Inc(kopf.Y, richtung.Y);
if (kopf.X<0) or (kopf.X>breite) or (kopf.Y<0) or (kopf.Y>hoehe) then
begin
  game_over;
  ShowMessageNew('Du bist gegen die Wand gestoßen!', 'Game over!', 101);
end;
if (map[kopf.X, kopf.Y]>0) and (not ende) then
begin
  game_over;
  ShowMessageNew('Du hast dich selbst gebissen!', 'Game over!', 101);
end;
if (kopf.X=futter.X) and (kopf.Y=futter.Y) then begin
  Inc(laenge);
  new_food;
  p:=p+1;
  punkte.Caption:=inttostr(p);
  ptext.Caption:='   Punkte hast du'+#13+'schon gefressen!';
end;
  map[kopf.X, kopf.Y] := laenge;
end;

procedure TForm1.game_over;
begin
if p>=20 then begin
  sendscore.Enabled := True;
  showscore.Enabled := True;
  Edit1.Enabled := True;
end;
if sound = True then begin
  PlaySound(PChar('down'), hInstance, snd_ASync or snd_Resource);
end;
  //PlaySound(nil, 0, 0);   -> Kein Sound bzw anhalten?!
  ende := True;
  Timer1.Enabled := False;
  start.Enabled := True;
  settings.Enabled := True;
  showscore.Enabled := True;
  PaintFromFile();
end;

procedure TForm1.new_food;
begin
  futter := Point(Random(breite), Random(hoehe));
while map[futter.X, futter.Y]<>0 do
  futter:= Point(Random(breite), Random(hoehe));
  map[futter.X,futter.Y] := -1;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  snake;
if not ende then
  draw_map;
end;

procedure TForm1.startClick(Sender: TObject);
var
  i, j: Integer;
begin
  timer1.interval := speed;
if sound = True then begin                                                      //Einstellungen und so...

  PlaySound(PChar('tetris'), hInstance, snd_ASync or snd_Resource or SND_Loop);   //Einstellungen und so...
  end;                                                                            //Einstellungen und so...
  //-----------------------
  settings.Enabled := False;
  start.Enabled := False;
  showscore.Enabled := False;
  sendscore.Enabled := False;
  Edit1.Enabled := False;
for i:=0 to breite do
for j:=0 to hoehe do
  map[i, j] := 0;
  kopf := Point(1, 1);
  laenge := 5;
  richtung := Point(0, 1);
  map[kopf.X, kopf.Y] := laenge;
  new_food;
  draw_map;
  ende := False;
  Timer1.Enabled := True;
  p:=0;
  punkte.Caption:=inttostr(p);
  ptext.Caption:='   Punkte hast du'+#13+'schon gefressen!';
end;

procedure TForm1.hochClick(Sender: TObject);
begin
if richtung.Y=0 then
  richtung :=Point(0,-1);
end;

procedure TForm1.linksClick(Sender: TObject);
begin
if richtung.X=0 then
  richtung:=point(-1,0);
end;

procedure TForm1.rechtsClick(Sender: TObject);
begin
if richtung.X=0 then
  richtung:=Point(1,0);
end;

procedure TForm1.runterClick(Sender: TObject);
begin
if richtung.Y=0 then
  richtung:= Point(0,1);
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if (Key = VK_LEFT) then
  links.Click();
if (Key = VK_RIGHT) then
  rechts.Click();
if (Key = VK_UP) then
  hoch.Click();
if (Key = VK_DOWN) then
  runter.Click();
if (Key = VK_DELETE) then
  start.Click();
end;

procedure TForm1.PaintFromFile;
var
  bmp: TBitmap;
begin
  bmp := TBitmap.create;
  bmp.LoadFromResourceName(hinstance, 'picsnake');
  PaintBox1.Canvas.Draw(0,0, bmp);
  bmp.free;
end;

procedure TForm1.settingsClick(Sender: TObject);
begin
  Form2.ShowModal;
end;

procedure TForm1.sendscoreClick(Sender: TObject);
var
  sList: TStringlist;
  Antwort: string;
  MyIdHTTP: TIdHTTP;
begin
  sList:=TStringList.Create;
  MyIdHTTP:= TIdHTTP.Create(nil);
try
  sList.Add('n=' + Edit1.Text);
  sList.Add('p=' + inttostr(p));
  sendscore.Enabled := False;
  Edit1.Enabled := False;
  Antwort:=(SendPostData(MyIdHTTP, 'url',sList));
finally
  sList.Free;
  MyIdHTTP.Free;
end;
if Antwort = '3' then begin
  Form3.Show;
end
else begin
  MessageBox(Self.Handle, PChar('Es ist ein Fehler bei der übertragung ' +
  'der Punkte aufgetreten. Fehler: ' + Antwort), 'Fehler', MB_OK or MB_ICONSTOP);
end;
end;

procedure TForm1.showscoreClick(Sender: TObject);
begin
  Form3.Show;
end;

end.					

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:

unit startsetting;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;

type
  TForm2 = class(TForm)
  Label3: TLabel;
  Label4: TLabel;
  TrackBar1: TTrackBar;
  Button1: TButton;
  Label5: TLabel;
  cbsound: TCheckBox;
  procedure Button1Click(Sender: TObject);
private
  { Private-Deklarationen }
public
  { Public-Deklarationen }
end;

var
  Form2: TForm2;
  speed: integer;
  sound: Boolean;

implementation

uses snake;

{$R *.dfm}

procedure TForm2.Button1Click(Sender: TObject);
begin

if cbsound.State = cbChecked then begin
  sound := True;
end
else begin
  sound := False;
end;

case Trackbar1.Position of
  1 : speed:=100;
  2 : speed:=80;
  3 : speed:=60;
  4 : speed:=40;
  5 : speed:=20;
end;
  Form2.Close;
end;

end.					

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:

unit score;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, INIFiles, IdHTTP, StdCtrls, ShellAPI;

type
  TForm3 = class(TForm)
  lb_Info1: TLabel;
  lb_Info10: TLabel;
  lb_Info11: TLabel;
  lb_Info12: TLabel;
  lb_Info13: TLabel;
  lb_Info2: TLabel;
  lb_Info3: TLabel;
  lb_Info4: TLabel;
  lb_Info5: TLabel;
  lb_Info6: TLabel;
  lb_Info7: TLabel;
  lb_Info8: TLabel;
  lb_Info9: TLabel;
  lb_Name1: TLabel;
  lb_Name10: TLabel;
  lb_Name2: TLabel;
  lb_Name3: TLabel;
  lb_Name4: TLabel;
  lb_Name5: TLabel;
  lb_Name6: TLabel;
  lb_Name7: TLabel;
  lb_Name8: TLabel;
  lb_Name9: TLabel;
  lb_Punkte1: TLabel;
  lb_Punkte10: TLabel;
  lb_Punkte2: TLabel;
  lb_Punkte3: TLabel;
  lb_Punkte4: TLabel;
  lb_Punkte5: TLabel;
  lb_Punkte6: TLabel;
  lb_Punkte7: TLabel;
  lb_Punkte8: TLabel;
  lb_Punkte9: TLabel;
  Button1: TButton;
  Button2: TButton;
  procedure FormShow(Sender: TObject);
  procedure Button1Click(Sender: TObject);
  procedure Button2Click(Sender: TObject);
private
  { Private-Deklarationen }
  procedure Top10Eintragen;
public
  { Public-Deklarationen }
end;

var
  Form3: TForm3;

implementation

uses snake;

{$R *.dfm}

procedure TForm3.Button1Click(Sender: TObject);
begin
  Form3.Close;
end;

procedure TForm3.Button2Click(Sender: TObject);
begin
  ShellExecute(Application.Handle, 'open', 'url', nil, nil,SW_ShowNormal);
end;

procedure TForm3.FormShow(Sender: TObject);
begin
  Top10Eintragen;
end;

procedure TForm3.Top10Eintragen;
var
  sList: TStringlist;
  lStream: TFileStream;
  i: Integer;
  ini: TIniFile;
  MyIdHTTP: TIdHTTP;
begin
  // top10.php erstellt eine ini-Datei auf dem Serber mit den Top10. Diese Datei wird geloadet und angezeigt.
  MyIdHTTP:= TIdHTTP.Create(nil);
  sList:=TStringList.Create;
  lStream:=TFileStream.Create
  (ExtractFilePath(ParamStr(0)) + 'highscore.ini', fmCreate or fmShareDenyWrite);
try
  sList.Add('art=top10');
try
  Form1.SendPostData(MyIdHTTP,'url',sList);
  MyIdHTTP.Get('http://url',lStream);
except
  Close;
end;
finally
  lStream.Free;
  sList.Free;
end;
if FileExists(ExtractFilePath(ParamStr(0)) + 'highscore.ini') then begin
  ini:= TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'highscore.ini');
try
for I := 1 to 10 do begin
  TLabel(findcomponent('lb_Name'+inttostr(i))).Caption:= ini.ReadString(
  IntToStr(i), 'name', '');
  TLabel(findcomponent('lb_Punkte'+inttostr(i))).Caption:= ini.ReadString(
  IntToStr(i), 'punkte', '');
end;
finally
  ini.Free;
end;
end;
end;
end.