Delphi VCLで３Ｄダンジョンを作ってみよう【迷路編】

前回からの続きです。

前回からの続きです。
右へ左へと折れ曲がる３Ｄ迷路を作ります。
delphi Advent Calendar 2024 12/14からの続きになります。

プログラムの全文は、末尾に折り畳みで掲載しています。

画面を準備します

まず、エクスプローラーでマイドキュメントを開いて、
C:\Users\【中略】\ドキュメント\Embarcadero\Studio\Projects
の下に、「Dungeon」 みたいな、適当な名前で作業用のフォルダーを作ってください。

つぎに、Delphi 12 Community Editionを起動します。
ファイル > 新規作成 > Windows VCLアプリケーション

操作説明

[地図CSV読込]ボタンを押すと、マップエディター編で作ったデータを、右側のStringGid1に読み込みます。左側のImage1には、StringGrid1のデータを読んで、迷路を描画します。

Plforwardをクリックで前進、PlLeftで左に向き、反時計回りに旋回します。PlRightは右向き、時計回りに旋回します。

地図表示について

左側は、地図、マップ画面となっています。
大きさは、縦✕横　ともに21セルです。

自機の位置は、グローバル変数で保持しています。
gPosX が　横で　StringGrid1.Colと
gPosY が　縦で　StringGrid1.Rowと
それぞれ同じ値になるように、クリックイベント内で代入しています。
gAroow が　自機の向きを現しています。

描画は、セルの値が「1111」のとき、壁 clGray 、それ以外の値は、通路 clSkyBlue です。

3D迷路の描画処理について

FormCreate

初期化処理を担当します。
マップ画面　StringGrid1　の大きさやセルの数を設定します。
迷路画面　の大きさを設定します。

Button1Click 地図CSV読込

StringGridを初期化します。
外周３セルが壁ですが、２１×２１と小さいので、全体を「1111」で埋めています。

PrintMap

StringGrid を描きます。
自機の位置表示の紅い三角は、Polygonで描いています。

PlLeftClick と　PlRightClick

自機の向きを、左または右に、旋回します。
gArrow の値を　左ならば　-1　右ならば　+１します。

gArrow の値は、
前が０　右１　後２　左３　です。

PlforwardClick

自機を、gArrow の方向へ　１歩前進します。
gArrow=0 のときは、 gPosYを -１ します。
gArrow=1 のときは、 gPosXを +１ します。
gArrow=2 のときは、 gPosYを +１ します。
gArrow=3 のときは、 gPosXを -１ します。

PlforwardMouseDown と PlforwardMouseUp

Panelをボタンの代わりにしてます。何か、ちょいお飾りがほしいな　ということです。
マウスボタンを押し下げると、Panelのフォントの赤色に変えます。
マウスボタンを離すと、Panelのフォントの色を黒色に戻します。

TPanel(sender).font.Color:=clRed;
で、PlLeft と　PlRight　と　Plforward　の３つのパネルで、イベントハンドラを共有しています。

Rotate(arrow:longint; Ms:String) :String;

StringGid1が持っている地図データを、arrowの向きに回して、返します。

StringGrid1Click

マップ上をクリックしたら、自機をクリックされた座標に移動します。
ただし、外周３セルは、進入禁止です。

Button2Click

終了ボタンです。

迷路の描画手順について

DrawMaze(x,y,arrow:longint)　が担当しています。
このお題のメインディッシュです。
x,y の位置から、 arrow の向きに見た３Ｄ迷路を描画します。

まず、StringGrid1 を Arrow の値に合わせて読み出します。

