お知らせ

電子会議

ライブラリ

パレット

Delphi FAQ検索

Delphi FAQ一覧

サンプル蔵





FDelphi FAQ
１６番会議室「玉石混淆みんなで作るSample蔵」に寄せられたサンプル

"RE:３次元ＣＧ物体の回転" 
この発言は
#01357　nax             さんの３次元ＣＧ物体の回転
に対するコメントです




ボタンを廃止してマウスで回転指示できるようにしました。
裏面ポリゴンを表示しない処理を追加しました。

ポリゴンの裏表の判定について
投影面上でのポリゴンの頂点座標値が時計まわりなら表、
反時計まわりなら裏と定義しています。
そのためテストデータを見直しました。

あと、だれか次の処理を追加してください。(^^;

　陰面消去(近くの物体は遠くの物体を覆い隠す)
　シェーディング(曲面を表現)

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;
  TxyzArr2 = array of Txyz;
  TCell4x4 = array[0..3,0..3] of Double;
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private 宣言 }
    TestData  : TxyzArr; // テストデータ
    A         : Txyz;    // 回転指示角度
    RotateFlg : boolean; // マウス回転指示フラグ
    MousePt   : TPoint;  // マウス位置
    Procedure DrawPolyLine(Data:TxyzArr);
    procedure Draw(A:Txyz;Data:TxyzArr);
    procedure CanvasClear;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

// ポリゴンが表ならTrueを返す
function PolygonIsCW(Data:TxyzArr;N:Integer):boolean;
var
  i,j : integer;
  vc:double;
begin
  vc:=0;
  for i:=0 to High(Data[N])-1 do
  begin
    j:=i+1;
    vc:=vc+(Data[N,j].x-Data[N,i].x)*(Data[N,j].y+Data[N,i].y);
  end;
  Result := Not (vc < 0);
end;

// 各軸まわりの回転角度を与えると回転指示行列を返す
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,5);
  setlength(Data[0],4);  setlength(Data[1],4);
  setlength(Data[2],4);  setlength(Data[3],4);
  setlength(Data[4],5);
  Data[0,0]:=xyz(  0,40,  0);  Data[0,1]:=xyz( 20, 0, 20);
  Data[0,2]:=xyz(-20, 0, 20);  Data[0,3]:=xyz(  0,40,  0);
  Data[1,0]:=xyz(  0,40,  0);  Data[1,1]:=xyz( 30, 0,-40);
  Data[1,2]:=xyz( 20, 0, 20);  Data[1,3]:=xyz(  0,40,  0);
  Data[2,0]:=xyz(  0,40,  0);  Data[2,1]:=xyz(-30, 0,-40);
  Data[2,2]:=xyz( 30, 0,-40);  Data[2,3]:=xyz(  0,40,  0);
  Data[3,0]:=xyz(  0,40,  0);  Data[3,1]:=xyz(-20, 0, 20);
  Data[3,2]:=xyz(-30, 0,-40);  Data[3,3]:=xyz(  0,40,  0);
  Data[4,0]:=xyz( 20, 0, 20);  Data[4,1]:=xyz( 30, 0,-40);
  Data[4,2]:=xyz(-30, 0,-40);  Data[4,3]:=xyz(-20, 0, 20);
  Data[4,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
    if Not PolygonIsCW(Data,i) then Continue;
    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.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  RotateFlg:=False;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  RotateFlg:=True;
  MousePt:=Point(x,y);
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if RotateFlg then
  begin
    A.y := A.y + (x - MousePt.x)/100*Pi;
    if A.y>359 then A.y:=0;
    if A.y<0   then A.y:=359;
    A.x := A.x + (y - MousePt.y)/100*Pi;
    if A.x>359 then A.x:=0;
    if A.x<0   then A.x:=359;
    CanvasClear;
    Draw(A,TestData);
  end;
end;

end.


                                     01/07/21(土) 08:26 nax(PXM01405)
 


Original document by nax             氏 ID:(PXM01405)

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