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:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
472:
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490:
491:
492:
493:
494:
495:
496:
497:
498:
499:
500:
501:
502:
503:
504:
505:
506:
507:
508:
509:
510:
511:
512:
513:
514:
515:
516:
517:
518:
519:
520:
521:
522:
523:
524:
525:
526:
527:
528:
529:
530:
531:
532:
533:
534:
535:
536:
537:
538:
539:
540:
541:
542:
543:
544:
545:
546:
547:
548:
549:
550:
551:

unit U_game;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, U_Timer, MM_Timer;

type
  HighscoreEintrag = record
    Name: String[100];
    Punkte: integer;
  end;

  Highscore = record
    Eintraege: array [1..5] of HighscoreEintrag
  end;


  TEinheit = class
    left,top,width,height: integer;
    art         : byte;
    status      : byte;
  end;

  TF_game = class(TForm)
    P_display: TPaintBox;
    B_start: TButton;
    Button2: TButton;
    Image1: TImage;
    T_gameloop: TTimer;
    I_schuss: TImage;
    T_schussbewegung: TMMTimer;
    T_Steuerung: TMMTimer;
    T_schussSteuerung: TTimer;
    Image2: TImage;
    MMTimer1: TMMTimer;
    T_GegnerSteuerung: TTimer;
    L_Punkte: TLabel;
    Label1: TLabel;
    Label2: TLabel;
    E_namenEingabe: TEdit;
    Button1: TButton;
    MMTimer2: TMMTimer;
    procedure FormCreate(Sender: TObject);
    procedure P_displayPaint(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure B_startClick(Sender: TObject);
    procedure T_gameloopTimer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure T_SteuerungTimer(Sender: TObject; Time: Cardinal);
    procedure T_schussbewegungTimer(Sender: TObject; Time: Cardinal);
    procedure T_schussSteuerungTimer(Sender: TObject);
    procedure T_GegnerSteuerungTimer(Sender: TObject);
    procedure MMTimer1Timer(Sender: TObject; Time: Cardinal);
    procedure Button1Click(Sender: TObject);
    procedure MMTimer2Timer(Sender: TObject; Time: Cardinal);
  private
    procedure GameLoop(Sender: TObject; var Done: Boolean);
    procedure startgame;
    procedure endgame;
    procedure savetobestenliste;
    function RectinRect(rect1,rect2: Trect): boolean;
    procedure WMNCHitTest(var M: TWMNCHitTest);
    message wm_NCHitTest;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  F_game: TF_game;
  backbild: TBitmap;
  WelraumHintergrund: TBitmap;
  Schiff: TEinheit;
  Schuesse: array [0..10] of TEinheit;
  Gegner: array [0..100] of TEinheit;
  start: boolean;
  Zeitzaehler: int64;
  Punkte: integer;
  Leertastewurdegedrueckt: boolean;
  Bestenliste: Highscore;

implementation

uses U_main;

{$R *.dfm}

procedure TF_game.WMNCHitTest (var M: TWMNCHitTest);
begin
  inherited;
  if M.Result = htClient then
    M.Result := htCaption;
end;

procedure TF_game.startgame;
var
  i: integer;
begin
  {Einheit status: 1=nichtsichtbar 2=sichtbar}

  For i:=0 to 10 do
  begin
    Schuesse[i] := TEinheit.Create;
    Schuesse[i].width := 5;
    Schuesse[i].height := 5;
    Schuesse[i].status := 1;
  end;

  For i:=0 to 100 do
  begin
    Gegner[i] := TEinheit.Create;
    Gegner[i].width := 15;
    Gegner[i].height := 17;
    Gegner[i].status := 1;
  end;
  Leertastewurdegedrueckt := false;
  T_gameloop.Enabled := true;
  T_schussSteuerung.Enabled := true;
  T_GegnerSteuerung.Enabled := true;

  Zeitzaehler := 0;
  Punkte := 500;


  start := true;
  Schiff.Left := 100;
  Schiff.top := 200;
  Schiff.width := 18;
  Schiff.height := 40;


  f_game.SetFocus;
  B_start.Enabled := false;

end;

procedure TF_game.endgame;
var
  i: integer;
begin
  {Einheit status: 1=nichtsichtbar 2=sichtbar}

  For i:=0 to 10 do
  begin
    Schuesse[i].Destroy;
  end;

  For i:=0 to 100 do
  begin
    Gegner[i].Destroy;
  end;


  T_schussSteuerung.Enabled := false;
  T_GegnerSteuerung.Enabled := false;
  T_gameloop.Enabled := false;

  start := false;

  B_start.Enabled := true;

end;

procedure TF_game.savetobestenliste;
var
  i: integer;
  Datei: file of Highscore;
begin
  IF Punkte > Bestenliste.Eintraege[5].Punkte then
  begin
    IF Punkte > Bestenliste.Eintraege[1].Punkte  then
    begin
      Bestenliste.Eintraege[1].name := E_namenEingabe.text;
      Bestenliste.Eintraege[1].punkte := Punkte;
    end
    else
    begin
      for i:= 5 downto 2 do
      begin
        If (Punkte > Bestenliste.Eintraege[i].Punkte ) and (Punkte < Bestenliste.Eintraege[i-1].Punkte ) then
        begin
          Bestenliste.Eintraege[i].name := E_namenEingabe.text;
          Bestenliste.Eintraege[i].punkte := Punkte;
        end;
      end;
    end;

  end;
  AssignFile(datei,'besten.hgs');
  if FileExists('besten.hgs') then
  begin
    ReSet(datei);
    seek(datei, 0);
    write(datei,Bestenliste);
    CloseFile(datei);
  end;


  Button1.visible := false;
  E_namenEingabe.visible := false;
  B_start.visible := true;
  Button2.visible := true;
  Label1.Caption := Bestenliste.Eintraege[1].name + inttostr(Bestenliste.Eintraege[1].punkte);
  Label2.Caption := Bestenliste.Eintraege[2].name + inttostr(Bestenliste.Eintraege[2].punkte);
end;

function TF_game.RectinRect(rect1,rect2: Trect): boolean;
begin
  result := true;
  if (rect1.Left > rect2.BottomRight.x) then result:=false;
  if (rect1.top > rect2.BottomRight.y) then result:=false;
  if (rect2.Left > rect1.BottomRight.x) then result:=false;
  if (rect2.top > rect1.BottomRight.y) then result:=false;
end;

{--------------------------------------------------------------}


procedure TF_game.FormCreate(Sender: TObject);
var
  i: integer;
  Datei: file of Highscore;
begin



  //Application.OnIdle := F_game.GameLoop;
  Schiff := TEinheit.Create;


  P_display.Width := F_game.Width-5;
  P_display.Height := 350;
  P_display.Left := 2;
  P_display.top := 2;

  backbild := TBitmap.Create;
  backbild.Width := P_display.Width;
  backbild.Height := P_display.Height;

  WelraumHintergrund := TBitmap.Create;
  WelraumHintergrund.Width := P_display.Width;
  WelraumHintergrund.Height := P_display.Height;
  randomize;
  WelraumHintergrund.Canvas.pen.Color := clblack;
  WelraumHintergrund.Canvas.brush.Color := clblack;
  WelraumHintergrund.Canvas.Rectangle(0,0,WelraumHintergrund.Width,WelraumHintergrund.Height);
  For i:=0 to 100 do
  begin
    WelraumHintergrund.Canvas.Pixels[random(WelraumHintergrund.Width),random(WelraumHintergrund.Height)] := clwhite;
  end;

  AssignFile(datei,'besten.hgs');
  if FileExists('besten.hgs') then
  begin
    ReSet(datei);
    seek(datei, 0);
    read(datei,Bestenliste);
    CloseFile(datei);
  end
  else
  begin
    Bestenliste.Eintraege[1].Name := 'Otto';
    Bestenliste.Eintraege[1].Punkte := 500;
    Bestenliste.Eintraege[2].Name := 'Paul';
    Bestenliste.Eintraege[2].Punkte := 400;
    Bestenliste.Eintraege[3].Name := 'Klaus';
    Bestenliste.Eintraege[3].Punkte := 300;
    Bestenliste.Eintraege[4].Name := 'Hugo';
    Bestenliste.Eintraege[4].Punkte := 200;
    Bestenliste.Eintraege[5].Name := 'Horst';
    Bestenliste.Eintraege[5].Punkte := 100;
    rewrite(datei);
    seek(datei, 0);
    write(datei,Bestenliste);
    CloseFile(datei);
  end;

  Label1.Caption := Bestenliste.Eintraege[1].name + inttostr(Bestenliste.Eintraege[1].punkte);
  Label2.Caption := Bestenliste.Eintraege[2].name + inttostr(Bestenliste.Eintraege[2].punkte);



end;

procedure TF_game.P_displayPaint(Sender: TObject);
begin
  P_display.Canvas.Brush.Color := clblack;
  P_display.Canvas.Rectangle(0,0,300,350);
end;

procedure TF_game.Button2Click(Sender: TObject);
begin
  f_game.Close
end;

procedure TF_game.FormPaint(Sender: TObject);
begin
  Canvas.Brush.Color := clblack;
  Canvas.pen.Color := clred;
  Canvas.pen.Width := 4;
  Canvas.Rectangle(0,0,f_game.Width,f_game.Height);
  Canvas.Brush.Color := clred;
  Canvas.MoveTo(0,P_display.Height+2);
  Canvas.LineTo(f_game.Width,P_display.Height+2);
end;

Procedure TF_game.GameLoop(Sender: TObject; var Done: Boolean);
begin
  Done := False;

end;

procedure TF_game.B_startClick(Sender: TObject);
begin
  startgame;

end;

//besser als Timer aber 100% CPU belastung
procedure TF_game.T_gameloopTimer(Sender: TObject);
var
  i: integer;
begin

end;

procedure TF_game.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  If start = true then
  begin
    endgame;
  end;
end;

procedure TF_game.T_SteuerungTimer(Sender: TObject; Time: Cardinal);
begin
  IF start then
  begin
    IF ((GetAsyncKeystate(vk_left)) <> 0) and (Schiff.left <> 0)  then
    begin
      Schiff.left := Schiff.left - 1;
    end;
    IF ((GetAsyncKeystate(vk_right)) <> 0) and (Schiff.left <> P_display.Width)then
    begin
      Schiff.left := Schiff.left + 1;
    end;
    IF ((GetAsyncKeystate(vk_up)) <> 0) and (Schiff.top <> 0)then
    begin
      Schiff.top := Schiff.top - 1;
    end;
    IF ((GetAsyncKeystate(vk_down)) <> 0) and (Schiff.top <> P_display.Height)then
    begin
      Schiff.top := Schiff.top + 1;
    end;
  end;
end;

procedure TF_game.T_schussbewegungTimer(Sender: TObject; Time: Cardinal);
var
  i,u: integer;
begin
  IF start then
  begin

    {Einheit status: 1=nichtsichtbar 2=sichtbar}
    For i:=0 to 10 do
    begin
      IF Schuesse[i].status = 2 then
      begin
         Schuesse[i].top := Schuesse[i].top -1;
         IF Schuesse[i].top < -4 then
         begin
           Schuesse[i].status := 1;
         end;

         {Collisiopn Abfrage zwischen schüssen und Gegnern}
         For u:=0 to 100 do
         begin
           IF Gegner[u].status = 2 then
           begin
               IF RectinRect(Rect(Gegner[u].left, Gegner[u].top, Gegner[u].width+Gegner[u].left, Gegner[u].Height+Gegner[u].top),
                   Rect(Schuesse[i].left, Schuesse[i].top, Schuesse[i].width+Schuesse[i].left, Schuesse[i].Height+Schuesse[i].top)) = true then
               begin
                 Punkte := Punkte + 10;
                 l_Punkte.Caption := inttostr(Punkte);
                 Gegner[u].status := 1;
                 Schuesse[i].status := 1;
               end;
           end;
         end;

      end;
    end;

  end;
end;

procedure TF_game.T_schussSteuerungTimer(Sender: TObject);
var
  i: integer;
begin
  {Einheit status: 1=nichtsichtbar 2=sichtbar}

  IF start then
  begin
    IF ((GetAsyncKeystate(vk_space)) <> 0)  then
    begin
      For i:=0 to 10 do
      begin
        IF Schuesse[i].status = 1 then
        begin
          Schuesse[i].status := 2;
          Schuesse[i].left := Schiff.left + (Schiff.width div 2)- (Schuesse[i].width div 2);
          Schuesse[i].top := Schiff.top-Schuesse[i].height;
          Leertastewurdegedrueckt := false;
          exit;
        end;

      end;
    end;
  end;
end;

procedure TF_game.T_GegnerSteuerungTimer(Sender: TObject);
var
  i,u: integer;
  EinheitenAnzahl: integer;
begin
  inc(Zeitzaehler);
  IF (Zeitzaehler > 0) and (Zeitzaehler < 700) then{Level 1}
  begin
    IF ((Zeitzaehler mod 100) = 0) or (Zeitzaehler = 5)then
    begin
      EinheitenAnzahl := 5;
      For i:=0 to EinheitenAnzahl do
      begin

        For u:=0 to 100 do
        begin
          IF Gegner[u].status = 1 then
          begin
            Gegner[u].status := 2;
            Gegner[u].top := -10-Random(50);
            If i <> 0 then
            begin
              Gegner[u].left := i*(P_display.Width div EinheitenAnzahl)-Random(20)- Gegner[u].width;
            end
            else
            begin
              Gegner[u].left := Random(20);
            end;
            Break;
          end;
        end;

      end;
    end;
  end;

  IF (Zeitzaehler > 700) and (Zeitzaehler < 1500) then{Level 1}
  begin
    IF ((Zeitzaehler mod 220) = 0) or (Zeitzaehler = 5)then
    begin
      For i:=0 to 10 do
      begin
        Gegner[i].status := 2;
        Gegner[i].top := -10-Random(50);
        If i <> 0 then
        begin
          Gegner[i].left := i*(P_display.Width div 10)-Random(10)- Gegner[i].width;
        end
        else
        begin
          Gegner[i].left := Random(10);
        end;
      end;
    end;
  end;


end;

procedure TF_game.MMTimer1Timer(Sender: TObject; Time: Cardinal);
var
  i: integer;
begin
  IF start then
  begin
    {Einheit status: 1=nichtsichtbar 2=sichtbar}
    For i:=0 to 100 do
    begin
      IF Gegner[i].status = 2 then
      begin
         Gegner[i].top := Gegner[i].top +1;
         IF RectinREct(Rect(Gegner[i].left, Gegner[i].top, Gegner[i].width+Gegner[i].left, Gegner[i].Height+Gegner[i].top),
               Rect(Schiff.left, Schiff.top, Schiff.width+Schiff.left, Schiff.Height+Schiff.top)) = true then
         begin
           {Gameover}
           Button1.visible := true;
           E_namenEingabe.visible := true;
           B_start.visible := false;
           Button2.visible := false;
         end;
         IF Gegner[i].top > P_display.Height then Gegner[i].status := 1;
      end;
    end;

  end;
end;

procedure TF_game.Button1Click(Sender: TObject);
begin
  savetobestenliste;
end;

//Gamelop
//Bilder für Raumschif sind in einem Timage so sind sie gleich als
//REsource ind die Exe eingebunden
procedure TF_game.MMTimer2Timer(Sender: TObject; Time: Cardinal);
var
  i: integer;
begin
  If start then
  begin
  BitBlt(backbild.canvas.handle, 0, 0, WelraumHintergrund.Width, WelraumHintergrund.Height, WelraumHintergrund.canvas.handle, 0, 0, srccopy);

  BitBlt(backbild.canvas.handle, Schiff.left, Schiff.top, Schiff.Width+Schiff.left, Schiff.Height+Schiff.top, Image1.canvas.handle, 0, 0, srccopy);
  For i:=0 to 10 do
  begin
    IF Schuesse[i].status = 2 then
    begin
      backbild.Canvas.Draw(Schuesse[i].left, Schuesse[i].top, I_schuss.Picture.Bitmap)
    end;
  end;

  For i:=0 to 100 do
  begin
    IF gegner[i].status = 2 then
    begin
       backbild.Canvas.Draw(gegner[i].left, gegner[i].top,Image2.Picture.Bitmap)
    end;
  end;

  BitBlt(P_display.canvas.handle, 0, 0, backbild.Width, backbild.Height, backbild.canvas.handle, 0, 0, srccopy);
  end;
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:

 TEinheit = class

    dx,dy : integer;
    x , y : integer;

  end;

var
  Form1: TForm1;
  Hintergrund , Raumschiff , Stein1 : Tbitmap;
  Spieler, Stein: TEinheit;

implementation

{$R *.DFM}

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin

  Spieler := TEinheit.Create ;
  Stein := Teinheit.Create ;
  stein.y := 100;
  stein.x := 600;
  stein.dx := 1;

  Stein1 := Tbitmap.create;
  Raumschiff   := Tbitmap.Create;
  Hintergrund  := Tbitmap.Create;

  Hintergrund.LoadFromFile ('hintergrund.bmp');
     canvas.StretchDraw(rect(0,0,clientwidth,clientheight), hintergrund);

  Raumschiff.Loadfromfile ('schiff.bmp');
  Stein1.LoadFromFile ('Stein.bmp');

end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin

if key = vk_up then begin

     spieler.y := spieler.dy + spieler.y;
     spieler.dy := -5;
       raumschiff.Transparent := true;

end;

if key = vk_down then   begin

     spieler.y := spieler.dy + spieler.y;
     spieler.dy := 5;
       raumschiff.Transparent := true;

end;

  {if key = vk_capital then

  spieler.y := spieler.dy + spieler.y;}

end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin

  stein1.Transparent := true ;
  raumschiff.Transparent := true ;
    stein.x := stein.x - stein.dx;
        canvas.StretchDraw(rect(0,0,clientwidth,clientheight), hintergrund);
        canvas.Draw (Stein.x,Stein.y, stein1);
        canvas.draw(spieler.x,spieler.y,raumschiff);

end;