前向き（Arrow = 0）と、右向き（Arrow = 1）の場合を例に、図示したものが上図です。
プログラムコードに表すと、下のようになります。
arrowの値で、どのセルを読み出すのかを変えています。

  case arrow of                                   //arrow にあわせて
  0:                                              //自機の前方4セルのデータを回します
    begin
      M0:=StringGrid1.cells[x,y];                  //　　[M3]
      M1:=StringGrid1.cells[x,y-1];                //    [M2]
      M2:=StringGrid1.cells[x,y-2];                //    [M1]
      M3:=StringGrid1.cells[x,y-3];                //    [M0]
    end;                                    　     //
  1:
    begin
      M0:=Rotate(arrow,StringGrid1.cells[x,y]);     //
      M1:=Rotate(arrow,StringGrid1.cells[x+1,y]);   // [M0][M1][M2][M3]
      M2:=Rotate(arrow,StringGrid1.cells[x+2,y]);   //
      M3:=Rotate(arrow,StringGrid1.cells[x+3,y]);   //
    end;

これで、arrowで表す進行方向のセルから、壁のデータを集められました。
次に、セルのデータを、ひとつずつ向きに合わせて、方向転換します。
Arrow = 0 つまり　前向きのときは、StringGrid1のデータをそのまま使います。変換は要りません。
でも、Arrow = 1 の右向きのときは、StringGrid1のデータを、右へ回す必要があります。

データを回す処理は、Rotate(arrow:longint; Ms:String) :String;　というサブルーチンを作っています。

Arrowが0、つまり前向きのときは、変換の必要がないため、上図のプログラムでは、
Rotate( )を書いていません。
この図では、三角の左と後に壁（赤い太線で表示）があります。

マップエディターは、周囲の４セルを、前 右 後 左 の順番に時計回りに読み出していました。
この例のセルでは、0011がセルの値として保存されています。

ということは..
右へ向いたときは、データも右へ回った状態に変換する必要があります。

データは、時計回りに作られていますから、文字列のしっぽから、あたまへ移動したら、図のようにデータを回すことができます。

以上で、データができました。
あとは、データの１のところに壁を描けば、３Ｄ迷路を描くことができます。

壁を描く処理について

輪郭線を描きます

最初に、clBlack で、一点透視法のパースみたいな、輪郭線を描きます。つぎに、壁や床にあたる部分を、CanvasのFloodFill　関数で塗りつぶします。

FloodFill関数
パラメーター	設定値の意味
基準点 X	壁や床にする領域の中の X
基準点 Y	壁や床にする領域の中の y
境界色	clBlack 輪郭線の黒色が境界色
塗りつぶし方法	fsBorder 境界色までBrush.Colorで塗りつぶします。

M0 自機のいるセルから順番に壁と床を塗ります

自機のいるセルの右側を塗る処理を例に説明します。

マップエディター編を思い出してください。この迷路のデータ構造は、図のようになっています。
ということは、左右の通路にチラ見せする隣の通路の壁は、図のように判定したら描けます。
プログラムにすると、次のようになります。

    //Right
    if Copy(M0,2,1)='1' then
      FloodFill(480,250,clblack,fsBorder)      //自機のいるセルの右が壁
    else
      if Copy(M1,2,1)='1' then //横壁を描く     //自機のいるセルの右が空間
      begin                                    
        rectangle (450,50,500,450);            //右通路の壁を描きます
        brush.Color:=clSilver;  //床の色
        FloodFill (460,455,clblack,fsBorder);  //右通路の床を塗ります
        brush.Color:=clCream;   //壁の色        //壁の色に戻します
      end;

この処理を、自機のいるセル、ひとつ前のセル、ふたつ前のセルに対して、左右の壁について繰り返します。

それから、正面が壁のときは、向こうが見えませんから、処理を抜けます。

   //手前壁
    if Copy(M1,3,1)='1' then                    //正面、壁
    begin                                       //向こうは見えません
      rectangle(50,50,450,450);
      exit;                                     //処理を抜けます
    end;

プログラム全文を乗せます。

▼▼▼　クリックして　開いてください　▼▼▼

プログラム全文　[クリックで開いてください]

unit TfmMains;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.Grids, Vcl.StdCtrls,System.Types;

