drocku.pas

source a top program in delphi.

 unit DRockU;
       {WWW.MOMBAINI2006.BLOGSKY.COM***WWW.SOURCE.DOM.IR}
interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, Menus, ExtCtrls, TrigU, StdCtrls,MMSystem;
              {WWW.MOMBAINI2006.BLOGSKY.COM***WWW.SOURCE.DOM.IR}
{global constants}
const
  MISSLEFRAMELIFE = 30;
  NUMMISSLES = 20;
  MISSLEVELDELTA = 10;
                {WWW.MOMBAINI2006.BLOGSKY.COM***WWW.SOURCE.DOM.IR}
  NUMPARTICLES = 29;
  EXHAUSTLIFESPAN = 10;
  EXHAUSTVELDELTA = 2;			   {A constant for adjusting the exhaust velocity in
                                 relation to the player ship velocity}
  NUMASTEROIDS = 20;				{the total number of asteroids allowed}
  MAXASTEROIDRAD = 40;			   {the maximum asteroid radius}

  NUMEXLPDS = 10;					{maximum number of explosions on the screen at once}
  EXPLDLIFE = 10;					{The number of frames that an explosion remains on screen}
  EXPLDVELDELTA = 4;				{velocitiy adjustment for explosion particles}

  SHIELDLIFESPAN = 40;			   {the number of frames that the players shields hold out}

{This array holds colors...}
type
  TFadeColors = array[0..4] of TColor;

{for the fade effect used on bullets and exhaust particles}
const
  FadeColors: TFadeColors = (clMaroon, clRed, clOlive, clYellow, clWhite);

{These states are used for controlling the game in the main loop}
type
  TGameStates = (Playing, Intermission, Demo);

