Delphi Oyun Yapımı

[LEFT][B][SIZE=2][COLOR=#333333]procedure TForm2.Timer1Timer(Sender: TObject);
var[/COLOR][/SIZE][SIZE=2][COLOR=#0000ff]
[/COLOR][/SIZE][/B][SIZE=2][COLOR=#0000ff][COLOR=#000000]s:byte;[/COLOR][B]
[COLOR=#000000]begin[/COLOR]
// 2. image basi ---------------------------------------[/B][/COLOR]
Image2.left:=Image2.left-10;[COLOR=#0000ff]// Ilk baslangiçta soldan 10 br. bosluk birakir.[/COLOR]
[B]if[/B] image1.Left=image2.Left-30 [B]then[/B] [COLOR=#0000ff]//Virüsün yiyecegi nesne önüne geldi ise[/COLOR]
[B]begin[/B]
[B]if[/B] image1.Top=image2.Top[B] then[/B] [COLOR=#0000ff]// Karsisinda ise [/COLOR]
[B]begin[/B]
Image2.left:=650; [COLOR=#0000ff]// Virüsün yedigi nesneyi ilk basa gönder.[/COLOR]
c:=c-1; [COLOR=#0000ff]// Canini 1 düsür.[/COLOR]
mediaplayer1.FileName:='ölüm.wav'; [COLOR=#0000ff]// Media Player' de Ölüm.Wav atanir.[/COLOR]
mediaplayer1.Open; [COLOR=#0000ff]//Ölüm.Wav açilir.[/COLOR]
mediaplayer1.Play; [COLOR=#0000ff]// Ölüm.Wav çalistirilir.[/COLOR]
label4.Caption:=inttostr(c);/[COLOR=#0000ff]/Oyundaki can kismi azalir.[/COLOR]
[B]if[/B] c=0 [B]then [/B][COLOR=#0000ff]// Can 0 ' a esitse[/COLOR]
[B]begin[/B]
form2.Close;[COLOR=#0000ff]//Form2 kapatilir.[/COLOR]
s:=0; [COLOR=#0000ff]//Puan sifirlanir[/COLOR].
showmessage('OYUN BITTI !!!');[COLOR=#0000ff]// Oyun bitti mesaji verir.[/COLOR]
[B]end;
end;[/B]
[B]if [/B]image1.Top-20=image2.Top [B]then[/B] [COLOR=#0000ff]//Antivirus 20 br üstünde ise [/COLOR]
[B]begin[/B]
Image2.left:=650; [COLOR=#0000ff]// Virüsün yedigi nesneyi ilk basa gönder.[/COLOR]
c:=c-1; [COLOR=#0000ff]// Canini 1 düsür.[/COLOR]
mediaplayer1.FileName:='ölüm.wav';[COLOR=#0000ff]// Media Player' de Ölüm.Wav atanir.[/COLOR]
mediaplayer1.Open;[COLOR=#0000ff]//Ölüm.Wav açilir.[/COLOR]
mediaplayer1.Play; [COLOR=#0000ff]// Ölüm.Wav çalistirilir.[/COLOR]
label4.Caption:=inttostr(c); [COLOR=#0000ff]//Oyundaki can kismi azalir.[/COLOR]
[B]if[/B] c=0 [B]then[/B] [COLOR=#0000ff]// Can 0 ' a esitse[/COLOR]
[B]begin[/B]
label4.Caption:=inttostr(c); [COLOR=#0000ff]//Oyundaki can kismi azalir[/COLOR]
form2.Close;[COLOR=#0000ff]//Form2 kapatilir.[/COLOR]
s:=0; [COLOR=#0000ff]//Puan sifirlanir.[/COLOR]
showmessage('OYUN BITTI !!!'); [COLOR=#0000ff]// Oyun bitti mesaji verir.[/COLOR]
[B]end;
end;[/B]
[B]if[/B] image1.Top+20=image2.Top [B]then[/B] [COLOR=#0000ff]// Virüsün yedigi nesneyi ilk basa gönder.[/COLOR]
[B]begin[/B]
Image2.left:=650; [COLOR=#0000ff]// Virüsün yedigi nesneyi ilk basa gönder.[/COLOR]
c:=c-1; [COLOR=#0000ff]// Canini 1 düsür.[/COLOR]
mediaplayer1.FileName:='ölüm.wav'; [COLOR=#0000ff]// Media Player' de Ölüm.Wav atanir.[/COLOR]
mediaplayer1.Open; [COLOR=#0000ff]//Ölüm.Wav açilir.[/COLOR]
mediaplayer1.Play; [COLOR=#0000ff]// Ölüm.Wav çalistirilir.[/COLOR]
label4.Caption:=inttostr(c); [COLOR=#0000ff]//Oyundaki can kismi azalir.[/COLOR]
[B]if[/B] c=0 [B]then[/B] [COLOR=#0000ff]// Can 0 ' a esitse[/COLOR]
[B]begin[/B]
c:=3;
label4.Caption:=inttostr(c); [COLOR=#0000ff]//Oyundaki can kismi azalir[/COLOR]
form2.Close;[COLOR=#0000ff]//Form2 kapatilir.[/COLOR]
s:=0; [COLOR=#0000ff]//Puan sifirlanir.[/COLOR]
showmessage('OYUN BITTI !!!');[COLOR=#0000ff]// Oyun bitti mesaji verir.[/COLOR]
[B]end;
end;
end;[/B]
[B]if[/B] image2.Left<13 [B]then[/B] [COLOR=#0000ff]//virus anti vürüse yakalanmadiysa[/COLOR]
[B]begin[/B]
Image2.left:=650;[COLOR=#0000ff]// Virüsün yedigi nesneyi ilk basa gönder.[/COLOR]
[B]for[/B] a:=1 [B]to[/B] 11 [B]do[/B] [COLOR=#0000ff]//1 'den 11'e kadar dolan[/COLOR]
x:=random(a);[COLOR=#0000ff]//1-11 arsinda bir sayi seç[/COLOR]
x:=x*40;[COLOR=#0000ff]// Seçtigin sayiyi 40 ile çarp[/COLOR]
image2.Top:=X; [COLOR=#0000ff]//Form2' nin üzerinde o yükseklige yerlestir. [/COLOR]
[B]end;[/B]
if image1.top<0 then image1.top:=400; [COLOR=#0000ff]//virüs asagidan en yukari çikarsa asagi gönder[/COLOR]
if image1.top>400 then image1.top:=0;[COLOR=#0000ff]//virüs yukaridan en asagii inerse yukari gönder[/COLOR]
if image1.left<10 then image1.left:=670;[/SIZE][SIZE=2][COLOR=#0000ff]// Soldan en saga giderse soldan çikar[/COLOR][/SIZE][/LEFT]
[CENTER][SIZE=2][COLOR=#0000ff]// 3. image basi ---------------------------------------[/COLOR][/SIZE][SIZE=2]
[COLOR=#ff0000][B].
.
. [/B][/COLOR][/SIZE][/CENTER]
[SIZE=2][B][SIZE=2]procedure TForm2.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin[/SIZE][/B][SIZE=2]
clientheight:=476; [COLOR=#0000ff]//form büyüklügü[/COLOR]
clientwidth:=715; [COLOR=#0000ff]//form büyüklügü[/COLOR]
[B]case[/B] key [B]of[/B]
VK_[B]up[/B]:Image1.Top:=Image1.Top-20; [COLOR=#0000ff]//yukariya 20br çikart[/COLOR]
VK_[B]down[/B]:Image1.Top:=Image1.Top+20; [COLOR=#0000ff]//asagiya 20br indir[/COLOR]
VK_[B]left[/B]:image1.Left:=image1.Left-20; [COLOR=#0000ff]//sola 20 br git[/COLOR]
VK_[B]right[/B]:image1.Left:=image1.Left+20; [COLOR=#0000ff]//sag 20br git[/COLOR]
[/SIZE][B][SIZE=2]end;[/SIZE][/B]
[B][SIZE=2]procedure TForm2.FormActivate(Sender: TObject);
begin[/SIZE][/B][SIZE=2]
timer1.Enabled:=true; [COLOR=#0000ff]//timer1 çalistir[/COLOR]
timer2.Enabled:=true; [COLOR=#0000ff]//timer2 çalistir[/COLOR]
timer3.Enabled:=true; [COLOR=#0000ff]//timer3 çalistir [/COLOR]
c:=3; [COLOR=#0000ff]//cani 3 ver[/COLOR]
s:=0; [COLOR=#0000ff]//puani sifirla[/COLOR]
label2.Caption:=inttostr(s); [COLOR=#0000ff]//puani göster[/COLOR]
[B]end; [/B][/SIZE][/SIZE]

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; 
[SIZE=2]procedure TForm1.CheckError(hr: HResult);
begin
Hermes1.DirectDraw.FlipToGDISurface;
OleCheck(hr);
end;[/SIZE]
[SIZE=2]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;[/SIZE]
[SIZE=2]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;[/SIZE]
[SIZE=2]if Collision then
if (FGameScore.MenLeft >= 0) then begin
ResetAll;
end else begin
FGameScore.Status := gsGameOverLost;
GameOver;
end;[/SIZE]
[SIZE=2]if HasWon then begin
FGameScore.Status := gsGameOverWon;
GameOver;
end;
end;[/SIZE]
[SIZE=2]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;[/SIZE]
[SIZE=2]procedure TForm1.DrawBackGround;
var
Sprites: TSpriteAry;
begin
Sprites[svDot] := DotSprite;
Sprites[svVert] := VertSprite;
Sprites[svBlank] := BlankSprite;[/SIZE]
[SIZE=2]FGameScore.Board.Draw(Hermes1, Sprites);
end;[/SIZE]
[SIZE=2]procedure TForm1.DrawBadGuy(Value: Integer);
begin
FBadMen[Value].Draw(Hermes1, FBadMen[Value].Sprite);
end;[/SIZE]
[SIZE=2]procedure TForm1.DrawMan;
begin
FMainMan.Draw(Hermes1, ManSprite);
end;[/SIZE]
[SIZE=2]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;[/SIZE]
[SIZE=2]procedure TForm1.FormCreate(Sender: TObject);
begin
FMainMan := TMainMan.Create;
FGameScore := TGameScore.Create;
SetupBadMen;[/SIZE]
[SIZE=2]ClientHeight := 480;
ClientWidth := 640;
Application.OnIdle := IdleProc;
Zounds1.OpenFile('Temp1.wav', 1);
end;[/SIZE]
[SIZE=2]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;[/SIZE]
[SIZE=2]procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (Key = VK_ESCAPE) then begin
Close;
Exit;
end;[/SIZE]
[SIZE=2]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;[/SIZE]
[SIZE=2]{------------------------------------------------------------------------------
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;[/SIZE]
[SIZE=2]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;[/SIZE]
[SIZE=2]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;[/SIZE]
[SIZE=2]procedure TForm1.IdleProc(Sender: TObject; var Done: Boolean);
begin
Done := False;
if Hermes1.Active then begin
Move;
Hermes1.Flip;
CheckGameStatus;
CheckFrameCount;
end;
end;[/SIZE]
[SIZE=2]{------------------------------------------------------------------------------
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;[/SIZE]
[SIZE=2]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;[/SIZE]
[SIZE=2]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;[/SIZE]
[SIZE=2]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;[/SIZE]
[SIZE=2]procedure TForm1.ResetAll;
begin
SetupBadMen;
FMainMan.Home;
FGameScore.Status := gsPaused;
DrawBackground;
Hermes1.Flip;
Hermes1.Active := False;
end;[/SIZE]
[SIZE=2]{------------------------------------------------------------------------------
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;[/SIZE]
[SIZE=2]procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
end;