NetVision-Technik - 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 :D
Code:
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