AFsoft WebSite (AFsoft.JP)

DelphiXE3　[3D-FMX] 3Dアプリケーションテスト(4)　2014/05/05

　
前回のテストプログラムでは、キーボード入力が主体でしたが、今回は3Dアプリケーションでのマウス入力についてテストしてみます。
　
下図のように、ライト(Light1)、カメラ(Camera1)、球(Sphere1)、立方体(Cube1)、ライト材質ソース(LightMaterialSource1・2)を配置し、カメラは初期状態のまま、球はライト材質ソース1と、立方体はライト材質ソース2とを関連付けます。

　
まずは、フォームのマウスホイール操作を行なってみます。
Form1 の OnMouseWheel イベントを下記のように記述して、マウスホイール操作をしたらカメラの前後移動を行うようにしてみます。

procedure TForm1.Form3DMouseWheel(Sender: TObject;
　Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
begin
　if (WheelDelta > 0) then begin
　　// マウスホイールを上方向へ回す
　　Camera1.Position.Z := Camera1.Position.Z + 1.0 ;
　end
　else if (WheelDelta < 0) then begin
　　// マウスホイールを下方向へ回す
　　Camera1.Position.Z := Camera1.Position.Z - 1.0 ;
　end;
end;

保存・コンパイル・実行を行います。

初期状態
↓

マウスホイールを上方向に回転すると、
カメラ位置をプラス移動＝向こう側へ移動
しますので、ズームイン状態となります。
↓

マウスホイールを下方向に回転すると、
カメラ位置をマイナス移動＝手前側へ移動
しますので、ズームアウト状態となります。

ヘルプには

フォームにフォーカスがある間にマウスホイールが動かされた際に発生します。
OnMouseWheel はまた、MouseWheel が呼び出された際にも発生します。
　
メモ： Mac OS X プラットフォーム上では、この関数は、マウスポインタがウィンドウ上にある間にマウスホイールが動いた場合に、呼び出される可能性があります。この場合、ウィンドウにフォーカスがある必要はありません。

との記載がありますので、作成した Windowsアプリと MacOSアプリとでは動作が若干異なる可能性があります。
　
次にマウス位置の確認をするため、OnMouseMoveイベントを下記のように記述してみます。

procedure TForm1.Form3DMouseMove(Sender: TObject;
　Shift: TShiftState; X,Y: Single);
begin
　Form1.Caption := 'マウス位置：('+FloatToStr(X)+','+FloatToStr(Y)+')' ;
end;

単にマウス座標をタイトルバーの所に表示するだけです。

マウス位置は、普通に、フォームの画面上のドット(ピクセル)位置
になっている様子です。

　
クライアント領域での座標位置となっています。クライアント領域外になると(-1,-1)を返していますが、他のプラットフォームでも同じかどうかは不明です。
OnMouseUp、OnMouseDown イベントでも同様です。但し、マウスを球 Sphere1、立方体 Cube1 の上に移動した状態で、マウスを押しても、フォームのこのイベントは発生しません。球、立方体、それぞれのイベントが発生します。
　
次に、マウスドラッグでカメラの角度を変えるようにしてみます。
マウスボタンを押した時に、角度変えますよフラグ変数 MouseOnFlag を True にして、そのときの位置を変数 MouseOnX、MouseOnY に格納します。マウス移動イベントでこのフラグ変数 MouseOnFlag が True の場合の処理を記述し、マウスボタンを離した時にこのフラグ変数　MouseOnFlag を False にします。これでマウスドラッグ操作を記述出来ます。

type
　TForm1 = class(TForm3D)
　　・・・
　{ private 宣言 }
　　MouseOnFlag : Boolean ;
　　MouseOnX , MouseOnY : Single ;
　　・・・
　end;
・・・
// 起動時
procedure TForm1.Form3DShow(Sender: TObject);
begin
　MouseOnFlag := False ;
end;
　
procedure TForm1.Form3DMouseDown(Sender: TObject;
　Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
　MouseOnFlag := True ;
　MouseOnX := X ;
　MouseOnY := Y ;
end;
　
procedure TForm1.Form3DMouseMove(Sender: TObject;
　Shift: TShiftState; X, Y: Single);
var
　dx,dy : Single ;
begin
　Form1.Caption := 'マウス位置：('+FloatToStr(X)+','+FloatToStr(Y)+')' ;
　if (MouseOnFlag) then begin
　　if (X < 0)or(Y < 0) then
　　　MouseOnFlag := False
　　else begin
　　　// マウスドラッグ処理
　　　dx := (X - MouseOnX) ;
　　　dy :=-(Y - MouseOnY) ;
　　　Camera1.RotationAngle.Y := dx ;
　　　Camera1.RotationAngle.X := dy ;
　　end;
　end;
end;
　
procedure TForm1.Form3DMouseUp(Sender: TObject;
　Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
　MouseOnFlag := False ;
end;


	↑
←		→
	↓

上記で書いたように、マウスを球や立方体のオブジェクト上に移動すると反応しなくなります。なお、カメラ角度を操作するとややこしくなるので、マウスホイール操作をしたら角度をリセットするようにしておきます。
　
　
次に、マウスを球に合わせた時、赤色に変色するようにしてみます。

procedure TForm1.Sphere1MouseEnter(Sender: TObject);
begin
　// 赤色に変色
　LightMaterialSource1.Diffuse := $FFFF0000 ;
　SPhere1.Repaint ;
end;
　
procedure TForm1.Sphere1MouseLeave(Sender: TObject);
begin
　// 元の緑色に戻す
　LightMaterialSource1.Diffuse := TAlphaColorRec.Springgreen ;
　SPhere1.Repaint ;
end;

↓

↓

　
次に、マウスで球 Sphere1 をクリックした場合について考えてみます。クリックしたかどうか、ダブルクリックしたかどうか、というだけならば、OnClickイベント、OnDblClickイベントを記述すれば良いだけですが、マウス位置が欲しい場合は、OnMouseDown、OnMouseMove イベントを記述する事になるでしょう。

procedure TForm1.Sphere1MouseUp(Sender: TObject;
　Button: TMouseButton; Shift: TShiftState; X, Y: Single;
　RayPos, RayDir: TVector3D);

X,Y値については上記同様、マウスカーソルで指定した画面上のドット(ピクセル)座標を示す、という事はいいとして、問題は、RayPos、RayDir の値についてです。画面表示されるものは 3D図ですから当然、3Dオブジェクトの存在する位置等を知りたい訳ですね。なのでおそらく、そういった情報であるに違いない、と想定出来ます。試しに、

procedure TForm1.Sphere1MouseUp(Sender: TObject;
　Button: TMouseButton; Shift: TShiftState; X, Y: Single;
　RayPos, RayDir: TVector3D);
begin
　ShowMessage('X,Y:'+FloatToStr(X)+','+FloatToStr(Y)+#13+#10
　 + 'RayPos.X:'+FloatToStr(RayPos.X)+#13+#10
　 + 'RayPos.Y:'+FloatToStr(RayPos.Y)+#13+#10
　 + 'RayPos.Z:'+FloatToStr(RayPos.Z)+#13+#10
　 + 'RayPos.W:'+FloatToStr(RayPos.W)+#13+#10
　 + 'RayDir.X:'+FloatToStr(RayDir.X)+#13+#10
　 + 'RayDir.Y:'+FloatToStr(RayDir.Y)+#13+#10
　 + 'RayDir.Z:'+FloatToStr(RayDir.Z)+#13+#10
　 + 'RayDir.W:'+FloatToStr(RayDir.W)+#13+#10);
end;

のようにして内容を表示させてみます。

マウスクリック
↓

フォームのキャプションに表示されている値と X,Yの値が違うのは、マウスを球の位置に合わせた瞬間、フォームのキャプション内容は更新されなくなる為です。球 Sphere1 のオブジェクトインスペクタ内容は

で、Camera1の位置は、(0,0,-10)ですから、RayPos値は、カメラとオブジェクトとの相対位置（距離）であると考えてよさそうです。「Ray」という言葉からは、レイトレース、放射線、というようなキーワードが想像出来ます。RayDir値はマウス位置によって微妙に値が変動します。ですので、マウス位置を特定するような値だと想定されます。「Dir」＝「Direction（方向）」と想像されるため、おそらくはカメラ位置からマウス位置への方向を示しているのだと想定されます。試しに、球 Sphere2 を配置し、下記のようにしてみます。

RayDir値は小さいので、おそらく、カメラ位置からの単位ベクトルである可能性が高いです。

マウスクリック
↓

↓

球 Sphere2 は見えないので
マウスホイールを下方向へ１つ回します

カメラをやや引いた所から、先ほどマウスクリックした
位置への方向を示すあたりに球 Sphere2 が
表示されているかのような感じがします

　
マウスで指定したオブジェクト＝球 Sphere1 上の表面上の点座標が欲しい場合は、それを計算するプログラムを記述する必要があるでしょう。
　
　
それでは、何もない空間をマウスで指定した場合、その3D位置というのは、どうなるのでしょう？　例えば上記の立方体 Cube1 をマウスドラッグして、画面下のほうへ移動したいとします。
画面ドット（ピクセル）座標というのは分かります。しかし、立方体を移動するには、Cube1.Position.X・Y・Z の値を変える、という事になりますから、下方向に移動する＝Y座標値をプラスする、という事で良いのでしょうか？　また、どれくらいの量をプラスすれば良いのでしょうか？　カメラの位置・角度によって状況は様々に変化します。
　
各3Dオブジェクトの OnMouseDown、OnMouseUp、OnMouseMoveの各イベントでは、カメラとの相対位置関係によって、マウス指示した箇所の特定が可能であるとわかりました。これはカメラ角度や画面上の見え方に影響されません。ですからこれを頼りに、量的なものは定数量で扱える所は　定数量で扱ってしまって、2Dで扱える所は 2Dで扱ってしまって、何もない3D空間座標上をマウスで直接捕まえる、というような事は余り考えない方がプログラミングしやすいと思われます。
　
　
ソース・実行プログラムのダウンロード（ZIP圧縮；3,228KB）
　
　

バッチファイル
ＢＡＳＩＣ
C言語のお勉強
拡張子な話
DOSプログラム
Delphi
>Dehi入門編
>Delphi2010
>DelphiXE3
▲2014/05/01
　2014/05/05
▼2014/05/06
　
シェアウェア
Script!World
データベース
　