type
  TfmMain = class(TForm)
    Panel1: TPanel;
    panel2: TPanel;
    Panel3: TPanel;
    Image1: TImage;
    StringGrid1: TStringGrid;
    Button1: TButton;
    Button2: TButton;
    PlRight: TPanel;
    Plforward: TPanel;
    PlLeft: TPanel;
    OpenDialog1: TOpenDialog;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure PrintMap;
    procedure StringGrid1Click(Sender: TObject);
    procedure PlLeftClick(Sender: TObject);
    procedure PlforwardClick(Sender: TObject);
    procedure PlRightClick(Sender: TObject);
    procedure PlforwardMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PlforwardMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private 宣言 }
    gPosx,gposy,garrow:longint; //自機位置
  public
    { Public 宣言 }
    function Rotate(arrow:longint; Ms:String):String; //マップ壁情報を向きに合わせて回す
    procedure DrawMaze(x,y,arrow:longint);  //迷路を描く

  end;

var
  fmMain: TfmMain;

implementation

{$R *.dfm}

procedure TfmMain.FormCreate(Sender: TObject);
var
  x,y:longint;
begin
  with StringGrid1 do
  begin
    width:=21*21+4;         //地図画面 21セル✕セルの幅21pix + 余白4
    height:=21*21+4;

    Colcount:=21;           //初期化　迷路はcol:横　row:縦　とも21　うち固定壁6
    RowCount:=21;
    FixedCols:=0;
    FixedRows:=0;

    for y:=0 to 20 do
      ColWidths[y] := 20;

    for x:=0 to 20 do
      RowHeights[x] := 20;
  end;

  gPosx:=3;                 //自機初期位置
  gPosy:=3;
  StringGrid1.col:=gPosX;
  StringGrid1.row:=gPosY;
  gArrow:=0;                //↑0　→1　↓2　←3   初期向き

  image1.width:=500;        //迷路画面 500✕500 pix
  image1.height:=500;
end;

procedure TfmMain.Button1Click(Sender: TObject);
var
  y,x:longint;
  S,M:String;
  path:string;
  StList:TStringList;

begin
  //マップデータを読みます。
  //MapEditer で作った WallMap.csv を読みます。

  path:=ExtractFilePath(Application.Exename);      //このアプリのある場所のパス
  OpenDialog1.InitialDir:=path;

  if OpenDialog1.Execute=False then
    exit;

  for y:=0 to 21 do                                //初期化　全部壁で埋めます
    for x:=0 to 21 do
      StringGrid1.cells[x,y]:='1111';

  StList:=TStringList.Create;    //文字列リスト作成

  try
    StList.LoadFromFile(OpenDialog1.FileName);      //マップデータを読込ます

    for y:=0 to 15 do
    begin                                           //Col Row ともに22セル
      M:=StList[y];                                 //外周3セルは固定壁なので、
      for x:=0 to 15 do                             //16列　16行を読みます。
      begin
        S:=Copy(M,x*5+1,4);                         // 1111,1111,1111, なので
        StringGrid1.cells[x+3,y+3]:=S;               // 5文字ずつの位置から、4文字読みます
      end;                                          // カンマを飛ばします
    end;                                            // x+3 y+3 は外周固定壁分です

  finally
    StList.free;                                    //文字列リストを開放
  end;

  PrintMap;
  PlforwardClick(Sender);
end;

procedure TfmMain.PrintMap;
var
  x,y,w,h:longint;
  Pts:array[0..2] of TPoint;                        //三角形をつくる頂点
  R:TRect;
