リバーシ ゲームの作成(WindowsとAndroidで動作) ~Delphiソースコード集
Delphiを起動してプロジェクトを作成し、オブジェクトを配置し、プロパティを設定する。
Delphiを起動し[ファイル]→[新規作成]→[マルチデバイスアプリケーション-Delphi]をクリックします。[空のアプリケーション]を選択して[OK]ボタンを押します。
Form1の widthプロパティを"320"に設定します。
Form1の heightプロパティを"500"に設定します。
ツールパレットからTScaledLayoutをドラッグ&ドロップします。
ScaledLayout1のPosition.Xプロパティを"0"に設定します。
ScaledLayout1のPosition.Yプロパティを"0"に設定します。
ScaledLayout1のWidthプロパティを"320"に設定します。
ScaledLayout1のHeightプロパティを"500"に設定します。
ツールパレットからTLayoutをScaledLayout1にドラッグ&ドロップします。
Layout1のAlignプロパティを"Top"に設定します。
Layout1のHeightプロパティを"50"に設定します。
ツールパレットからTButtonをLayout1にドラッグ&ドロップします。
Button1のAlignプロパティを"MostLeft"に設定します。
Button1のMargins.Bottom,Margins.Left,Margins.Right,Margins.Topプロパティを"2"に設定します。
Button1のTextプロパティを"開始"に設定します。
ツールパレットからTButtonをLayout1にドラッグ&ドロップします。
Button2のAlignプロパティを"Left"に設定します。
Button2のMargins.Bottom,Margins.Left,Margins.Right,Margins.Topプロパティを"2"に設定します。
ツールパレットからTMemoをScaledLayout1にドラッグ&ドロップします。
Memo1のAlignプロパティを"Bottom"に設定します。
Memo1のHeightプロパティを"130"に設定します。
ツールパレットからTImageをScaledLayout1にドラッグ&ドロップします。
Image1のAlignプロパティを"Client"に設定します。
(重要)Image1のMultiResBitmapプロパティに、何でもいいので小さい画像ファイルを設定します。
Image1のWrapModeプロパティを"Fit"に設定します。
ツールパレットからTTimerをフォームへドラッグ&ドロップします。
Timer1のEnabledプロパティを"False"に設定します。
プログラミング
unit Unit1; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls, FMX.Objects, FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo, FMX.Layouts; type TForm1 = class( TForm) ScaledLayout1: TScaledLayout; Layout1: TLayout; Memo1: TMemo; Image1: TImage; Button1: TButton; Button2: TButton; Timer1: TTimer; procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); procedure Button2Click(Sender: TObject); private { private 宣言 } com_iro:Integer; //PCの色 1:白,2:黒 user_iro:Integer;//ユーザーの色 1:白,2:黒 //PCの順番1、ユーザーの順番2 OrderPcUser:integer; //盤の状態を保持する 0まだおかれてない、1白、2黒 fBoard:array[0..7] of array[0..7] of Integer; //PCの番の時に呼ぶ関数 procedure PcCalculate(); //配列fBoardに基づき、絵を描く procedure DrawBoard(); //順番を入れ替える(ラベルにも表示する) procedure OrderChange(); //開始(初期化処理) procedure GameStart(); //指定したx,y座標に色(iro=1:白,2:黒)が置けるか //裏返す方向はdx,dyで指定する //置けるならTrue、置けないならFalseを返す function CanPutPiece(x,y, OkuIro, dx,dy: integer): boolean; //全ての方向に対してCanPutPieceを呼び出す function CanPutPieces(x,y, iro:integer):boolean; //指定したx,y座標に色(iro=1:白,2:黒)が置けるなら裏返す //置けるならTrue、置けないならFalseを返す function ReversePiece(x, y, iro,dx,dy: integer): Boolean; //全ての方向に対してReversePieceを呼び出す function ReversePieces(x, y, iro: integer): Boolean; //全て駒を置いた、又はもう駒を置けないか確認する //未だ駒を置ける場合はFalse、置けない場合はTrueを返す function CheckPieces():boolean; //PCとユーザーの駒の数を集計して表示する function PieceCount():boolean; //ユーザーの置ける場所が無いか確認する。無ければTrue function Cannot_UserPutPiece():boolean; //コンピューターの置ける場所が無いか確認する。無ければTrue function Cannot_ComPutPiece: boolean; public { public 宣言 } end; var Form1: TForm1; //PCの手 ai:array[0..63] of TPoint = ( (X:0;Y:0),(X:0;Y:7),(X:7;Y:7),(X:7;Y:0), (X:2;Y:2),(X:2;Y:5),(X:5;Y:5),(X:5;Y:2), (X:2;Y:0),(X:0;Y:2),(X:0;Y:5),(X:2;Y:7), (X:5;Y:7),(X:7;Y:5),(X:7;Y:2),(X:5;Y:0), (X:3;Y:1),(X:1;Y:3),(X:1;Y:4),(X:3;Y:6), (X:4;Y:6),(X:6;Y:4),(X:6;Y:3),(X:4;Y:1), (X:3;Y:0),(X:0;Y:3),(X:0;Y:4),(X:3;Y:7), (X:4;Y:7),(X:7;Y:4),(X:7;Y:3),(X:4;Y:0), (X:3;Y:2),(X:2;Y:3),(X:2;Y:4),(X:3;Y:5), (X:4;Y:5),(X:5;Y:4),(X:5;Y:3),(X:4;Y:2), (X:2;Y:1),(X:1;Y:2),(X:1;Y:5),(X:2;Y:6), (X:5;Y:6),(X:6;Y:5),(X:6;Y:2),(X:5;Y:1), (X:1;Y:0),(X:0;Y:1),(X:0;Y:6),(X:1;Y:7), (X:6;Y:7),(X:7;Y:6),(X:7;Y:1),(X:6;Y:0), (X:1;Y:1),(X:1;Y:6),(X:6;Y:6),(X:6;Y:1), (X:3;Y:3),(X:3;Y:4),(X:4;Y:4),(X:4;Y:3) ); implementation {$R *.fmx} { TForm1 } procedure TForm1.PcCalculate; var i: Integer; dx,dy:integer; begin if OrderPcUser=2 then exit; dx:=-1; dy:=-1; //ai.x,ai.y座標の順に、そこにこまが置けるか調べる for i := 0 to 63 do begin if fBoard[ai[i].X,ai[i].Y]=0 then begin if CanPutPieces(ai[i].X,ai[i].Y,com_iro) then begin //こまが置けるのでその座標を変数に保持する dx:=ai[i].X; dy:=ai[i].Y; break; end; end; end; if dx=-1 then begin //こまが置けないのでパスする Memo1.Lines.Add('PC:駒を置く場所が無いのでパス'); Memo1.GoToTextEnd; end else begin //こまが置けるのでこまを置く fBoard[dx,dy]:=com_iro; //裏返す ReversePieces(dx,dy,com_iro); end; OrderChange(); end; procedure TForm1.Button1Click(Sender: TObject); begin GameStart(); end; procedure TForm1.Button2Click(Sender: TObject); begin if OrderPcUser=2 then if Cannot_UserPutPiece() then OrderChange(); end; function TForm1.Cannot_ComPutPiece: boolean; var x,y:integer; flag:boolean; begin flag:=false; for x := 0 to 7 do for y := 0 to 7 do begin if fBoard[x,y]=0 then begin if CanPutPieces(x,y,com_iro) then flag:=true; end; end; result:=not flag; end; procedure TForm1.DrawBoard; var x,y:integer; begin Image1.Bitmap.Canvas.BeginScene(); Image1.Bitmap.Canvas.Fill.Color:=TAlphaColorRec.Green; Image1.Bitmap.Canvas.Fill.Kind:=TBrushKind.Solid; Image1.Bitmap.Canvas.FillRect( RectF(0,0,Image1.Bitmap.Width,Image1.Bitmap.Height), 0,0,[],1 ); Image1.Bitmap.Canvas.Stroke.Color:=TAlphaColorRec.White; Image1.Bitmap.Canvas.Stroke.Thickness:=6; Image1.Bitmap.Canvas.Stroke.Kind:=TBrushKind.Solid; for x := 0 to 8 do begin Image1.Bitmap.Canvas.DrawLine( PointF(x*80,0),PointF(x*80,640),1); end; for y := 0 to 8 do begin Image1.Bitmap.Canvas.DrawLine( PointF(0,y*80),PointF(640,y*80),1); end; //駒の色を描画する for x := 0 to 7 do begin for y := 0 to 7 do begin if fBoard[x,y]=1 then begin Image1.Bitmap.Canvas.Fill.Color:=TAlphaColorRec.White; Image1.Bitmap.Canvas.Fill.Kind:=TBrushKind.Solid; Image1.Bitmap.Canvas.Stroke.Color:=TAlphaColorRec.Black; Image1.Bitmap.Canvas.Stroke.Thickness:=2; Image1.Bitmap.Canvas.Stroke.Kind:=TBrushKind.Solid; //楕円塗りつぶし Image1.Bitmap.Canvas.FillEllipse( RectF(x*80+10,y*80+10,x*80+60,y*80+60),1); //楕円境界線描画 Image1.Bitmap.Canvas.DrawEllipse( RectF(x*80+10,y*80+10,x*80+60,y*80+60),1); end; if fBoard[x,y]=2 then begin Image1.Bitmap.Canvas.Fill.Color:=TAlphaColorRec.Black; Image1.Bitmap.Canvas.Fill.Kind:=TBrushKind.Solid; Image1.Bitmap.Canvas.Stroke.Color:=TAlphaColorRec.White; Image1.Bitmap.Canvas.Stroke.Thickness:=2; Image1.Bitmap.Canvas.Stroke.Kind:=TBrushKind.Solid; //楕円塗りつぶし Image1.Bitmap.Canvas.FillEllipse( RectF(x*80+10,y*80+10,x*80+60,y*80+60),1); //楕円境界線描画 Image1.Bitmap.Canvas.DrawEllipse( RectF(x*80+10,y*80+10,x*80+60,y*80+60),1); end; end; end; Image1.Bitmap.Canvas.EndScene; PieceCount(); end; procedure TForm1.FormCreate(Sender: TObject); begin Timer1.Enabled:=False; Image1.Bitmap.Width:=640; Image1.Bitmap.Height:=640; Randomize; OrderPcUser:=0; GameStart(); end; procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); var bx,by,ww:integer; begin ww:=trunc(Image1.Width); if Image1.Width>Image1.Height then begin ww:=trunc(Image1.Height); end; if OrderPcUser=2 then begin bx:= trunc(x)*8 div ww; by:= trunc(y)*8 div ww; if (fBoard[bx,by]=0) and (CanPutPieces(bx,by,user_iro)) then begin fBoard[bx,by]:=user_iro; ReversePieces(bx,by,user_iro); OrderChange(); end else begin Memo1.Lines.Add('指定した場所には置けません'); Memo1.GoToTextEnd; end; end; end; function TForm1.CheckPieces: boolean; //全て駒を置いた、又はもう駒を置けないか確認する //未だ駒を置ける場合はFalse、置けない場合はTrueを返す var flag:boolean; x,y:integer; begin flag:=True; for x := 0 to 7 do for y := 0 to 7 do if fBoard[x,y]=0 then flag:=False; //盤面が空いていて白も黒も置けない場合が無いかチェック if flag=False then begin if Cannot_UserPutPiece and Cannot_ComPutPiece then flag:=True; end; Result:= flag; end; function TForm1.PieceCount: boolean; //PCとユーザーの駒の数を集計して表示する var x,y:integer; pc,user:integer; begin pc:=0; user:=0; for x := 0 to 7 do for y := 0 to 7 do begin if fBoard[x,y]=user_iro then inc(user) else if fBoard[x,y]= com_iro then inc(pc); end; Memo1.Lines.Add('あなた:'+inttostr(user)+'個 PC:'+inttostr(pc)+'個'); if CheckPieces then begin Memo1.Lines.Add('ゲーム終了'); OrderPcUser:=0; end; Memo1.GoToTextEnd; Result:=True; end; function TForm1.CanPutPiece(x, y, OkuIro, dx, dy: integer): boolean; //指定したx,y座標に色(iro=1:白,2:黒)が置けるか //裏返す方向はdx,dyのみチェックし、置けるならTrue、置けないならFalseを返す var KaesuIro:Integer;//裏返す対象の色 Flag:Integer; SearchPoint:TPoint;//探索座標 begin Result:=False; //裏返す対象の色を設定 KaesuIro:=1; if OkuIro=1 then KaesuIro:=2; Flag:=0; SearchPoint.X:=x+dx; SearchPoint.Y:=y+dy; while (SearchPoint.X>=0) and (SearchPoint.X<=7) and (SearchPoint.Y>=0) and (SearchPoint.Y<=7) do begin //駒が無かったら終了 if fBoard[SearchPoint.X,SearchPoint.Y]=0 then Break else if fBoard[SearchPoint.X,SearchPoint.Y]=KaesuIro then Flag:=1 //ひっくり返す色だった場合はflagを1にする else if fBoard[SearchPoint.X,SearchPoint.Y]=OkuIro then begin //ひっくり返す色が間にあったのでflagを2にする if Flag=1 then Flag:=2; Break; end; SearchPoint.X:=SearchPoint.X+dx; SearchPoint.Y:=SearchPoint.Y+dy; end; //駒を置いてひっくり返すことが出来るのでTrueを返す if Flag=2 then begin Result:=True; end; end; function TForm1.CanPutPieces(x, y, iro: Integer): Boolean; var Flag:Boolean; begin Flag:=false; if CanPutPiece(x,y,iro, 0,-1) then Flag:=True; if CanPutPiece(x,y,iro,-1,-1) then Flag:=True; if CanPutPiece(x,y,iro,-1, 0) then Flag:=True; if CanPutPiece(x,y,iro,-1, 1) then Flag:=True; if CanPutPiece(x,y,iro, 0, 1) then Flag:=True; if CanPutPiece(x,y,iro, 1, 1) then Flag:=True; if CanPutPiece(x,y,iro, 1, 0) then Flag:=True; if CanPutPiece(x,y,iro, 1,-1) then Flag:=True; Result:=Flag; end; function TForm1.ReversePiece(x, y, iro, dx, dy: integer): Boolean; //指定したx,y座標におければ裏返す。 //置く駒の色(iro)は1白、2黒、指定した方向(dx,dy)を確認する //置けるならTrue、置けないならFalseを返す var SearchPoint:TPoint; begin Result:=CanPutPiece(x,y,iro,dx,dy); //裏返る場合 if Result then begin SearchPoint.X:=x+dx; SearchPoint.Y:=y+dy; while fBoard[SearchPoint.X,SearchPoint.Y]<>iro do begin fBoard[SearchPoint.X,SearchPoint.Y]:=iro; SearchPoint.X:=SearchPoint.X+dx; SearchPoint.Y:=SearchPoint.Y+dy; end; end; end; function TForm1.ReversePieces(x, y, iro: integer): boolean; var flag:Boolean; begin flag:=False; if ReversePiece(x,y,iro, 0,-1) then flag:=True; if ReversePiece(x,y,iro,-1,-1) then flag:=True; if ReversePiece(x,y,iro,-1, 0) then flag:=True; if ReversePiece(x,y,iro,-1, 1) then flag:=True; if ReversePiece(x,y,iro, 0, 1) then flag:=True; if ReversePiece(x,y,iro, 1, 1) then flag:=True; if ReversePiece(x,y,iro, 1, 0) then flag:=True; if ReversePiece(x,y,iro, 1,-1) then flag:=True; DrawBoard(); result:=flag; end; procedure TForm1.OrderChange; begin if OrderPcUser=1 then OrderPcUser:=2 else if OrderPcUser=2 then OrderPcUser:=1; if OrderPcUser=1 then Memo1.Lines.Add('PCの番'); if OrderPcUser=2 then Memo1.Lines.Add('あなたの番'); Memo1.GoToTextEnd; if OrderPcUser=1 then Timer1.Enabled:=True; end; procedure TForm1.Timer1Timer(Sender: TObject); begin Timer1.Enabled:=False; PcCalculate(); end; procedure TForm1.GameStart; //開始(初期化処理) var x,y:integer; begin Memo1.Lines.Clear; for x := 0 to 7 do for y := 0 to 7 do fBoard[x,y]:=0; //リバーシの最初の置き方 fBoard[3,3]:=1; fBoard[4,4]:=2; fBoard[3,4]:=2; fBoard[4,3]:=1; OrderPcUser:=Random(2)+1; user_iro:=Random(2)+1; if user_iro=1 then com_iro:=2 else com_iro:=1; DrawBoard(); if user_iro=1 then Memo1.Lines.Add('あなたの色:白') else Memo1.Lines.Add('あなたの色:黒'); if OrderPcUser=1 then Memo1.Lines.Add('PCの番') else Memo1.Lines.Add('あなたの番'); Memo1.GoToTextEnd; if OrderPcUser=1 then Timer1.Enabled:=True; end; function TForm1.Cannot_UserPutPiece: boolean; //ユーザーの置ける場所が無いか確認する。無ければTrue var x,y:integer; flag:boolean; begin flag:=False; for x := 0 to 7 do for y := 0 to 7 do begin if fBoard[x,y]=0 then begin if CanPutPieces(x,y,user_iro) then flag:=True; end; end; Result:=not flag; end; end.
実行ボタンを押す(WindowsでもAndroidでも動作します)
実行ボタンを押すと、コンパイルして起動します。クリック、またはタップすると駒を配置できます。