TViewport3D上の3Dポリゴンメッシュ(TMesh)にテクスチャマッピング(FMX) ～Delphiソースコード集

• ホーム
• Delphiでお手軽プログラミング
• TViewport3D上の3Dポリゴンメッシュ(TMesh)にテクスチャマッピング(FMX) ～Delphiソースコード集

TViewport3D上の3Dポリゴンメッシュ(TMesh)にテクスチャマッピング(FMX) ～Delphiソースコード集

Delphiを起動して新規作成を行い、必要なコンポーネントをドラッグ&ドロップする

ソースコードを記述する

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.Types3D,
  System.Math.Vectors, FMX.Objects3D, FMX.Controls3D, FMX.MaterialSources,
  FMX.Viewport3D, System.RTLConsts;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Viewport3D1: TViewport3D;
    ColorMaterialSource1: TColorMaterialSource;
    LightMaterialSource1: TLightMaterialSource;
    Light1: TLight;
    Mesh1: TMesh;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { private 宣言 }
  public
    { public 宣言 }
    phase:single;  //位相
    procedure DrawWire(Sender: TObject; Context: TContext3D);
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.DrawWire(Sender: TObject; Context: TContext3D);
begin
  //線を描画する
  Context.DrawLines(
    TMesh(Sender).Data.VertexBuffer,
    TMesh(Sender).Data.IndexBuffer,
    ColorMaterialSource1.Material, 1
  );
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  phase:=0;

  //マテリアル(材質)設定
  Mesh1.MaterialSource:=LightMaterialSource1;
  //テクスチャの読み込み
  LightMaterialSource1.Texture.LoadFromFile('..\..\texture.jpg');


  //両面にする場合
  //Mesh1.TwoSide:=true;

  //TMeshWrapMode.Fit
  //  TMeshのWidth,Height,Depthの中に収まるようにフィット
  //  比率は保たれ、原点は自動計算される
  //TMeshWrapMode.Original
  //  TMeshのWidth,Height,Depth倍された大きさになり、原点は0,0,0
  //TMeshWrapMode.Resize
  //  基本はFitと同じだが原点は0,0,0
  //TMeshWrapMode.Stretch
  //  TMeshのWidth,Height,Depthの中に収まるようにストレッチされ
  //  比率は保たれない、原点は自動計算される
  Mesh1.WrapMode:=TMeshWrapMode.Resize;
  Mesh1.Width:=4;
  Mesh1.Depth:=4;
  Mesh1.Height:=4;
  Mesh1.Position.X:=0;
  Mesh1.Position.Y:=-2;//少し上の位置にする
  Mesh1.Position.Z:=0;
  Mesh1.RotationAngle.X:=30;//30度回転
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var xp,zp:integer;
    x,z:integer;
    y:single;
    idx:integer;
    fTexCoordinates:String;//テクスチャの貼り方を入れる
begin
  xp:=20;//x方向のメッシュの数＋１
  zp:=15;//z方向のメッシュの数＋１

  Mesh1.Data.VertexBuffer.Length := xp*zp;
  Mesh1.Data.IndexBuffer.Length := (xp-1)*(zp-1)*3*2;

  fTexCoordinates:='';

  //頂点バッファの作成
  for z := 0 to zp-1 do
  begin
    for x := 0 to xp-1 do
    begin
      //y座標（高さ）を適当にCos*Sinにする
      y:=Cos(x/xp*pi()*4+phase)*Sin(z/zp*pi()*4+phase)*2;
      //頂点バッファに値を設定
      Mesh1.Data.VertexBuffer.Vertices[x+z*xp]:=
        Point3D(x-xp/2, y, z-zp/2);

      //各頂点に対してテクスチャの位置(割合)を指定していく(x:0～1  y:0～1)
      fTexCoordinates:=fTexcoordinates+
        Format('%4.4f %4.4f,',[x/(xp-1),1-z/(zp-1)]);
    end;
  end;
  //頂点に対するテクスチャの位置を指定する
  Mesh1.Data.TexCoordinates:=fTexCoordinates;

  //メッシュの作成
  idx:=0;
  for z := 0 to zp-2 do
  begin
    for x := 0 to xp-2 do
    begin
      //3角形ポリゴン作成(頂点を結ぶ)
      Mesh1.Data.IndexBuffer.Indices[idx]:=x+0+(z+0)*xp;
      inc(idx);
      Mesh1.Data.IndexBuffer.Indices[idx]:=x+0+(z+1)*xp;
      inc(idx);
      Mesh1.Data.IndexBuffer.Indices[idx]:=x+1+(z+0)*xp;
      inc(idx);
      //3角形ポリゴン作成(頂点を結ぶ)
      Mesh1.Data.IndexBuffer.Indices[idx]:=x+1+(z+0)*xp;
      inc(idx);
      Mesh1.Data.IndexBuffer.Indices[idx]:=x+0+(z+1)*xp;
      inc(idx);
      Mesh1.Data.IndexBuffer.Indices[idx]:=x+1+(z+1)*xp;
      inc(idx);
    end;
  end;

  //法線ベクトルの自動計算
    //メッシュのすべての面に対する法線ベクトルを計算します
    Mesh1.Data.CalcFaceNormals();
    //メッシュのすべての面の滑らかな法線ベクトルを計算します
    //Mesh1.Data.CalcSmoothNormals();
    //メッシュのすべての面の接線ベクトルと従法線ベクトルを計算します
    //Mesh1.Data.CalcTangentBinormals;


  //稜線（ワイヤーフレーム）の描画、必要であればコメントを外す
  //Mesh1.OnRender:=DrawWire;

  //位相を変える
  phase:=phase+0.1;

  //再描画
  Viewport3D1.Repaint;
end;

end.

実行する