begin                                               //セル幅　+線の幅
  w:=StringGrid1.ColWidths[0]+1;                     //セル高さ+線の幅
  h:=StringGrid1. RowHeights[0]+1;

  With StringGrid1 do
  begin
    for y:=0 to 21 do
      for X:=0 to 21 do
      begin
        R:=rect(x*w,y*h,x*w+w-1,y*h+h-1);           //セル1個の描画領域
        if Cells[x,y]='1111' then
          Canvas.Brush.color:=clGray                //1111は壁=clGray
        else
          Canvas.Brush.color:=clSkyBlue;            //それ以外=clSkyBlue

        Canvas.FillRect(R);                         //塗り

        R:=Rect(R.left+2,R.top+2,R.right-2,R.bottom-2);   //ひとまわり縮小

        if (gPosX=x)and(gPosY=Y) then                     //座標読み出し
        begin
          Canvas.brush.color:=clRed;                      //三角は赤色

          case gArrow of
            0:                                            //0=上向き
            begin
              pts[0]:=point(R.left+8,R.top);
              pts[1]:=point(R.right,R.bottom);
              pts[2]:=point(R.left,R.bottom);
            end;
            1:                                            //1=右向き
            begin
              pts[0]:=point(R.right,R.top+8);
              pts[1]:=point(R.left,R.bottom);
              pts[2]:=point(R.left,R.top);
            end;
            2:                                            //2=下向き
            begin
              pts[0]:=point(R.left+8,R.bottom);
              pts[1]:=point(R.left,R.top);
              pts[2]:=point(R.right,R.top);
            end;
            3:                                            //3=左向き
            begin
              pts[0]:=point(R.left,R.Top+8);
              pts[1]:=point(R.right,R.Top);
              pts[2]:=point(R.right,R.bottom);
            end;
          end;

          canvas.Polygon(pts);                            //三角形描画
        end;
      end;
  end;
end;

procedure TfmMain.PlLeftClick(Sender: TObject);   //左旋回　反時計回り
begin
  gArrow:=gArrow-1;
  if gArrow<0then
    gArrow:=3;

  panel1.caption:='X:'+inttostr(gPosX)+'  Y:'+inttostr(gPosY)+  'Arrow:'+inttoStr(gArrow);
  DrawMaze(gPosX,gPosY,gArrow);             //迷路描画
  PrintMap;                                 //地図描画

end;

procedure TfmMain.PlRightClick(Sender: TObject);  //右旋回  時計回り
begin
  gArrow:=gArrow+1;
  if gArrow>=4 then
    gArrow:=0;

  panel1.caption:='X:'+inttostr(gPosX)+'  Y:'+inttostr(gPosY)+  'Arrow:'+inttoStr(gArrow);
  DrawMaze(gPosX,gPosY,gArrow);                  //迷路描画
  PrintMap                         //地図描画
end;

procedure TfmMain.PlforwardClick(Sender: TObject);
begin
  case gArrow of                                 //方向 gArrowにより進む向きを変える
  0:
    if gPosY>3 then
      gPosY:=gPosY-1;
  1:
    if gPosX<18 then
      gPosX:=GPosX+1;
  2:
    if gPosY<18 then
      gPosY:=gPosY+1;
  3:
    if gPosX>3 then
      gPosX:=gPosX-1;
  end;


  //壁ドン判定
  if StringGrid1.cells[gPosX,gPosY]='1111' then
  begin
    gPosX:=StringGrid1.col;  //地図のcol rowに自機位置を戻します
    gPosY:=StringGrid1.Row;
  end
  else
  begin
    StringGrid1.col:=gPosx;          //地図のcol row を更新
    StringGrid1.Row:=gPosY;
    DrawMaze(gPosx,gPosY,gArrow);    //迷路描画
    PrintMap;                        //地図描画
  end;

end;

procedure TfmMain.PlforwardMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  TPanel(sender).font.Color:=clRed;
end;

procedure TfmMain.PlforwardMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  TPanel(sender).font.Color:=clBlack;
end;

function TfmMain.Rotate(arrow:longint; Ms:String) :String; //マップ壁情報を向きに合わせて回す
var
  S:string;
begin
  case arrow of                                //セルの壁データをarrowに合わせて回して返す
  0:
      Result:=Ms;
  1:
    begin
      S:=Copy(Ms,1,1);
      Result:=Copy(Ms,2,3)+S;
    end;
  2:
    begin
      S:=Copy(Ms,3,2);
      Result:=S+Copy(Ms,1,2);
    end;
  3:
    begin
      S:=Copy(Ms,4,1);
      Result:=S+Copy(Ms,1,3);
    end;
  end;
end;

procedure TfmMain.StringGrid1Click(Sender: TObject);
begin
with StringGrid1 do
begin
  if Col<3 then                           //外周３セルは進入禁止
    Col:=3;                               //  0 　1　 2　✕
  if Col>18 then                          // 19　20　21　✕
    Col:=18;
  if Row<3 then
   Row:=3;
  if Row>18 then
   Row:=18;

  gPosX:=Col;               //地図をクリックすると自機の位置も更新
  gPosY:=Row;
