MathgeomGLS

1
unit FMain;
2

3
interface
4

5
uses
6
  Winapi.OpenGL,
7
  Winapi.Windows,
8
  Winapi.Messages,
9
  System.Math,
10
  System.SysUtils,
11
  System.UITypes,
12
  System.Variants,
13
  System.Classes,
14
  Vcl.Graphics,
15
  Vcl.Controls,
16
  Vcl.Forms,
17
  Vcl.Dialogs,
18
  Vcl.StdCtrls,
19
  Vcl.ExtCtrls,
20
  Vcl.Menus,
21

22
  GLS.PersistentClasses,
23
  GLS.VectorTypes,
24
  GLS.Scene,
25
  GLS.State,
26
  GLS.VectorTypesExt,
27
  GLS.SceneViewer,
28
  GLS.Objects,
29
  GLS.VectorFileObjects,
30
  GLS.VectorGeometry,
31
  GLS.Coordinates,
32
  
33
  GLS.BaseClasses,
34
  GLS.IsosurFace,
35
  GLS.Spline,
36
  Vcl.Mask;
37

38
type
39
  TFrmMain = class(TForm)
40
    GLSceneViewer: TGLSceneViewer;
41
    GLScene: TGLScene;
42
    OpenDialog: TOpenDialog;
43
    Camera: TGLCamera;
44
    dcBox: TGLDummyCube;
45
    PUSerInterface: TPanel;
46
    ffCube: TGLFreeForm;
47
    Label1: TLabel;
48
    Label2: TLabel;
49
    lblVertices: TLabel;
50
    lblTriangles: TLabel;
51
    LEXDim: TLabeledEdit;
52
    LEYDim: TLabeledEdit;
53
    LEZDim: TLabeledEdit;
54
    LEIsoVal: TLabeledEdit;
55
    rbgAlgorithm: TRadioGroup;
56
    MainMenu: TMainMenu;
57
    File1: TMenuItem;
58
    miFileOpen: TMenuItem;
59
    miFileExit: TMenuItem;
60
    N3: TMenuItem;
61
    Light: TGLLightSource;
62
    rbgSurface: TRadioGroup;
63
    procedure FormCreate(Sender: TObject);
64
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
65
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
66
    procedure GLSceneViewerMouseDown(Sender: TObject; Button: TMouseButton;
67
      Shift: TShiftState; X, Y: Integer);
68
    procedure GLSceneViewerMouseMove(Sender: TObject; Shift: TShiftState;
69
      X, Y: Integer);
70
    procedure miFileOpenClick(Sender: TObject);
71
    procedure miFileExitClick(Sender: TObject);
72
    procedure rbgAlgorithmClick(Sender: TObject);
73
    procedure rbgSurfaceClick(Sender: TObject);
74
  private
75
    ExtractedVertices: TVertexArray; // array of TVertex
76
    ExtractedTriangles: TIntegerArray; // array of Integer
77
    Dimensions: array ['x' .. 'z'] of Word;
78

79
    ExtendedData: TArray3DExt; // array of array of array of Single
80
    mdx, mdy: Integer;
81

82
    // Load Data from file
83
    function LoadCharData(AFileName: String; out ADataout: TArray3DExt;
84
      var Dims: array of word): Integer;
85
  public
86
    { Public-Deklarationen }
87
  end;
88

89
var
90
  FrmMain: TFrmMain;
91

92
implementation
93

94
{$R *.dfm}
95

96
procedure TFrmMain.FormCreate(Sender: TObject);
97
begin
98
  ExtendedData := nil;
99
end;
100

101
function TFrmMain.LoadCharData(AFileName: String; out ADataout: TArray3DExt;
102
  var Dims: array of word): Integer;
103
var
104
  DataFile: File of Byte;
105
  i, j, k: Integer;
106
  DataPoint: Byte;
107
  Counter: Integer;
108
begin
109
  AssignFile(DataFile, AFileName);
110
  Reset(DataFile);
111

112
  SetLength(ADataout, Dims[0], Dims[1], Dims[2]);
113

114
  i := 0;
115
  j := 0;
116
  k := 0;
117
  Counter := 0;
118
  try
119
    repeat
120
      Read(DataFile, DataPoint);
121
      ADataout[i, j, k] := DataPoint;
122
      inc(i);
123
      if (i = Dims[0]) then
124
      begin
125
        i := 0;
126
        inc(j);
127
      end;
128
      if (j = Dims[1]) then
129
      begin
130
        j := 0;
131
        inc(k);
132
      end;
133
      inc(Counter);
134
    until Eof(DataFile);
135
  finally
136
    Closefile(DataFile);
137
  end;
138
  Result := Counter;
139
end;
140

141
procedure TFrmMain.miFileOpenClick(Sender: TObject);
142
var
143
  DataAmount: cardinal;
144
begin
145
  Dimensions['x'] := StrToInt(LEXDim.Text);
146
  Dimensions['y'] := StrToInt(LEYDim.Text);
147
  Dimensions['z'] := StrToInt(LEZDim.Text);