type

  TRPoint = record
  	X, Y: Real;
  end;
    {WWW.MOMBAINI2006.BLOGSKY.COM***WWW.SOURCE.DOM.IR}
  TAsteroidForm = class(TForm)
    MainMenu1: TMainMenu;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    File1: TMenuItem;
    NewGame1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure NewGame1Click(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
  private
    { Private declarations }
    FDoLoop: Boolean;                     {Controls the processing of the main loop}
    FOffscreenBuffer: TBitmap;				  {Double Buffer for flicker-free animation}
  public
    { Public declarations }
    procedure MainLoop;						  {Our game control loop function}
           {WWW.MOMBAINI2006.BLOGSKY.COM***WWW.SOURCE.DOM.IR}
    {this procedure is called when the player fires a new bullet}
    procedure StartMissle(InitialX, InitialY: Real; Facing: Integer; StartXVel, StartYVel: Real);

    {moves and draws all the missles}
    procedure MoveMissles;

    {Start some particles for the ship exhaust effect}
    procedure StartShipExhaustBurst;

    {draws and moves the particles in the ship exhaust effect}
    procedure DrawShipExhaust;

    {this procedure will start an asteroid with a relative diameter}
    procedure StartAsteroid(InitialX,InitialY: Integer; Facing: Integer; Radius: Integer);

    {this procedure moves and draws all the asteroids, and performs the collision checking}
    procedure MoveAsteroids;

    {Start an explosion particle system}
    procedure StartExplosion(InitialX,InitialY: Integer);

    {Draw the explosion particle systems}
    procedure DrawExplosions;

    {this procedure starts the player in the middle of the screen, with shields on}
    procedure StartPlayer(NewPlayer: Boolean);

    {this procedure simply throws us into the main loop when the program is idling}
    procedure Idling(Sender: TObject; var Done: Boolean);

    {this is used to clear out all of the arrays so we can start new games}
    procedure ClearAll;

    {this procedure will essentially end the game and put us in Intermission mode}
    procedure EndGame;

    {this procedure interprets all keyboard input for the game}
    procedure ProcessUserInput;
  end;
       {WWW.MOMBAINI2006.BLOGSKY.COM***WWW.SOURCE.DOM.IR}
  {the base moving graphic object all others will be decended from. all sprites in this game
   will be vector based}
  TSprite = class
     XPos, YPos: Real; 			   						{world coordinates relative to the center of the sprite}
     XVel, YVel: Real;                              {world velocities}
     Living: Boolean;                               {if it's alive, it'll be moved}
     Color: TColor;												{the color the sprite will be drawn in}
     Angle: Integer;											{direction the sprite is facing}
     procedure MoveSprite;                          {moves the sprite based on velocity}
     procedure Accelerate;                          {increases velocity}
  end;

  {WWW.MOMBAINI2006.BLOGSKY.COM***WWW.SOURCE.DOM.IR}
  TParticle = class(TSprite)
     Lifespan: Integer;										{the current life span, expressed in terms of number of frames}
     MaxLife: Integer;                              {the particles maximum lifespan, used in determining
                                                     what color to draw it in}
     ColDelta: Integer;										{bounding box for missle types}
     procedure Draw;                                {draws the particle and decreases its life}
  end;

  {this is the base class for the player ship and asteroids}
  TPolygonSprite = class(TSprite)
    ColDelta: Integer;                              {used to determine a bounding box from the center}
    ThePolygon: array[0..19] of TRPoint;            {the points for drawing the shape, relative to the center of the shape}
    NumVertices: integer;									   {the number of vertices used in ThePolygon}
    procedure Draw;                                 {this draws and rotates the polygon}
    procedure Rotate(Degrees: integer);             {modifies the direction that the sprite is facing}
  end;

  {This is the class for the players ship.  It simply adds an indicator for the shields}
  TPlayerShip = class(TPolygonSprite)
     ShieldLife: Integer;									   {holds the current count of the shields lifespan}
  end;

  {Asteroids have a few more properties other objects don't}
  TAsteroid = class(TPolygonSprite)
  	RotationRate: Integer;								   {the angle it rotates through each frame}
  end;

  TParticleSystem = array[0..NUMPARTICLES] of TParticle;  {used for explosions and ship exhaust}

  TExplosion = record
     Living: boolean;                               {If it's alive, it'll be drawn}
     Particles: TParticleSystem;                    {The particle system for the explosion}
  end;

var
  AsteroidForm: TAsteroidForm;
  PlayerShip: TPlayerShip;                          {the player ship variable}
  Asteroids: array[0..NUMASTEROIDS] of TAsteroid;   {this tracks all of the asteroids}
  Missles: array[0..NUMMISSLES] of TParticle;			{this tracks all of the missles}
  Explosions: array[0..NUMEXLPDS] of TExplosion;	   {this tracks all of the explosions}
  ShipExhaust: TParticleSystem;                 	   {exhause effect from the players ship}
  Score: Longint;												{The players score}
  NumShipsLeft: Integer;										{The number of lives the player has left}
  CurLevel: Integer;	 										{the current level in the game}
  AnyAsteroidsMoved: Boolean;								{this will determine if all asteroids are dead so we can start a new level}
  GameState: TGameStates;                           {tracks what state the game is currently in}
  PacingCounter : LongInt;

implementation

{$R *.DFM}
   {WWW.MOMBAINI2006.BLOGSKY.COM***WWW.SOURCE.DOM.IR}
{----- TSprite Routines -----}

{moves sprites according to velocity}
procedure TSprite.MoveSprite;
begin
  {add the X and Y velocities to the sprites current position}
  XPos:=XPos+XVel;
	YPos:=YPos+YVel;

  {check for screen sides}
  if XPos>632 then XPos:=0;
  if XPos<0 then XPos:=632;
  if YPos>409 then YPos:=0;
  if YPos<0 then YPos:=409;
end;

{accelerates the sprite, constraining to a maximum velocity}
procedure TSprite.Accelerate;
begin
  {adjust the X velocity}
  XVel:=XVel+CosineArray^[Angle];
  {check for maximum limits}
  if XVel>10 then XVel:=10
  else
  if XVel<-10 then XVel:=-10;

  {adjust the Y velocity}
  YVel:=YVel+SineArray^[Angle];
  {check for maximum limits}
  if YVel>10 then YVel:=10
  else
  if YVel<-10 then YVel:=-10;
end;

{----- TParticle Routines -----}

{moves and draws a particle}
procedure TParticle.Draw;
var
  ParticleColor: TColor;     {a placeholder for the particle color}
  ColorIndex: Real;          {used in determining what color the particle is drawn in}
begin
  {move this particle}
  MoveSprite;

  {Decrease the LifeSpan, as another animation frame has gone by}
  Inc(LifeSpan,-1);

  {if the lifespan has run out, kill this particle}
  if LifeSpan=0 then
  begin
     Living:=False;
     Exit;
  end;

  {if the particle is still alive, then draw it}

  {determine where the color will fall in the color array}
  ColorIndex:=MaxLife/5;	{we have 5 colors}

  {and the particle color is...}
  ParticleColor:=FadeColors[Trunc(LifeSpan/ColorIndex)];

  {draw this particle to our offscreen buffer}
  AsteroidForm.FOffscreenBuffer.Canvas.Pixels[Round(XPos),Round(YPos)]:=ParticleColor;
end;

{----- TPolygonSprite Routines -----}

{modify the sprites current facing}
procedure TPolygonSprite.Rotate(Degrees: Integer);
begin
  {modify the angle}
  Angle:=Angle+Degrees;

  {check for boundries}
  if Angle>359 then Angle:=Angle-359;
  if Angle<0 then Angle:=360+Angle;
end;

{this procedure rotates the points in the polygon to the current facing and draws it
 to the offscreen buffer}
procedure TPolygonSprite.Draw;
var
	TempPoly: Array[0..19] of TPoint;   {a Polyline compatible polygon point array}
  Count: Integer;                     {general loop control variable}
begin
	{Rotate the polygon by the angle using point rotation equations from trigonometry,
   and translate it's position}
  for Count:=0 to NumVertices-1 do
  begin
  	TempPoly[Count].X:=Round((ThePolygon[Count].X*CosineArray^[Angle]-ThePolygon[Count].Y*SineArray^[Angle])+XPos);
  	TempPoly[Count].Y:=Round((ThePolygon[Count].X*SineArray^[Angle]+ThePolygon[Count].Y*CosineArray^[Angle])+YPos);
  end;

  {adjust the pen and the brush of the offscreen buffers canvas}
  AsteroidForm.FOffscreenBuffer.Canvas.Pen.Color:=Color;
  AsteroidForm.FOffscreenBuffer.Canvas.Brush.Style:=bsClear;
  AsteroidForm.FOffscreenBuffer.Canvas.Brush.Color:=clBlack;

  {draw the polygon using a Windows API function}
  Polyline(AsteroidForm.FOffscreenBuffer.Canvas.Handle,TempPoly,NumVertices);
end;

{----- TAsteroidForm Routines -----}

{This is the main control loop for the entire program.  This controls the action
 from a high level standpoint, and is itself controlled by a state variable that
 determines what should be happening. We want to do this inside of a regular loop
 as opposed to putting this on a timer event.  This is becuase even with an interval
 of 1, the timer is too slow, and a loop will give us the best performance.}
procedure TAsteroidForm.MainLoop;
var
	LevelPauseCounter: TDateTime;		     {for timing how long the level intermission has lasted}
  Count: Integer;								{general loop control}
begin
	while FDoLoop do     {continue this loop until the user shuts down the program}
  case GameState of
     Playing:          {we are actively playing the game}
        begin
           {if the player does not have any ships left, end the game and go into demo mode}
           if NumShipsLeft<0 then
              EndGame;

           {if the player has killed all of the asteroids, go to intermission and increase the level}
           if not AnyAsteroidsMoved then
              GameState:=Intermission;

	         {Erase the previous frame in the offscreen buffer, so we can begin a new one}
		      With FOffscreenBuffer.Canvas do
		      begin
		    	   Brush.Color:=clBlack;
		    	   Brush.Style:=bsSolid;
		    	   Fillrect(Cliprect);
		      end;

           {if the player is still alive, get user input and move the players ship}
           if PlayerShip.Living then
           begin
              ProcessUserInput;
              PlayerShip.MoveSprite;
           end
           else
        	   {we died, start us over}
        	   StartPlayer(TRUE);

           {draw the players ship to the offscreen buffer}
           PlayerShip.Draw;

           {if shields are on, draw them round the players ship}
		      if PlayerShip.ShieldLife>0 then
		    	with FOffscreenBuffer.Canvas do
			      begin
		    		   Pen.Color:=clGreen;
		            Brush.Style:=bsClear;
                 {shields are represented by a simple circle}
		            Ellipse(Round(PlayerShip.XPos-PlayerShip.ColDelta-5),Round(PlayerShip.YPos-PlayerShip.ColDelta-5),
		        				  Round(PlayerShip.XPos+PlayerShip.ColDelta+5),Round(PlayerShip.YPos+PlayerShip.ColDelta+5));
                 {decrease the shield life span}
                 Inc(PlayerShip.ShieldLife, -1);
		  	      end;

		      {draw ship exhaust effect}
		      DrawShipExhaust;

		      {Move all active missles}
		      MoveMissles;

		      {Move all Asteroids and check for collisions}
		      MoveAsteroids;

	         {draw any explosions that have just occured}
		      DrawExplosions;

		  	   {Copy the next frame to the screen}
		      AsteroidForm.Canvas.Draw(0,0,FOffscreenBuffer);

	         {Display Score Changes}
	         Panel2.Caption:='Score: '+IntToStr(Score);

                 {This pause counter is here for the benefit of faster machines.
                  Without it, Delphi Rocks will run too fast to be playable on
                  Pentium 90+ machines.  Try experimenting with the delay time
                  to increase the frame rate if you have a slower machine}
                  PacingCounter := GetTickCount;
                  repeat
                    {Let Windows process any pending messages}
                    Application.ProcessMessages;
                  until (GetTickCount-PacingCounter) > 50;
  		end;
     Intermission:		{this does a slight pause in between levels}
        begin
           {kill any moving sprites}
           ClearAll;

           {increase the level}
           Inc(CurLevel);

	    		{Erase the former frame, so we can begin a new one}