end;

  DrawMaze(gPosX,gPosY,gArrow);                  //迷路描画
  PrintMap;                                      //地図描画
end;

procedure TfmMain.Button2Click(Sender: TObject);
begin
  Close;
end;

procedure TfmMain.DrawMaze(x,y,arrow:longint);    //迷路を描画します
var
  M0,M1,M2,M3:String;
begin
  case arrow of                                   //arrow にあわせて
  0:                                              //自機の前方4セルのデータを回します
    begin
      M0:=StringGrid1.cells[x,y];                  //　　[M3]
      M1:=StringGrid1.cells[x,y-1];                //    [M2]
      M2:=StringGrid1.cells[x,y-2];                //    [M1]
      M3:=StringGrid1.cells[x,y-3];                //    [M0]
    end;                                          //
  1:
    begin
      M0:=Rotate(arrow,StringGrid1.cells[x,y]);     //
      M1:=Rotate(arrow,StringGrid1.cells[x+1,y]);   // [M0][M1][M2][M3]
      M2:=Rotate(arrow,StringGrid1.cells[x+2,y]);   //
      M3:=Rotate(arrow,StringGrid1.cells[x+3,y]);   //
    end;
  2:
    begin
      M0:=Rotate(arrow,StringGrid1.cells[x,y]);     //    [M0]
      M1:=Rotate(arrow,StringGrid1.cells[x,y+1]);   //    [M1]
      M2:=Rotate(arrow,StringGrid1.cells[x,y+2]);   //    [M2]
      M3:=Rotate(arrow,StringGrid1.cells[x,y+3]);   //    [M3]
    end;
  3:
    begin
      M0:=Rotate(arrow,StringGrid1.cells[x,y]);     //
      M1:=Rotate(arrow,StringGrid1.cells[x-1,y]);   // [M3][M2][M1][M0]
      M2:=Rotate(arrow,StringGrid1.cells[x-2,y]);   //
      M3:=Rotate(arrow,StringGrid1.cells[x-3,y]);   //
    end;
  end;


  //Map
  with image1.Canvas do           //迷路を描画します。
  begin
    pen.color:=clblack;           //線 は黒色
    brush.color:=clGray;          //空間は clGray
    brush.Style:=bsSolid;         //塗り方は bsSolid = ベタ塗り

    rectangle(0,0,500,500);       //外枠
    rectangle (50, 50,450,450);   //自セル　
    rectangle(150,150,350,350);   //ひとつまえ
    rectangle(200,200,300,300);   //ふたつまえ

    moveto(200,200);              //パースの斜め線
    lineto(0,0);

    moveto(200,300);
    lineto(0,500);

    moveto(300,200);
    lineto(500,0);

    moveto(300,300);
    lineto(500,500);

    brush.Color:=clSilver;               //床の色 は clSilver
    FloodFill(250,330,clblack,fsBorder); //床を塗ります
    FloodFill(250,380,clblack,fsBorder); //FloodFill(基準点X,Y,境界色,境界まで)
    FloodFill(250,480,clblack,fsBorder);


//壁を描きます
    brush.Color:=clCream;                //壁の色 clCream

//位置表示
  panel2.caption:='X:'+inttostr(gPosX)+'  Y:'+inttostr(gPosY)+  '  Arrow:'+inttoStr(gArrow);

  //M0 自分がいるセル

    //Right
    if Copy(M0,2,1)='1' then
      FloodFill(480,250,clblack,fsBorder)      //自機のいるセルの右が壁
    else
      if Copy(M1,2,1)='1' then //横壁を描く     //自機のいるセルの右が空間
      begin
        rectangle (450,50,500,450);             //右横通路の壁を塗ります
        brush.Color:=clSilver;  //床の色
        FloodFill (460,455,clblack,fsBorder);   //床を塗ります
        brush.Color:=clCream;   //壁の色        //壁の色に戻します
      end;

    //Left
    if Copy(M0,4,1)='1' then
      FloodFill(30,250,clblack,fsBorder)        //時期のいるセルの左が壁
    else
    if Copy(M1,4,1)='1' then //横壁を描く       //自機のいるセルの左が空間
      begin
        rectangle (0,50,50,450);                //右横通路を塗ります
        brush.Color:=clSilver;  //床の色
        FloodFill (5,455,clblack,fsBorder);     //床を塗ります
        brush.Color:=clCream;   //壁の色        //壁の色に戻します
      end;


    //手前壁
    if Copy(M0,1,1)='1' then                    //正面、壁
    begin                                       //向こうは見えません
      rectangle(50,50,450,450);
      exit;                                     //処理を抜けます
    end;


