この発言に対し以下のコメントが寄せられています

#01360　nax             さん　RE:３次元ＣＧ物体の回転






３次元ＣＧで物体を回転させるための座標変換のサンプルです。
四角錐のワイヤーフレームモデルをボタンで回転させます。

空間座標系は右手系です。
このサンプルは物体の姿勢が回転によって変わるのと同期して
回転軸も回転するようになっています。

Form に Button を３個 配置
各ボタンの名前を RotateX, RotateY, RotateZ としてください。
OnClick イベントは下記コードの最後の方を参照
また各ボタンは作画の邪魔にならないようにLeftプロパティを200に設定

注:Delphi 5 で作成しテストしました。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Math;

type
  Txyz = record
    x,y,z : Double;
  end;
  TxyzArr = array of array of Txyz;
  TCell4x4 = array[0..3,0..3] of Double;
  TForm1 = class(TForm)
    RotateX: TButton;
    RotateY: TButton;
    RotateZ: TButton;
    procedure FormCreate(Sender: TObject);
    procedure RotateXClick(Sender: TObject);
    procedure RotateYClick(Sender: TObject);
    procedure RotateZClick(Sender: TObject);
  private
    { Private 宣言 }
    TestData : TxyzArr; // テストデータ
    A        : Txyz;    // 回転指示角度
    Procedure DrawPolyLine(Data:TxyzArr);
    procedure Draw(A:Txyz;Data:TxyzArr);
    procedure CanvasClear;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

// 各軸まわりの回転角度を与えると回転指示行列を返す
function RotateCreate(A:Txyz):TCell4x4;
var
  SinAZ,CosAZ : Double;
  SinAY,CosAY : Double;
  SinAX,CosAX : Double;
begin
  SinAZ:=Sin(DegToRad(A.z)); CosAZ:=Cos(DegToRad(A.z));
  SinAY:=Sin(DegToRad(A.y)); CosAY:=Cos(DegToRad(A.y));
  SinAX:=Sin(DegToRad(A.x)); CosAX:=Cos(DegToRad(A.x));
  Result[0,0]:=CosAZ*CosAY;
  Result[0,1]:=(-SinAZ)*CosAY;
  Result[0,2]:=SinAY;
  Result[0,3]:=0;
  Result[1,0]:=(SinAZ*CosAX+CosAZ*(-SinAY)*(-SinAX));
  Result[1,1]:=(CosAZ*CosAX+(-SinAZ)*(-SinAY)*(-SinAX));
  Result[1,2]:=CosAY*(-SinAX);
  Result[1,3]:=0;
  Result[2,0]:=(SinAZ*SinAX+CosAZ*(-SinAY));
  Result[2,1]:=(CosAZ*SinAX+(-SinAZ)*(-SinAY)*CosAX);
  Result[2,2]:=CosAY*CosAX;
  Result[2,3]:=0;
  Result[3,0]:=0;
  Result[3,1]:=0;
  Result[3,2]:=0;
  Result[3,3]:=1;
end;

// 座標値と回転指示行列を与えると回転後の座標値を返す
function RotateApply(P:Txyz;R:TCell4x4):Txyz; overload;
var
  i , j : integer;
  A , B : array[0..3] of Double;
begin
  A[0]:=P.x; A[1]:=P.y; A[2]:=P.z; A[3]:=1;
  for i :=0 to 3 do
  begin
    B[i]:=0;
    for j := 0 to 3 do
      B[i]:=B[i]+A[j]*R[i,j];
  end;
  Result.x:=B[0]; Result.y:=B[1]; Result.z:=B[2];
end;

// 座標値と回転指示行列を与えると回転後の座標値を返す
function RotateApply(Data:TxyzArr;R:TCell4x4):TxyzArr; overload;
var
  i , j : integer;
begin
  setlength(Result,length(Data));
  for i:=0 to high(Data) do
  begin
    setlength(Result[i],length(Data[i]));
    for j:=0 to high(Data[i]) do
      Result[i,j] := RotateApply(Data[i,j],R);
  end;
end;

// 座標の組み合わせから Txyz 構造を作成
function xyz(x,y,z:Double):Txyz;
begin
  Result.x:=x; Result.y:=y; Result.z:=z;
end;

// テストデータ作成
procedure TestDataCreate(var Data:TxyzArr);
begin
  Finalize(Data); setlength(Data,3);
  setlength(Data[0],4);  setlength(Data[1],4); setlength(Data[2],5);
  Data[0,0]:=xyz( 20, 0, 20);  Data[0,1]:=xyz(  0,40,  0);
  Data[0,2]:=xyz(-20, 0, 20);  Data[0,3]:=xyz( 20, 0, 20);
  Data[1,0]:=xyz( 30, 0,-40);  Data[1,1]:=xyz(  0,40,  0);
  Data[1,2]:=xyz(-30, 0,-40);  Data[1,3]:=xyz( 30, 0,-40);
  Data[2,0]:=xyz( 20, 0, 20);  Data[2,1]:=xyz( 30, 0,-40);
  Data[2,2]:=xyz(-30, 0,-40);  Data[2,3]:=xyz(-20, 0, 20);
  Data[2,4]:=xyz( 20, 0, 20);
end;

// 作画サブルーチン
Procedure TForm1.DrawPolyLine(Data:TxyzArr);
var
  i , j : integer;
  P : Array of TPoint;
  // Txyz構造をTPointに変換
  function Conv(xyz:Txyz):TPoint;
  begin
    Result.x := 100 + Trunc(xyz.x);
    Result.y := 100 - Trunc(xyz.y);
  end;
begin
  for i:=0 to high(Data) do
  begin
    Finalize(P);
    for j:=0 to high(Data[i]) do
    begin
      setlength(P,Length(P)+1);
      P[high(P)]:=Conv(Data[i,j]);
    end;
    Canvas.Polyline(P);
  end;
end;

// 作画メイン
procedure TForm1.Draw(A:Txyz;Data:TxyzArr);
var
  NewData : TxyzArr;
  R       : TCell4x4;
begin
  R := RotateCreate(A);
  NewData:=RotateApply(Data,R);
  DrawPolyLine(NewData);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  TestDataCreate(TestData); // テストデータ作成
  A.x:=0;  A.y:=0;  A.z:=0;
end;

procedure TForm1.CanvasClear;
begin
  Invalidate;
  Application.ProcessMessages;
end;

procedure TForm1.RotateXClick(Sender: TObject);
begin
  A.x:=A.x + 10;
  if A.x>359 then A.x := 0;
  CanvasClear;
  Draw(A,TestData);
end;

procedure TForm1.RotateYClick(Sender: TObject);
begin
  A.y:=A.y + 10;
  if A.y>359 then A.y := 0;
  CanvasClear;
  Draw(A,TestData);
end;

procedure TForm1.RotateZClick(Sender: TObject);
begin
  A.z:=A.z + 10;
  if A.z>359 then A.z := 0;
  CanvasClear;
  Draw(A,TestData);
end;

end.

                                     01/07/20(金) 14:35 nax(PXM01405)
 


- FDELPHI  MES(16):玉石混淆みんなで作るSample蔵【見本蓄積】 01/07/21 -

Original document by nax             氏 ID:(PXM01405)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。