148
  OpenDialog.InitialDir := ExtractFilePath(ParamStr(0));
149
  OpenDialog.Filter := 'Volumes|*.vol';
150
  if OpenDialog.Execute() then
151
  begin
152
    DataAmount := LoadCharData(OpenDialog.FileName, ExtendedData, Dimensions);
153
    MessageDlg(format('%d read. %dx%dx%d', [DataAmount, Dimensions['x'],
154
      Dimensions['y'], Dimensions['z']]), mtInformation, [mbOK], -1);
155
    LEXDim.Text := Format('%d', [Dimensions['x']]);
156
    LEYDim.Text := Format('%d', [Dimensions['y']]);
157
    LEZDim.Text := Format('%d', [Dimensions['z']]);
158
  end;
159
  rbgAlgorithmClick(Self);
160
  rbgSurfaceClick(Self);
161
end;
162

163
procedure TFrmMain.rbgAlgorithmClick(Sender: TObject);
164
var
165
  IsoSurfaceEx: TGLIsoSurfaceExtractor;
166
  i: Integer;
167
  mo: TGLMeshObject;
168

169
begin
170
  // Create IsoSurfaceExtractor
171
  IsoSurfaceEx := TGLIsoSurfaceExtractor.Create(Dimensions['x'], Dimensions['y'],
172
    Dimensions['z'], ExtendedData);
173
  // Launch Calculation
174
  case rbgAlgorithm.ItemIndex of
175
    0:
176
      IsoSurfaceEx.MarchingTetrahedra(StrToFloat(LEIsoVal.Text), ExtractedVertices,
177
        ExtractedTriangles, False);
178
    1:
179
      IsoSurfaceEx.MarchingCubes(StrToFloat(LEIsoVal.Text), ExtractedVertices,
180
        ExtractedTriangles, False);
181
  end;
182

183
  lblVertices.Caption := Format('%d', [Length(ExtractedVertices)]);
184
  lblTriangles.Caption := Format('%d', [Length(ExtractedTriangles) div 3]);
185
  IsoSurfaceEx.Free();
186

187
  ffCube.MeshObjects.Clear();
188
  mo := TGLMeshObject.CreateOwned(ffCube.MeshObjects);
189
  for i := 0 to Length(ExtractedTriangles) - 1 do
190
    mo.Vertices.Add(AffineVectorMake(ExtractedVertices[ExtractedTriangles[i]].X
191
      - Dimensions['x'] / 2, ExtractedVertices[ExtractedTriangles[i]].Y -
192
      Dimensions['y'] / 2, ExtractedVertices[ExtractedTriangles[i]].Z -
193
      Dimensions['z'] / 2));
194
  ffCube.StructureChanged();
195

196
  GLSceneViewer.Invalidate();
197
end;
198

199
procedure TFrmMain.rbgSurfaceClick(Sender: TObject);
200
begin
201
  if rbgSurface.ItemIndex = 0 then
202
    ffCube.Material.PolygonMode := pmFill
203
  else
204
    ffCube.Material.PolygonMode := pmLines;
205
  GLSceneViewer.Invalidate();
206
end;
207

208
procedure TFrmMain.miFileExitClick(Sender: TObject);
209
begin
210
  SetLength(ExtendedData, 0, 0, 0);
211
  Application.Terminate();
212
end;
213

214
procedure TFrmMain.FormMouseWheel(Sender: TObject; Shift: TShiftState;
215
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
216
begin
217
  Camera.AdjustDistanceToTarget(Power(1.1, WheelDelta / 120));
218
end;
219

220
procedure TFrmMain.GLSceneViewerMouseDown(Sender: TObject; Button: TMouseButton;
221
  Shift: TShiftState; X, Y: Integer);
222
begin
223
  mdx := X;
224
  mdy := Y;
225
end;
226

227
procedure TFrmMain.GLSceneViewerMouseMove(Sender: TObject; Shift: TShiftState;
228
  X, Y: Integer);
229

230
var
231
  dx, dy: Integer;
232
  v: TGLVector;
233
begin
234
  // calculate delta since last move or last mousedown
235
  dx := mdx - X;
236
  dy := mdy - Y;
237
  mdx := X;
238
  mdy := Y;
239
  if ssLeft in Shift then
240
  begin
241
    if ssShift in Shift then
242
    begin
243
      // right button with shift rotates the teapot
244
      // (rotation happens around camera's axis)
245
      Camera.RotateObject(dcBox, dy, dx);
246
    end
247
    else
248
    begin
249
      // right button without shift changes camera angle
250
      // (we're moving around the parent and target dummycube)
251
      Camera.MoveAroundTarget(dy, dx)
252
    end;
253
  end
254
  else if Shift = [ssRight] then
255
  begin
256
    // left button moves our target and parent dummycube
257
    v := Camera.ScreenDeltaToVectorXY(dx, -dy,
258
      0.12 * Camera.DistanceToTarget / Camera.FocalLength);
259
    dcBox.Position.Translate(v);
260
    // notify camera that its position/target has been changed
261
    Camera.TransformationChanged;
262
  end;
263
end;
264

265
end.
266