Pong Game

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

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