|
OYUN
KODU :
procedure TForm1.BlankDot;
var
hr: HResult;
begin
hr := TDirectDrawSurface(Hermes1.Scene.WorkSurface).DDSurface.BltFast(
FMainMan.GridX * DibSize, FMainMan.GridY * DibSize,
TDirectDrawSurface(BlankSprite.Surface).DDSurface,
BlankSprite.SpriteBounds,
DDBLTFAST_WAIT or DDBLTFAST_SRCCOLORKEY);
if (hr <> DD_OK) then
CheckError(hr);
end;
procedure TForm1.CheckError(hr: HResult);
begin
Hermes1.DirectDraw.FlipToGDISurface;
OleCheck(hr);
end;
procedure TForm1.CheckFrameCount;
begin
Inc(FFrameCount);
FFrameTime := TimeGetTime;
if (FFrameTime - FFrameTime0 > 1000) then begin
FFrameRate :=
(FFrameCount - FFrameCount0) * 1000 div (FFrameTime - FFrameTime0);
FFrameTime0 := FFrameTime;
FFrameCount0 := FFrameCount;
end;
end;
procedure TForm1.CheckGameStatus;
begin
if FGameScore.Board.GetDataXY(FMainMan.GridX,
FMainMan.GridY) = svDot then
begin
FGameScore.Board.SetDataXY(FMainMan.GridX, FMainMan.GridY, svBlank);
FGameScore.Points := FGameScore.Points + 25;
Zounds1.Play(1, False);
BlankDot;
end;
if Collision then
if (FGameScore.MenLeft >= 0) then begin
ResetAll;
end else begin
FGameScore.Status := gsGameOverLost;
GameOver;
end;
if HasWon then begin
FGameScore.Status := gsGameOverWon;
GameOver;
end;
end;
function TForm1.Collision: Boolean;
var
i: Integer;
begin
Result := True;
for i := 0 to MaxBadMen - 1 do
if (FMainMan.GridX = FBadMen[i].GridX) and
(FMainMan.GridY = FBadMen[i].GridY) then begin
FGameScore.MenLeft := FGameScore.MenLeft - 1;
Exit;
end;
Result := False;
end;
procedure TForm1.DrawBackGround;
var
Sprites: TSpriteAry;
begin
Sprites[svDot] := DotSprite;
Sprites[svVert] := VertSprite;
Sprites[svBlank] := BlankSprite;
FGameScore.Board.Draw(Hermes1, Sprites);
end;
procedure TForm1.DrawBadGuy(Value: Integer);
begin
FBadMen[Value].Draw(Hermes1, FBadMen[Value].Sprite);
end;
procedure TForm1.DrawMan;
begin
FMainMan.Draw(Hermes1, ManSprite);
end;
procedure TForm1.DrawStats;
const
Directions = 'Alt S to Start; Alt X to Exit';
var
DC: HDC;
Score, MenLeft: string;
FrameStr: string;
begin
FrameStr := Format('Frames Per Second: %d Speed: %d',
[FFrameRate, FGameScore.Speed]);
Score := 'Score: ' + IntToStr(FGameScore.Points);
MenLeft := 'Men Left: ' + IntToStr(FGameScore.MenLeft);
Hermes1.BackSurface.GetDC(DC);
TextOut(DC, 150, 430, PChar(FrameStr), Length(FrameStr));
TextOut(DC, 150, 460, PChar(Directions), Length(Directions));
TextOut(DC, 20, 430, PChar(Score), Length(Score));
TextOut(DC, 20, 460, PChar(MenLeft), Length(MenLeft));
Hermes1.BackSurface.ReleaseDC(DC);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FMainMan := TMainMan.Create;
FGameScore := TGameScore.Create;
SetupBadMen;
ClientHeight := 480;
ClientWidth := 640;
Application.OnIdle := IdleProc;
Zounds1.OpenFile('Temp1.wav', 1);
end;
procedure TForm1.FormDestroy(Sender: TObject);
var
i: Integer;
begin
Hermes1.Active := False;
FMainMan.Free;
for i := 0 to MaxBadMen - 1 do
FBadMen[i].Free;
FGameScore.Free;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (Key = VK_ESCAPE) then begin
Close;
Exit;
end;
if (ssAlt in Shift) then
case Char(Key) of
'X': begin
Close;
Exit;
end;
'S': begin
FGameScore.Status := gsRunning;
Hermes1.Active := True;
end;
end;
case Key of
VK_LEFT: FMainMan.RequestDir := tdLeft;
VK_RIGHT: FMainMan.RequestDir := tdRight;
VK_DOWN: FMainMan.RequestDir := tdDown;
VK_UP: FMainMan.RequestDir := tdUp;
end;
end;
{------------------------------------------------------------------------------
I post a message so I can draw something after
the form is actually visible. See WMStartAll.
------------------------------------------------------------------------------}
procedure TForm1.FormShow(Sender: TObject);
begin
Hermes1.Run(Handle);
PostMessage(Handle, WM_STARTALL, 0, 0);
end;
procedure TForm1.GameOver;
var
S: string;
begin
DrawBackground;
Hermes1.Flip;
Hermes1.Active := False;
Hermes1.DirectDraw.FlipToGDISurface;
case FGameScore.Status of
gsGameOverWon: S := 'You won!';
gsGameOverLost: S := 'You lost';
end;
ShowMessage(S);
Close;
end;
function TForm1.HasWon: Boolean;
var
X, Y, Value: integer;
begin
Result := False;
for Y := 0 to MaxY do
for X := 0 to MaxX do begin
Value := FGameScore.Board.GetDataXY(X, Y);
if Value = svDot then
Exit;
end;
DrawBackground;
Hermes1.Flip;
Sleep(1000);
if FGameScore.Board.GotoNextLevel then begin
ResetAll;
end else
Result := True;
end;
procedure TForm1.IdleProc(Sender: TObject; var Done: Boolean);
begin
Done := False;
if Hermes1.Active then begin
Move;
Hermes1.Flip;
CheckGameStatus;
CheckFrameCount;
end;
end;
{------------------------------------------------------------------------------
Move the chacacters and check for the condition that means the
man just ate a dot.
------------------------------------------------------------------------------}
procedure TForm1.Move;
var
i :Integer;
begin
FMainMan.Move(FGameScore);
for i := 0 to MaxBadMen - 1 do
FBadMen[i].Move(FGameScore);
end;
procedure TForm1.SpriteScene1SetupSurfaces(Sender: TObject);
begin
SpriteScene1.AddSprite(DotSprite);
SpriteScene1.AddSprite(BlankSprite);
SpriteScene1.AddSprite(VertSprite);
SpriteScene1.AddSprite(ManSprite);
SpriteScene1.AddSprite(BadSprite1);
SpriteScene1.AddSprite(BadSprite2);
SpriteScene1.AddSprite(BadSprite3);
end;
procedure TForm1.SpriteScene1DrawScene(Sender: TObject);
var
i: Integer;
begin
if Hermes1.DrawState = tsDrawAll then
DrawBackground;
DrawMan;
for i := 0 to MaxBadMen - 1 do
DrawBadGuy(i);
DrawStats;
end;
procedure TForm1.SetupBadMen;
var
i: Integer;
begin
for i := 0 to MaxBadMen - 1 do begin
FBadMen[i] := TBadMan.Create;
FBadMen[i].GridX := 18;
FBadMen[i].GridY := 11;
FBadMen[i].XPos := FBadMen[i].GridX * DibSize;
FBadMen[i].YPos := FBadMen[i].GridY * DibSize;
FBadMen[i].RequestDir := tdUp;
FBadMen[i].Sprite := TSprite(FindComponent('BadSprite' + IntToStr(i
+ 1)));
end;
end;
procedure TForm1.ResetAll;
begin
SetupBadMen;
FMainMan.Home;
FGameScore.Status := gsPaused;
DrawBackground;
Hermes1.Flip;
Hermes1.Active := False;
end;
{------------------------------------------------------------------------------
The WM_SHOW event posts a message that calls this method. That
way I'm sure the form is actually visible before I start drawing
on it.
------------------------------------------------------------------------------}
procedure TForm1.WMStartAll(var Msg: TMessage);
begin
DrawBackground;
Hermes1.Flip;
Hermes1.Active := False;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
end;
|
