Pong Game

[Bluesteel]

Hi hier mal nen kleines Pong Game Für 2 Spieler, Steuerung: W/S Spieler1, Hoch/Runter Spieler2, Pause für Pause und ESC = Ende. Anschaulich auch die Anbindung an DirectDraw zum Umschalten in 320x200 Bildpunkte bei 32Bit Farbtiefe.



hier nun mal der code und der rest dann im anhang :D


unit PONG1;

interface

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

type
TForm1 = class(TForm)
Label1: TLabel;
Timer1: TTimer;
procedure Timer1Timer(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
procedure IncreasePoints(Player1,Player2: boolean);
procedure ProcessEscape;
procedure ProcessPlayer1Up;
procedure ProcessPlayer1Down;
procedure ProcessPlayer2Up;
procedure ProcessPlayer2Down;
procedure ProcessComputer;
procedure ProcessPause;
procedure DrawPaddle(Player: Integer);
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

var
Points1: integer = 0;
Points2: integer = 0;
Player1Top: integer = 0;
Player2Top: integer = 0;
BallX: integer = 0;
BallY: integer = 0;
DeltaX: integer = 0;
DeltaY: integer = 0;
MinX: integer = 0;
MaxX: integer = 0;
MinY: integer = 0;
MaxY: integer = 0;

procedure BeepEx(dwFreq,dwDuration: integer); stdcall; external 'kernel32.dll' name 'Beep';

procedure TForm1.IncreasePoints(Player1,Player2: boolean);
begin
if Player1 then Inc(Points1);
if Player2 then Inc(Points2);
Label1.Caption:= Format('%d : %d',[Points1,Points2]);
end;

procedure TForm1.ProcessEscape;
begin
if GetAsyncKeystate(VK_ESCAPE) = 0 then Exit;
BeepEx(400,100);
Application.Terminate;
end;

procedure TForm1.ProcessPlayer2Up;
begin
if GetAsyncKeystate(VK_UP) = 0 then Exit;
if Player2Top <= Label1.Height then Exit;
Dec(Player2Top,2);
DrawPaddle(2);
end;

procedure TForm1.ProcessPlayer2Down;
begin
if GetAsyncKeystate(VK_DOWN) = 0 then Exit;
if Player2Top >= ClientHeight-20 then Exit;
Inc(Player2Top,2);
DrawPaddle(2);
end;

procedure TForm1.ProcessPlayer1Up;
begin
if GetAsyncKeystate(Ord('W')) = 0 then Exit;
if Player1Top <= Label1.Height then Exit;
Dec(Player1Top,2);
DrawPaddle(1);
end;

procedure TForm1.ProcessPlayer1Down;
begin
if GetAsyncKeystate(Ord('S')) = 0 then Exit;
if Player1Top >= ClientHeight-20 then Exit;
Inc(Player1Top,2);
DrawPaddle(1);
end;

procedure TForm1.DrawPaddle(Player: Integer);
var
dx,dy: integer;
pr: PRect;
begin
if Player = 1 then begin
dx:= 8;
dy:= Player1Top;
end else begin
dx:= ClientWidth-14;
dy:= Player2Top;
end;
New(pr);
pr^:= Rect(dx-1,Label1.Height-1,dx+5,ClientHeight);
InvalidateRect(Handle,pr,False);
Canvas.Brush.Color:= clBlack;
Canvas.FillRect(pr^);
Canvas.Brush.Color:= clWhite;
Canvas.FillRect(Rect(dx,dy,dx+5,dy+19));
ValidateRect(Handle,pr);
Dispose(pr);
end;

procedure TForm1.ProcessComputer;
var
Lose1,Lose2: boolean;
pr: PRect;
begin
DrawPaddle(2);
Inc(BallX, DeltaX);
Inc(BallY, DeltaY);
Lose1:= False;
Lose2:= False;
if BallX <= MinX then begin
Lose1:= (BallY < Player1Top-8) or (BallY > Player1Top+19);
BallX:= MinX;
DeltaX:= DeltaX*(-1);
end;
if BallX >= MaxX then begin
Lose2:= (BallY < Player2Top-8) or (BallY > Player2Top+19);
BallX:= MaxX;
DeltaX:= DeltaX*(-1);
end;
if BallY <= MinY then begin
BallY:= MinY;
DeltaY:= DeltaY*(-1);
end;
if BallY >= MaxY then begin
BallY:= MaxY;
DeltaY:= DeltaY*(-1);
end;
New(pr);
pr^:= Rect(MinX,MinY,MaxX+7,MaxY+7);
InvalidateRect(Handle,pr,False);
Canvas.Brush.Color:= clBlack;
Canvas.FillRect(pr^);
Canvas.Brush.Color:= clWhite;
Canvas.FillRect(Rect(BallX,BallY,BallX+7,BallY+7));
ValidateRect(Handle,pr);
Dispose(pr);
IncreasePoints(Lose2,Lose1);
if Lose1 or Lose2 then BeepEx(400,200);
end;

procedure TForm1.ProcessPause;
begin
if GetAsyncKeyState(VK_PAUSE) = 0 then Exit;
Label1.Caption:= 'PAUSED';
Application.ProcessMessages;
repeat
Sleep(1);
until GetAsyncKeyState(VK_PAUSE) = 0;
repeat
Sleep(1);
until GetAsyncKeyState(VK_PAUSE) <> 0;
repeat
Sleep(1);
until GetAsyncKeyState(VK_PAUSE) = 0;
Label1.Caption:= Format('%d : %d',[Points1,Points2]);
Application.ProcessMessages;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
dd: IDirectDraw;
res: HResult;
begin
Width:= 320;
Height:= 200;
Timer1.Enabled:= False;
Label1.Caption:= '0 : 0';
Left:= 0;
Top:= 0;
Player1Top:= (ClientHeight-Label1.Height-20) shr 1;
Player2Top:= (ClientHeight-Label1.Height-20) shr 1;
BallX:= ClientWidth shr 1;
BallY:= ClientHeight shr 1;
DeltaX:= 2;
DeltaY:= 2;
MinX:= 14;
MaxX:= ClientWidth-22;
MinY:= Label1.Height;
MaxY:= ClientHeight-8;
Cursor:= crNone;
res:= DirectDrawCreate(nil,dd,nil);
if res = DD_OK then dd.SetDisplayMode(320,200,32);
Label1.Caption:= 'READY ...';
Application.ProcessMessages;
Sleep(5000);
while not Application.Terminated do begin
ProcessPlayer1Up;
ProcessPlayer1Down;
ProcessPlayer2Up;
ProcessPlayer2Down;
ProcessEscape;
ProcessComputer;
ProcessPause;
Sleep(1);
Application.ProcessMessages;
end;
end;

end.
viel spaß bei Greez Bluesteel

[AKFourtySeven]

kannst du das auch fertig kompiliert zur verfügung stellen !?

[Cerberus]

das geht nicht, da ich die Lizenz von Borland nicht habe, kompilierte Anwendungen vertreiben zu dürfen ...

Sorry

[AKFourtySeven]

also muss ich mir tatsächlich das Delphi SDK installieren ?

kann man das nicht hintenrum über rapidshare schnell machen ?

[Cerberus]

Ihr könnt das gern per Mail abwickeln -- aber bitte nicht übers Forum -- die sind da recht drastisch hinter her ....

leider ....

Oder es muß mit der Kostenlosen Version kompiliert werden -- hat aber ne Meldung zur Folge in der EXE

[Bluesteel]

das ist richtig mit der kostenlosen Version sollte es gehen aber wie cerb schon sagte mit meldung in der exe datei

[LOL]

Das doch egal wenn nur ne Meldung oder so ist.

Würde es auch gerne mal Testen =)

Mfg

[Bluesteel]

dann runterladen kompilieren und spaß haben :D