－トップへ－
ブロックくずしゲームを作る
その７ 最終回
このシリーズの最後です。今回は，今まで作成したプログラムソースを修正していきます。
まずは，ラケットでボールを跳ね返すとき，ラケットが動いている場合にボールの進む角度が変わるようにします。
また，ボールがスタートする場所も乱数を使って変化するようにします。
まず，ボールがスタートする場所が変化するようにします。プログラムを書く場所は，FormKeyDownイベントハンドラです。
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=VK_right then keyd:=4;
if key=VK_left then keyd:=-4;
if key=VK_space then begin
balls:=6;
with image1.Canvas do begin
brush.Color:=clblack;
fillrect(rect(0,200,image1.Width,450));
end;
timer1.Enabled:=true;
end;
end;
Shift: TShiftState);
begin
if key=VK_right then keyd:=4;
if key=VK_left then keyd:=-4;
if key=VK_space then begin
//ボールのスタート場所に変化を持たせる
randomize; //乱数の初期化
ballx:=random(200)+100; //X座標で100～299の間でボールがスタートするようにする
bally:=300;ballx:=random(200)+100; //X座標で100～299の間でボールがスタートするようにする
bx:=(random(2)*2-1)*3; //ボールの進む横方向を -3または3にする
by:=-6;balls:=6;
with image1.Canvas do begin
brush.Color:=clblack;
fillrect(rect(0,200,image1.Width,450));
end;
timer1.Enabled:=true;
end;
end;
random(200)は，0～199の数字を返してきます。random(2)は，0か1の数字を返してきます。ですから(random(2)*2-1)*3とすると，-3か3のどちらかの数字を返してきます。
次にラケットでボールを跳ね返すとき，ラケットが動いている場合にボールの進む角度が変わるようにします。プログラムを書く場所は，Timer1Timerの中です。
前回までのプログラムでは以下の通りでした。
//ボールがラケットに当たったか調べる
if bally>=raky-balls thenbegin
if (ballx>=rakx) and (ballx<=rakx+rakw) then by:=-by;
end;
上記の部分を下のように書きかえます。
//ボールがラケットに当たったか調べる
if (bally>=raky-balls) and (bally<raky+5) then begin //ボールがY座標でラケットの位置に来たとき
if (ballx>=rakx) and (ballx<=rakx+rakw) then begin //ボールがX座標でラケットの位置にあるとき
by:=-by; //ボールのY座標の進行方向を反対にする
if keyd>0 then bx:=bx+2; //［→］キーが押されていたら，進行方向を右に傾ける
if keyd<0 then bx:=bx-2; //［←］キーが押されていたら，進行方向を左に傾ける
end;
end;
if (ballx>=rakx) and (ballx<=rakx+rakw) then begin //ボールがX座標でラケットの位置にあるとき
by:=-by; //ボールのY座標の進行方向を反対にする
if keyd>0 then bx:=bx+2; //［→］キーが押されていたら，進行方向を右に傾ける
if keyd<0 then bx:=bx-2; //［←］キーが押されていたら，進行方向を左に傾ける
end;
end;
次に，ブロックを全部消したら，新しいブロックを表示するようにします。
これを行うには，消したブロックの数を数えるために，変数「score」を宣言します。
private
{ Private 宣言 }
ballx,bally,bx,by,balls,score:integer;//Private部に，scoreを整数宣言します
rakx,raky,rakw,keyd:integer;
block:array[0..10,0..2] of boolean;
public
{ Public 宣言 }
end;
{ Private 宣言 }
ballx,bally,bx,by,balls,score:integer;//Private部に，scoreを整数宣言します
rakx,raky,rakw,keyd:integer;
block:array[0..10,0..2] of boolean;
public
{ Public 宣言 }
end;
そして，Timer1Timerイベントハンドラで，ブロックが消えるごとにscoreを１ずつ増やしていき，30になったら新しいブロックを表示するようにします。
//ブロックに当たったか調べる
if (bally>=60) and (bally<=70) then begin //下段のブロックでi:=ballx div (image1.Width div 10);
if block[i,2]=true then begin //ブロックに当たったら
block[i,2]:=false;
by:=-by;
with image1.Canvas do begin
brush.Color:=clblack;
fillrect(rect(i*(image1.Width div 10),60,(i+1)*(image1.Width div 10),70));
end;
inc(score); //scoreを１増加する
end;end;
if (bally>=40) and (bally<=50) then begin //中段のブロックで
i:=ballx div (image1.Width div 10);
if block[i,1]=true then begin //ブロックに当たったら
block[i,1]:=false;
by:=-by;
with image1.Canvas do begin
brush.Color:=clblack;
fillrect(rect(i*(image1.Width div 10),40,(i+1)*(image1.Width div 10),50));
end;
inc(score); //scoreを１増加する
end;end;
if (bally>=20) and (bally<=30) then begin /上段のブロックで
i:=ballx div (image1.Width div 10);
if block[i,0]=true then begin //ブロックに当たったら
block[i,0]:=false;
by:=-by;
with image1.Canvas do begin
brush.Color:=clblack;
fillrect(rect(i*(image1.Width div 10),20,(i+1)*(image1.Width div 10),30));
end;
inc(score); //scoreを１増加する
end;end;
//ブロックがなくなったとき
if score mod 31 =0 then begin //scoreを31で割った余りが0のとき(scoreの初期値は1にしたため，31で割っています)
timer1.Enabled:=false; //timer1を無効にする
inc(score); //scoreを1増加する（これをしないと，次回も「score mod 31=0」になってしまう）
makeblock; //makeblockイベントハンドラを実行して，ブロックを表示させる
exit; //timer1Timerイベントハンドラから抜け出す
end;
timer1.Enabled:=false; //timer1を無効にする
inc(score); //scoreを1増加する（これをしないと，次回も「score mod 31=0」になってしまう）
makeblock; //makeblockイベントハンドラを実行して，ブロックを表示させる
exit; //timer1Timerイベントハンドラから抜け出す
end;
最後に，「Game Over」のときの処理をします。
ここでは失敗しても，ボールを３個まで使用できるようにして，３個を使い切った後は，スペースキーを押してもボールが出ないようにします。
まず，private部でballk(整数型にして，ボールの個数を表します)とgameover（論理型にして，trueならゲームオーバーにします。）を宣言します。
これらを，すべてまとめて，プログラムソースを表示します。
unit test1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
Timer1: TTimer;
procedure makeBlock;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
{ Private 宣言 }
ballx,bally,bx,by,balls,score,ballk:integer; //scoreは消したブロックの数，ballkは使用できるボールの数
rakx,raky,rakw,keyd:integer;
block:array[0..10,0..2] of boolean;
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
form1.ClientWidth:=400;
form1.ClientHeight:=500;
image1.Left:=0;
image1.Top:=0;
image1.Width:=form1.ClientWidth;
image1.Height:=form1.ClientHeight;
raky:=450;
rakw:=40;
with image1.Canvas do begin
brush.Color:=clblack;
fillrect(image1.Canvas.ClipRect);
//ラケットを描く
brush.Color:=clwhite;
fillrect(rect(rakx,raky,rakx+rakw,raky+10));
end;
makeblock;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=VK_right then keyd:=4;
if key=VK_left then keyd:=-4;
if key=VK_space then begin
balls:=6;
with image1.Canvas do begin
brush.Color:=clblack;
fillrect(rect(0,200,image1.Width,450));
end;
timer1.Enabled:=true;
end;
end;
procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
keyd:=0;
end;
//===============================================
//ブロックを表示する=============================
procedure TForm1.makeBlock;
var
i,j:integer;
begin
for i:=0 to 2 do begin
for j:=0 to 9 do begin
block[j,i]:=true;
end;
end;
with image1.Canvas do begin
for i:=0 to 2 do begin
brush.Color:=clyellow;
for j:=0 to 9 do begin
fillrect(rect((image1.Width div 10)*j,20+20*i,(image1.Width div 10)*(j+1)-1,30+20*i));
end;
end;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
i:integer;
begin
with image1.Canvas do begin
//ボールがあった部分を黒く塗る
brush.Color:=clblack;
fillrect(rect(ballx,bally,ballx+balls,bally+balls));
end;
//ボールの新しい座標を求める
if (ballx<=0) or (ballx>=image1.Width-balls) then bx:=-bx;
ballx:=ballx+bx;
if bally<=0 then by:=-by;
bally:=bally+by;
if bally>=500 then begin
timer1.Enabled:=false;
//ブロックに当たったか調べる
if (bally>=60) and (bally<=70) then begin
i:=ballx div (image1.Width div 10);
if block[i,2]=true then begin
block[i,2]:=false;
by:=-by;
with image1.Canvas do begin
brush.Color:=clblack;
fillrect(rect(i*(image1.Width div 10),60,(i+1)*(image1.Width div 10),70));
end;
end;
if (bally>=40) and (bally<=50) then begin
i:=ballx div (image1.Width div 10);
if block[i,1]=true then begin
block[i,1]:=false;
by:=-by;
with image1.Canvas do begin
brush.Color:=clblack;
fillrect(rect(i*(image1.Width div 10),40,(i+1)*(image1.Width div 10),50));
end;
end;
if (bally>=20) and (bally<=30) then begin
i:=ballx div (image1.Width div 10);
if block[i,0]=true then begin
block[i,0]:=false;
by:=-by;
with image1.Canvas do begin
brush.Color:=clblack;
fillrect(rect(i*(image1.Width div 10),20,(i+1)*(image1.Width div 10),30));
end;
end;
//bx,by進んだ位置にボールを描く
with image1.Canvas do begin
brush.Color:=clwhite;
fillrect(rect(ballx,bally,ballx+balls,bally+balls));
end;
//ラケットを動かす
if keyd<>0 then begin
with image1.Canvas do begin
brush.Color:=clblack;
fillrect(rect(rakx,raky,rakx+rakw,raky+10));
rakx:=rakx+keyd;
brush.Color:=clwhite;
fillrect(rect(rakx,raky,rakx+rakw,raky+10));
end;
end;
end;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
Timer1: TTimer;
procedure makeBlock;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
{ Private 宣言 }
ballx,bally,bx,by,balls,score,ballk:integer; //scoreは消したブロックの数，ballkは使用できるボールの数
rakx,raky,rakw,keyd:integer;
block:array[0..10,0..2] of boolean;
gameover:boolean; //gameoverはtrueでゲームオーバー，falseでゲーム継続
public{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
form1.ClientWidth:=400;
form1.ClientHeight:=500;
image1.Left:=0;
image1.Top:=0;
image1.Width:=form1.ClientWidth;
image1.Height:=form1.ClientHeight;
ballk:=3; //ボールの個数を３個に設定
gameover:=false; //gameoverをfalseに設定
score:=1; //scoreを１に設定
rakx:=200;gameover:=false; //gameoverをfalseに設定
score:=1; //scoreを１に設定
raky:=450;
rakw:=40;
with image1.Canvas do begin
brush.Color:=clblack;
fillrect(image1.Canvas.ClipRect);
//ラケットを描く
brush.Color:=clwhite;
fillrect(rect(rakx,raky,rakx+rakw,raky+10));
end;
makeblock;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=VK_right then keyd:=4;
if key=VK_left then keyd:=-4;
if key=VK_space then begin
if gameover=true then exit; //もしgameoverがtrueなら以下のプログラムを実行しない
//ボールの出方に変化を持たせる
randomize; //乱数の初期化
ballx:=random(200)+100; //ballxの値を100～299にする
bally:=300;ballx:=random(200)+100; //ballxの値を100～299にする
bx:=(random(2)*2-1)*3; //bxの値を-3または3にする
by:=-6;balls:=6;
with image1.Canvas do begin
brush.Color:=clblack;
fillrect(rect(0,200,image1.Width,450));
end;
timer1.Enabled:=true;
end;
end;
procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
keyd:=0;
end;
//===============================================
//ブロックを表示する=============================
procedure TForm1.makeBlock;
var
i,j:integer;
begin
for i:=0 to 2 do begin
for j:=0 to 9 do begin
block[j,i]:=true;
end;
end;
with image1.Canvas do begin
for i:=0 to 2 do begin
brush.Color:=clyellow;
for j:=0 to 9 do begin
fillrect(rect((image1.Width div 10)*j,20+20*i,(image1.Width div 10)*(j+1)-1,30+20*i));
end;
end;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
i:integer;
begin
with image1.Canvas do begin
//ボールがあった部分を黒く塗る
brush.Color:=clblack;
fillrect(rect(ballx,bally,ballx+balls,bally+balls));
end;
//ボールの新しい座標を求める
if (ballx<=0) or (ballx>=image1.Width-balls) then bx:=-bx;
ballx:=ballx+bx;
if bally<=0 then by:=-by;
bally:=bally+by;
//ボールがラケットに当たったか調べる
if (bally>=raky-balls) and (bally<raky+5) then begin
if (ballx>=rakx) and (ballx<=rakx+rakw) then begin
by:=-by;
if keyd>0 then bx:=bx+2;
if keyd<0 then bx:=bx-2;
end;
end;
//ゲームオーバーif (bally>=raky-balls) and (bally<raky+5) then begin
if (ballx>=rakx) and (ballx<=rakx+rakw) then begin
by:=-by;
if keyd>0 then bx:=bx+2;
if keyd<0 then bx:=bx-2;
end;
end;
if bally>=500 then begin
timer1.Enabled:=false;
dec(ballk);//ボールの個数を１つ減らす
if ballk>0 then begin//ボールの個数が0より大きかったら
with image1.Canvas do begin
font.Color:=clred;
font.Size:=30;
textout((image1.Width-textwidth('ボール残り'+inttostr(ballk)+'個')) div 2,200,
'ボール残り'+inttostr(ballk)+'個');
//ボールの残り個数を表示
end;
end else begin
//ボールの残り個数が0になったとき
gameover:=true;//vameoverをtrueにする
with image1.Canvas do begin
font.Color:=clred;
font.Size:=30;
textout((image1.Width-textwidth('Game Over')) div 2,200,'Game Over');
//「Game Over」を表示
end;
end;
end;if ballk>0 then begin//ボールの個数が0より大きかったら
with image1.Canvas do begin
font.Color:=clred;
font.Size:=30;
textout((image1.Width-textwidth('ボール残り'+inttostr(ballk)+'個')) div 2,200,
'ボール残り'+inttostr(ballk)+'個');
//ボールの残り個数を表示
end;
end else begin
//ボールの残り個数が0になったとき
gameover:=true;//vameoverをtrueにする
with image1.Canvas do begin
font.Color:=clred;
font.Size:=30;
textout((image1.Width-textwidth('Game Over')) div 2,200,'Game Over');
//「Game Over」を表示
end;
end;
//ブロックに当たったか調べる
if (bally>=60) and (bally<=70) then begin
i:=ballx div (image1.Width div 10);
if block[i,2]=true then begin
block[i,2]:=false;
by:=-by;
with image1.Canvas do begin
brush.Color:=clblack;
fillrect(rect(i*(image1.Width div 10),60,(i+1)*(image1.Width div 10),70));
end;
inc(score); //scoreに１加える
end;end;
if (bally>=40) and (bally<=50) then begin
i:=ballx div (image1.Width div 10);
if block[i,1]=true then begin
block[i,1]:=false;
by:=-by;
with image1.Canvas do begin
brush.Color:=clblack;
fillrect(rect(i*(image1.Width div 10),40,(i+1)*(image1.Width div 10),50));
end;
inc(score); //scoreに１加える
end;end;
if (bally>=20) and (bally<=30) then begin
i:=ballx div (image1.Width div 10);
if block[i,0]=true then begin
block[i,0]:=false;
by:=-by;
with image1.Canvas do begin
brush.Color:=clblack;
fillrect(rect(i*(image1.Width div 10),20,(i+1)*(image1.Width div 10),30));
end;
inc(score);//scoreに１加える
end;end;
//ブロックがなくなったとき
if score mod 31 =0 then begin
timer1.Enabled:=false;
inc(score);
makeblock;//新しくブロックを表示する
exit;
end;
if score mod 31 =0 then begin
timer1.Enabled:=false;
inc(score);
makeblock;//新しくブロックを表示する
exit;
end;
//bx,by進んだ位置にボールを描く
with image1.Canvas do begin
brush.Color:=clwhite;
fillrect(rect(ballx,bally,ballx+balls,bally+balls));
end;
//ラケットを動かす
if keyd<>0 then begin
with image1.Canvas do begin
brush.Color:=clblack;
fillrect(rect(rakx,raky,rakx+rakw,raky+10));
rakx:=rakx+keyd;
brush.Color:=clwhite;
fillrect(rect(rakx,raky,rakx+rakw,raky+10));
end;
end;
end;
まだまだ改良する点はありますが，以上で終了します。
今までのプログラムを，ダウンロードできるようにしましたので，興味のある人は見てください。
なお，ダウンロードファイルは，「Delphi XE2」で作成したものです。ですので「Delphi XE2」以降のものがないと開くことができません。
また，このプログラムは適当に改良して再配布しても構いませんので，ご自由にお使いください。