Luxophia

1
unit Main;
2

3
interface //#################################################################### ■
4

5
uses
6
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
7
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
8
  System.Math.Vectors,
9
  FMX.Types3D, FMX.ScrollBox, FMX.Memo, FMX.Controls.Presentation,
10
  FMX.StdCtrls, FMX.Controls3D, FMX.Objects3D, FMX.Viewport3D, FMX.TabControl,
11
  LUX, LUX.FMX, LUX.FMX.TTrueViewport3D,
12
  LIB.Material, FMX.Memo.Types;
13

14
type
15
  TForm1 = class(TForm)
16
    TabControl1: TTabControl;
17
      TabItemV: TTabItem;
18
        Viewport3D1: TViewport3D;
19
          Light1: TLight;
20
          Dummy1: TDummy;
21
            Dummy2: TDummy;
22
              Camera1: TCamera;
23
          Dummy3: TDummy;
24
            Dummy4: TDummy;
25
              Camera2: TCamera;
26
          Grid3D1: TGrid3D;
27
            Plane1: TPlane;
28
          Grid3D2: TGrid3D;
29
            Plane2: TPlane;
30
          Sphere1: TSphere;
31
      TabItemS: TTabItem;
32
        TabControlS: TTabControl;
33
          TabItemSV: TTabItem;
34
            TabControlSV: TTabControl;
35
              TabItemSVC: TTabItem;
36
                MemoSVC: TMemo;
37
              TabItemSVE: TTabItem;
38
                MemoSVE: TMemo;
39
          TabItemSP: TTabItem;
40
            TabControlSP: TTabControl;
41
              TabItemSPC: TTabItem;
42
                MemoSPC: TMemo;
43
              TabItemSPE: TTabItem;
44
                MemoSPE: TMemo;
45
    Panel1: TPanel;
46
      Viewport3D2: TTrueViewport3DFrame;
47
      ScrollBar1: TScrollBar;
48
    procedure FormCreate(Sender: TObject);
49
    procedure Viewport3D1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
50
    procedure Viewport3D1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
51
    procedure Viewport3D1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
52
    procedure Viewport3D2MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
53
    procedure Viewport3D2MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
54
    procedure Viewport3D2MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
55
    procedure ScrollBar1Change(Sender: TObject);
56
  private
57
    { private 宣言 }
58
    _MouseS :TShiftState;
59
    _MouseP :TPointF;
60
  public
61
    { public 宣言 }
62
    _Material :TMyMaterialSource;
63
  end;
64

65
var
66
  Form1: TForm1;
67

68
implementation //############################################################### ■
69

70
uses System.Math;
71

72
{$R *.fmx}
73

74
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& private
75

76
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& public
77

78
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
79

80
procedure TForm1.FormCreate(Sender: TObject);
81
var
82
   T :String;
83
begin
84
     with Viewport3D2 do
85
     begin
86
          Camera := Camera2;
87
          Color  := TAlphaColors.Dimgray;
88
     end;
89

90
     _MouseS := [];
91

92
     _Material := TMyMaterialSource.Create( Self );
93

94
     with _Material do
95
     begin
96
          with ShaderV do
97
          begin
98
               Source.Text := MemoSVC.Text;
99

100
               for T in Errors.Keys do
101
               begin
102
                    with MemoSVE.Lines do
103
                    begin
104
                         Add( '▼ ' + T   );
105
                         Add( Errors[ T ] );
106
                    end;
107
               end;
108
          end;
109

110
          with ShaderP do
111
          begin
112
               Source.Text := MemoSPC.Text;
113

114
               for T in Errors.Keys do
115
               begin
116
                    with MemoSPE.Lines do
117
                    begin
118
                         Add( '▼ ' + T   );
119
                         Add( Errors[ T ] );
120
                    end;
121
               end;
122
          end;
123

124
          EmisLight  := TAlphaColorF.Create( 0, 0, 0 );
125
          AmbiLight  := TAlphaColorF.Create( 0, 0, 0 );
126
          DiffRatio  := TAlphaColorF.Create( 1, 1, 1 );
127
          SpecRatio  := TAlphaColorF.Create( 1, 1, 1 );
128
          SpecShiny  := 50;
129
          ProjImage  .  LoadFromFile( '..\..\_DATA\Lena_512.png' );
130
          ProjMatrix := Camera2.AbsoluteMatrix;
131
          ProjAngleW := DegToRad( ScrollBar1.Value );
132
          ProjAngleH := DegToRad( ScrollBar1.Value );
133
     end;
134

135
     Plane1 .MaterialSource := _Material;
136
     Plane2 .MaterialSource := _Material;
137
     Sphere1.MaterialSource := _Material;
138

139
     Viewport3D2.RebuildRenderingList;  // Camera2 の所属する Viewport3D1 内のオブジェクト構造が変わる度に呼ぶ必要あり。
140
end;
141

142
//------------------------------------------------------------------------------
143

144
procedure TForm1.Viewport3D1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
145
begin
146
     _MouseS := Shift;
147
     _MouseP := TPointF.Create( X, Y );
148
end;
149

150
procedure TForm1.Viewport3D1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
151
var
152
   P :TPointF;
153
begin
154
     if ssLeft in _MouseS then
155
     begin
156
          P := TPointF.Create( X, Y );
157

158
          with Dummy1.RotationAngle do Y := Y + ( P.X - _MouseP.X ) / 2;
159
          with Dummy2.RotationAngle do X := X - ( P.Y - _MouseP.Y ) / 2;
160

161
          _MouseP := P;
162
     end;
163
end;
164

165
procedure TForm1.Viewport3D1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
166
begin
167
     Viewport3D1MouseMove( Sender, Shift, X, Y );
168

169
     _MouseS := [];
170
end;
171

172
//------------------------------------------------------------------------------
173

174
procedure TForm1.Viewport3D2MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
175
begin
176
     _MouseS := Shift;
177
     _MouseP := TPointF.Create( X, Y );
178
end;
179

180
procedure TForm1.Viewport3D2MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
181
var
182
   P :TPointF;
183
begin
184
     if ssLeft in _MouseS then
185
     begin
186
          P := TPointF.Create( X, Y );
187

188
          with Dummy3.RotationAngle do Y := Y - ( P.X - _MouseP.X ) / 4;
189
          with Dummy4.RotationAngle do X := X + ( P.Y - _MouseP.Y ) / 4;
190

191
          _Material.ProjMatrix := Camera2.AbsoluteMatrix;
192

193
          Viewport3D2.Repaint;
194

195
          _MouseP := P;
196
     end;
197
end;
198

199
procedure TForm1.Viewport3D2MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
200
begin
201
     Viewport3D2MouseMove( Sender, Shift, X, Y );
202

203
     _MouseS := [];
204
end;
205

206
//------------------------------------------------------------------------------
207

208
procedure TForm1.ScrollBar1Change(Sender: TObject);
209
begin
210
     with _Material do
211
     begin
212
          ProjAngleW := DegToRad( ScrollBar1.Value );
213
          ProjAngleH := DegToRad( ScrollBar1.Value );
214
     end;
215

216
     Viewport3D1.Repaint;
217
     Viewport3D2.Repaint;
218
end;
219

220
//############################################################################## □
221

222
initialization //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 初期化
223

224
     //GlobalUseDX := False;
225

226
end. //######################################################################### ■
227