//M1ひとつ前のセル

    //Right
    if Copy(M1,2,1)='1' then
      FloodFill(430,250,clblack,fsBorder)      //ひとつ前の右が壁
    else
      if Copy(M0,2,1)='0' then                 //自機の右が空間
      begin
        rectangle (450,50,500,450);            //右横通路を塗ります
        brush.Color:=clSilver;
        FloodFill (460,455,clblack,fsBorder);
        brush.Color:=clCream;
      end;

    //Left
    if Copy(M1,4,1)='1' then
      FloodFill(80,250,clblack,fsBorder)       //ひとつ前の左が壁
    else
      if Copy(M0,4,1)='0' then                 //時期の左が通路
         begin
          rectangle (0,50,50,450);             //左通路を塗ります
          brush.Color:=clSilver;
          FloodFill (5,455,clblack,fsBorder);
          brush.Color:=clCream;
        end;

//M2ふたつ前のセル

  　//Right
    if Copy(M2,2,1)='1' then
    begin
      FloodFill(330,255,clblack,fsBorder);        //ふたつ前の右が壁

      if Copy(M1,2,1)='0' then                    //ひとつ前の右が空間
        begin
          rectangle (350,150,450,350);            //右横通路を塗ります
          brush.Color:=clSilver;
          FloodFill (360,355,clblack,fsBorder);
          brush.Color:=clCream;
        end;
    end;

    //Left
    if Copy(M2,4,1)='1' then
    begin
      FloodFill(180,250,clblack,fsBorder);        //ふたつ前の左が壁

      if Copy(M1,4,1)='0' then                    //ひとつ前の左が空間
        begin
          rectangle (50,150,150,350);
          brush.Color:=clSilver;
          FloodFill (140,355,clblack,fsBorder);
          brush.Color:=clCream;
        end;
    end;

  //中壁
    if Copy(M1,1,1)='1' then
    begin
      rectangle(150,150,350,350);
      exit;
    end;


//ふたつ前の横壁

  　//Right
    if Copy(M3,2,1)='1' then                      //みつつ前の右が壁（判定だけ）
    begin                                         //みっつ前のセルは描画範囲の外
      if Copy(M2,2,1)='0' then                    //ふたつ前の右が空間
      begin
        rectangle (300,200,350,300);              //右横通路の壁を塗ります
        brush.Color:=clSilver;
        FloodFill (310,305,clblack,fsBorder);
        brush.Color:=clCream;
      end;
    end;

    //Left
    if Copy(M3,4,1)='1' then                      //みつつ前の左が壁（判定だけ）
    begin                                         //みっつ前のセルは描画範囲の外
      if Copy(M2,4,1)='0' then                    //ふたつ前の右が空間
      begin
        rectangle (150,200,200,300);              //左通路の壁を塗ります
        brush.Color:=clSilver;
        FloodFill (160,305,clblack,fsBorder);
        brush.Color:=clCream;
      end;
    end;

  //奥壁
    if Copy(M2,1,1)='1' then   　　　           //奥の壁
      rectangle(200,200,300,300);
  end;

end;

end.

おまけ

やりたかったけど、説明が長くなりすぎるので、今回は見送ったこと。

マップエディター編で、壁を１　通路を０　にしてますが、壁に２や３も設定できるようにして、壁のデザインを通路ごとに変更できる処理を入れたかったです。