MathgeomGLS

1
unit LevelCurves;
2

3
interface
4

5
uses
6
  Winapi.Windows,
7
  System.Classes,
8
  System.SysUtils,
9
  System.Math,
10
  System.ImageList,
11
  System.Actions,
12
  System.Variants,
13
  Vcl.Graphics,
14
  Vcl.Forms,
15
  Vcl.Controls,
16
  Vcl.Menus,
17
  Vcl.Dialogs,
18
  Vcl.StdCtrls,
19
  Vcl.Buttons,
20
  Vcl.ExtCtrls,
21
  Vcl.ComCtrls,
22
  Vcl.ImgList,
23
  Vcl.StdActns,
24
  Vcl.ActnList,
25
  Vcl.ToolWin,
26
  Vcl.DBCtrls,
27
  Generics.Collections,
28

29
  GLS.VectorTypesExt,
30
  GLS.Cadencer,
31
  GLS.Material,
32
  GLS.Scene,
33
  GLS.Objects,
34
  GLS.GeomObjects,
35
  GLS.VectorGeometry,
36
  GLS.VectorFileObjects,
37
  GLS.VectorLists,
38
  GLS.Coordinates,
39
  
40
  GLS.BaseClasses,
41
  GLS.SceneViewer,
42
  GLS.HUDObjects,
43
  GLS.WindowsFont,
44
  GLS.Texture,
45
  GLSL.UserShader,
46
  GLS.Color,
47
  GLS.Graphics,
48
  GLS.RenderContextInfo,
49
  GLS.Mesh,
50
  GLS.VectorTypes,
51
  GLS.MultiPolygon,
52
  GLS.AVIRecorder,
53
  GLS.Extrusion,
54
  GLS.BitmapFont,
55
  GLS.Context,
56
  GLS.State,
57
  GLS.TextureFormat,
58
  GLS.ProxyObjects,
59
  GLS.SpaceText,
60
  GLS.AsyncTimer,
61
  GLS.Isolines,
62

63
  About,
64
  UNcube;
65

66
const
67
  Nx = 40; // dimension west - east
68
  Ny = 40; // dimenstion north west
69
  Nz = 40; // dimenstion height
70

71
  res3DmaxForm3D= 100;   res3DminForm3D= 10;
72

73
  Kfixed = 4; // Came from a 3D code where the plane XY can move as Z[I,J,K}
74
  gxmin = -3;
75
  gxmax = 6.5;
76
  gymin = -4;
77
  gymax = 4;
78

79
type
80
  TLevelCurvesForm = class(TForm)
81
    OpenDialog: TOpenDialog;
82
    SaveDialog: TSaveDialog;
83
    ToolBar1: TToolBar;
84
    ToolButton9: TToolButton;
85
    ToolButton1: TToolButton;
86
    ToolButton2: TToolButton;
87
    ToolButton3: TToolButton;
88
    ToolButton4: TToolButton;
89
    ToolButton5: TToolButton;
90
    ToolButton6: TToolButton;
91
    StatusBar: TStatusBar;
92
    MainMenu: TMainMenu;
93
    File1: TMenuItem;
94
    FileNewItem: TMenuItem;
95
    FileOpenItem: TMenuItem;
96
    FileSaveItem: TMenuItem;
97
    FileSaveAsItem: TMenuItem;
98
    N1: TMenuItem;
99
    FileExitItem: TMenuItem;
100
    Edit1: TMenuItem;
101
    CutItem: TMenuItem;
102
    CopyItem: TMenuItem;
103
    PasteItem: TMenuItem;
104
    Help1: TMenuItem;
105
    HelpAboutItem: TMenuItem;
106
    pnlGLscene2: TPanel;
107
    StaticText1: TStaticText;
108
    View: TGLSceneViewer;
109
    GLScene: TGLScene;
110
    GLLightSource1: TGLLightSource;
111
    dc_cam: TGLDummyCube;
112
    PlaneXY: TGLFreeForm;
113
    cam: TGLCamera;
114
    GLMaterialLibrary1: TGLMaterialLibrary;
115
    GLCadencer1: TGLCadencer;
116
    pnlDimensoesGL: TPanel;
117
    RGexamples: TRadioGroup;
118
    SeeIsolines: TCheckBox;
119
    TrackBarNC: TTrackBar;
120
    rgNodeAspect: TRadioGroup;
121
    Label2: TLabel;
122
    TrackBarPosition: TTrackBar;
123
    rgPlaneSelection: TRadioGroup;
124
    cad: TGLCadencer;
125
    AsyncTimer1: TGLAsyncTimer;
126
    RGpanning: TRadioGroup;
127
    DC_world: TGLDummyCube;
128
    DC_utils: TGLDummyCube;
129
    lbNL: TLabel;
130
    rgSplineModes: TRadioGroup;
131
    procedure FileNew1Execute(Sender: TObject);
132
    procedure FileOpen1Execute(Sender: TObject);
133
    procedure FileSave1Execute(Sender: TObject);
134
    procedure FileExit1Execute(Sender: TObject);
135
    procedure HelpAbout1Execute(Sender: TObject);
136
    procedure ViewMouseDown(Sender: TObject; Button: TMouseButton;
137
      Shift: TShiftState; x, y: Integer);
138
    procedure ViewMouseMove(Sender: TObject; Shift: TShiftState;
139
      x, y: Integer);
140
    procedure ViewMouseWheel(Sender: TObject; Shift: TShiftState;
141
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
142
    procedure FormKeyPress(Sender: TObject; var Key: Char);
143
    procedure FormCreate(Sender: TObject); // values of cut levels
144
    procedure DrawPlaneClick(Sender: TObject);
145
    procedure Use_CONREC_XY (Kfix:integer);
146
    procedure RGexamplesClick(Sender: TObject);
147
    procedure TrackBarNCChange(Sender: TObject);
148
    procedure rgNodeAspectClick(Sender: TObject);
149
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
150
    procedure TrackBarPositionChange(Sender: TObject);
151
    procedure RGpanningClick(Sender: TObject);
152
    procedure cadProgress(Sender: TObject; const deltaTime, newTime: Double);
153
    procedure AsyncTimer1Timer(Sender: TObject);
154
    procedure FormActivate(Sender: TObject);
155
    procedure FormDeactivate(Sender: TObject);
156
    procedure rgPlaneSelectionClick(Sender: TObject);
157
    procedure rgSplineModesClick(Sender: TObject);
158
  private
159
    mdx, mdy: Integer;
160
    mx, my: Integer;
161
    UserAbort: Boolean;
162
  public
163
    dir: Integer;
164
    NC: Integer; // dimension for contour levels
165
    pt1AX, pt1AY, pt1AZ, pt1BX, pt1BY, pt1BZ, flap1A, flap1B: single;
166
    Isolines: TGLIsolines;
167
    procedure CreateInputData;
168
  end;
169

170
var
171
  LevelCurvesForm: TLevelCurvesForm;
172
  Mat: TMatrixArr; // 2D - Datafield    replaced by  res3DPlane
173
  Scx: TVectorArr; // scaling vector west - east
174
  Scy: TVectorArr; // scaling vector north - west
175
  Scz: TVectorArr; // scaling vector north - west
176
  Hgt: TVectorArr; // vector for the countur levels
177
  i, j, k: Integer; // adress indexes
178
  mi, ma: Double; // for minimum & maximum
179
  Xarr, Yarr,    // coord. values
180
  Zarr, res3DPlane: array of array of array of Double;
181
  Z_Kfixed: Integer;
182
  ncube: TGLNCube;
183

184
//======================================
185
implementation
186
//======================================
187

188
{$R *.dfm}
189

190
procedure TLevelCurvesForm.FormCreate(Sender: TObject);
191
begin
192
   SetCurrentDir(ExtractFilePath(ParamStr(0)));
193
   Z_Kfixed := TrackBarPosition.Position;
194
   Isolines := TGLIsolines.CreateAsChild(PlaneXY);
195
   Isolines.LineColor.Color := clrBlack;
196
   Isolines.LinePattern := $FFFF;
197
   Isolines.LineWidth := 2;
198
   Isolines.NodesAspect := TGLLineNodesAspect(0);
199
   Isolines.SplineMode := lsmSegments; //lsmBezierSpline;
200

201
  // using  my 3D type variables . Each point in the 3D space is defined by
202
  // X[I,J,K]  Y[I,J,K]and  Z[I,J,K] . The value of the variable to map is
203
  // res3Dplane[I,J,K] in that point (already normalized for =0 and <=1)
204
  SetLength(Xarr, Nx+1 , Ny+1 , Nz+1 );
205
  SetLength(Yarr, Nx+1 , Ny+1 , Nz +1);
206
  SetLength(Zarr, Nx +1, Ny+1 , Nz+1 );
207
  SetLength(res3DPlane, Nx+1 , Ny+1 , Nz+1 );
208
  RGexamplesClick(Self);
209
  RGpanningClick(self);
210
end;
211

212
procedure TLevelCurvesForm.RGpanningClick(Sender: TObject);
213
begin
214
  case RGpanning.ItemIndex of
215
    0:
216
      begin
217
        if ncube = nil then
218
        begin
219
          cad.Enabled := true;
220
          ncube := TGLNCube.CreateAsChild(GLScene.Objects);
221
          ncube.SceneViewer := View;
222
          ncube.FPS := 30;
223
          application.OnActivate := OnActivate;
224
          application.OnDeactivate := OnDeactivate;
225
        end;
226
      end;
227
    1:
228
      begin
229
        if ncube <> nil then
230
        begin
231
          if Assigned(ncube) then
232
          begin
233
            cad.Enabled := False;
234
            ncube.Free;
235
            ncube := nil;
236
          end;
237
        end;
238
      end;
239
  end;
240
end;
241

242
procedure TLevelCurvesForm.rgPlaneSelectionClick(Sender: TObject);
243
begin
244
  case rgPlaneSelection.ItemIndex of
245
  0: begin //XY
246
       PlaneXY.Roll(0);
247
       PlaneXY.Pitch(0);
248
       PlaneXY.Turn(90);
249
     end;
250
  1: begin //YZ;
251
       PlaneXY.Roll(0);
252
       PlaneXY.Pitch(90);
253
       PlaneXY.Turn(0);
254
     end;
255
  2: begin //ZX;
256
       PlaneXY.Roll(90);
257
       PlaneXY.Pitch(0);
258
       PlaneXY.Turn(0);
259
     end;
260
  end;
261
//  rgExamplesClick(self);
262
end;
263

264
procedure TLevelCurvesForm.rgSplineModesClick(Sender: TObject);
265
begin
266
  case rgSplineModes.ItemIndex of
267
    0: Isolines.SplineMode := lsmSegments;
268
    1: Isolines.SplineMode := lsmCubicSpline;
269
    2: Isolines.SplineMode := lsmBezierSpline;
270
    3: Isolines.SplineMode := lsmNURBSCurve;
271
    4: Isolines.SplineMode := lsmLines;
272
    5: Isolines.SplineMode := lsmLoop;
273
  end;
274
end;
275

276
// __________________________________________________________________________
277
procedure TLevelCurvesForm.AsyncTimer1Timer(Sender: TObject);
278
begin
279
  caption := 'naviCube: ' + View.FramesPerSecondText(2);
280
  View.ResetPerformanceMonitor;
281
end;
282

283
procedure TLevelCurvesForm.cadProgress(Sender: TObject; const deltaTime,
284
  newTime: Double);
285
begin
286
 if ncube<> nil then
287
  begin
288
  if ncube.InactiveTime > 5 then begin
289
      if ncube.InactiveTime < 8 then
290
        dc_cam.TurnAngle := dc_cam.TurnAngle + (ncube.InactiveTime - 5) * deltatime * 2
291
      else
292
        dc_cam.TurnAngle := dc_cam.TurnAngle + deltatime * 6;
293
     end;
294
    View.Refresh;
295
  end;
296
end;
297

298
procedure TLevelCurvesForm.ViewMouseDown(Sender: TObject;
299
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
300
begin
301
  mx := X;
302
  my := Y;
303
  View.SetFocus;
304
end;
305

306
procedure TLevelCurvesForm.ViewMouseMove(Sender: TObject;
307
  Shift: TShiftState; X, Y: Integer);
308
var
309
  dx, dy: Integer;
310

311
begin
312
  // calculate delta since last move or last mousedown
313
  dx := mdx - X;
314
  dy := mdy - Y;
315
  mdx := X;
316
  mdy := Y;
317
  if ssLeft in Shift then
318
  begin
319
    if ssShift in Shift then
320
    begin // right button with shift rotates DC1 (rotation happens around camera's axis)
321
      cam.RotateObject(dc_world, dy, dx);
322
    end
323
    else
324
    begin // right button without shift changes camera angle *** moving around the parent and target dummycube)
325
      cam.MoveAroundTarget(dy, dx)
326
    end;
327
  end
328
  else if Shift = [ssRight] then
329
  begin // left button moves our target and parent dummycube
330
    // v:=cam1.ScreenDeltaToVectorXY(dx, -dy,0.12*cam1.DistanceToTarget/cam1.FocalLength);
331
    // DC1.Position.Translate(v);     	// notify camera that its position/target has been changed
332
    // cam1.TransformationChanged;
333
  end;
334

335
end;
336

337
procedure TLevelCurvesForm.ViewMouseWheel(Sender: TObject;
338
  Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
339
  var Handled: Boolean);
340
begin
341
  cam.AdjustDistanceToTarget(Power(1.03, WheelDelta / 300));
342
end;
343

344
procedure TLevelCurvesForm.FormDeactivate(Sender: TObject);
345
begin
346
  cad.Enabled := false;
347
end;
348

349
procedure TLevelCurvesForm.FormActivate(Sender: TObject);
350
begin
351
   cad.Enabled := true;
352
end;
353
// __________________________________________________________________________
354
procedure TLevelCurvesForm.rgNodeAspectClick(Sender: TObject);
355
begin
356
  case rgNodeAspect.ItemIndex of
357
    0: Isolines.NodesAspect := TGLLineNodesAspect(0);
358
    1: Isolines.NodesAspect := TGLLineNodesAspect(2);
359
    2: Isolines.NodesAspect := TGLLineNodesAspect(1);
360
  end;
361
end;
362

363
// __________________________________________________________________________
364
procedure TLevelCurvesForm.RGexamplesClick(Sender: TObject);
365
var I:integer  ;
366
begin
367
  CreateInputData;
368
  DrawPlaneClick(Self);
369
end;
370

371

372
procedure TLevelCurvesForm.TrackBarNCChange(Sender: TObject);
373
begin
374
  lbNL.Caption := 'NL: '+ IntToStr(TrackBarNC.Position);
375
  RGexamplesClick(self);
376
end;
377

378
procedure TLevelCurvesForm.TrackBarPositionChange(Sender: TObject);
379
begin
380
  RGexamplesClick(self);
381
end;
382

383

384
procedure TLevelCurvesForm.CreateInputData;
385
var
386
  i, j: Integer;
387
  xAux, yAux: Double;
388
begin
389
  for i := 0 to Nx - 1 Do
390
  // ----------------------------------- set 2d data field
391
  begin
392
    for j := 0 to Ny - 1 Do
393
    Begin
394
      for k := 0 to Nz - 1 Do
395
      begin
396
        case RGexamples.ItemIndex of
397
          0:
398
            begin
399
              Xarr[i, j, k] := i - Nx / 2;
400
              Yarr[i, j, k] := j - Ny / 2;
401
              Zarr[i, j, k] := Z_Kfixed;
402
            end;
403
          1:
404
            begin
405
              Xarr[i, j, k] := gxmin + i * (gxmax - gxmin) / Nx;
406
              Yarr[i, j, k] := gymin + j * (gymax - gymin) / Ny;
407
              Zarr[i, j, k] := Z_Kfixed;
408
            end;
409
          2:
410
            begin
411
              Xarr[i, j, k] := i - Nx / 2;
412
              Yarr[i, j, k] := j - Ny / 2;
413
              Zarr[i, j, k] := Z_Kfixed;
414
            end;
415

416
        end;
417
      end;
418
    end;
419
  end;
420

421
  for i := 0 to Nx - 1 do // ------ set 2d data field
422
  begin
423
    for j := 0 to Ny - 1 do
424
    begin
425
      // example of mapping xAux and yAux are the coordinates in the X and Y axis
426
      // and res3Dplane are normalized values ( >0 and <1) at the points to mapp
427

428
      xAux := Xarr[i, j, Kfixed];
429
      yAux := Yarr[i, j, Kfixed];
430

431
      case RGexamples.ItemIndex of
432
        0:
433
          begin
434
            res3DPlane[i, j, Kfixed] :=
435
              (sin(xAux / Nx * 4 * pi) * cos(yAux / Ny * 4 * pi)) +
436
              (sin(xAux / Nx * 2 * pi) * cos(yAux / Ny * 2 * pi)) +
437
              (sin(xAux / Nx * 1 * pi) * cos(yAux / Ny * 1 * pi)) +
438
              (sin(xAux / Nx * 0.5 * pi) * cos(yAux / Ny * 0.5 * pi)) +
439
              (sin(xAux / Nx * 0.25 * pi) * cos(yAux / Ny * 0.25 * pi));
440
          end;
441
        1:
442
          begin
443
            if (xAux <> 4) or (yAux <> 0) then
444
              res3DPlane[i, j, Kfixed] := 0.5 *
445
                (sin(sqrt(sqr(xAux) + sqr(yAux))) + 1 /
446
                sqrt(sqr(xAux - 4) + sqr(yAux)));
447
          end;
448
        2:
449
          begin
450
            xAux := 0.08 * (i - Nx / 2);
451
            yAux := 0.08 * (j - Ny / 2);
452
            res3DPlane[i, j, Kfixed] :=
453
              (sqr(sqr(xAux) + (yAux - 0.842) * (yAux + 0.842)) +
454
              sqr(xAux * (yAux - 0.842) + xAux * (yAux - 0.842)));
455
          end;
456
      end;
457
    end;
458
  end;
459
end;
460

461
procedure TLevelCurvesForm.DrawPlaneClick(Sender: TObject);
462
var
463
  ResultsMesh: TGLMeshObject;
464
  Quads: TFGVertexIndexList;
465
  i, j, k, MMT: Integer;
466
begin
467
  // reconvert  to 3D variables before drawing a plane
468
  View.Update;
469
  View.Invalidate;
470
  ///////////////////////////////////////////////////////////
471
  PlaneXY.MeshObjects.Clear;
472
  ResultsMesh := TGLMeshObject.CreateOwned(PlaneXY.MeshObjects);
473
  ResultsMesh.Mode := momFaceGroups;
474

475
  case rgPlaneSelection.ItemIndex of
476
    0:
477
      begin
478
        k := Kfixed;
479
        with ResultsMesh do
480
        begin
481
          for i := 1 to Nx do // 1 to Nx
482
          begin // 1 to Ny
483
            for j := 1 to Ny do
484
            begin // coloquei o deltaXwall para ficar centrado
485
              Vertices.Add(Xarr[i, j, k], Yarr[i, j, k], Zarr[i, j, k]);
486
              TexCoords.Add(res3DPlane[i, j, k], 0);
487

488
            end;
489
          end;
490
          Quads := TFGVertexIndexList.CreateOwned(ResultsMesh.FaceGroups);
491
          Quads.Mode := fgmmQuads;
492
          for i := 1 to Nx - 2 do
493
          begin
494
            for j := 1 to Ny - 2 do
495
            begin
496
              MMT := (i - 1) * Ny + j - 1;
497
              Quads.VertexIndices.Add(MMT, MMT + 1);
498
              Quads.VertexIndices.Add(MMT + Ny + 1, MMT + Ny);
499
            end;
500
          end;
501
        end;
502

503
        if SeeIsolines.Checked then
504
          Use_CONREC_XY(k)
505
        else
506
          Isolines.Nodes.Clear;
507
      end;
508

509
    1:
510
      begin
511
        i := Kfixed;
512
        with ResultsMesh do
513
        begin
514
          for j := 1 to Ny do // 1 to Nx
515
          begin // 1 to Ny
516
            for k := 1 to Nz do
517
            begin // coloquei o deltaXwall para ficar centrado
518
              Vertices.Add(Xarr[i, j, k], Yarr[i, j, k], Zarr[i, j, k]);
519
              TexCoords.Add(res3DPlane[i, j, k], 0);
520

521
            end;
522
          end;
523
          Quads := TFGVertexIndexList.CreateOwned(ResultsMesh.FaceGroups);
524
          Quads.Mode := fgmmQuads;
525
          for j := 1 to Ny - 2 do
526
          begin
527
            for k := 1 to Nz - 2 do
528
            begin
529
              MMT := (j - 1) * Nz + k - 1;
530
              Quads.VertexIndices.Add(MMT, MMT + 1);
531
              Quads.VertexIndices.Add(MMT + Nz + 1, MMT + Nz);
532
            end;
533
          end;
534
        end;
535

536
        if SeeIsolines.Checked then
537
          Use_CONREC_XY(i)
538
        else
539
          Isolines.Nodes.Clear;
540
      end;
541

542
    2:
543
      begin
544
        j := Kfixed;
545
        with ResultsMesh do
546
        begin
547
          for k := 1 to Nz do // 1 to Nx
548
          begin // 1 to Ny
549
            for i := 1 to Nx do
550
            begin // coloquei o deltaXwall para ficar centrado
551
              Vertices.Add(Xarr[i, j, k], Yarr[i, j, k], Zarr[i, j, k]);
552
              TexCoords.Add(res3DPlane[i, j, k], 0);
553

554
            end;
555
          end;
556
          Quads := TFGVertexIndexList.CreateOwned(ResultsMesh.FaceGroups);
557
          Quads.Mode := fgmmQuads;
558
          for k := 1 to Nz - 2 do
559
          begin
560
            for i := 1 to Nx - 2 do
561
            begin
562
              MMT := (k - 1) * Nx + i - 1;
563
              Quads.VertexIndices.Add(MMT, MMT + 1);
564
              Quads.VertexIndices.Add(MMT + Nx + 1, MMT + Nx);
565
            end;
566
          end;
567
        end;
568

569
        if SeeIsolines.Checked then
570
          Use_CONREC_XY(j)
571
        else
572
          Isolines.Nodes.Clear;
573
      end;
574
  end;
575
  PlaneXY.StructureChanged;
576
end;
577

578
// __________________________________________________________________________
579
procedure TLevelCurvesForm.Use_CONREC_XY (Kfix:integer);
580
 var
581
  I,J,K:integer;   NCL:integer;    planeName:string;
582
  F38: TextFile;
583
  File38: string;
584
  FileIsolines: TFileName;
585
  IsoValuesList: TList<Real>;
586
  TextIso:TGlFlatText;
587
begin
588
  File38 := ExtractFilePath(application.ExeName) + 'Isolines.txt';
589
  If FileExists(File38) Then
590
    DeleteFile(File38);
591
  AssignFile(F38, File38);
592
  Rewrite(F38);
593
  writeln(F38, ' Hgt[i]  Nodes.Items[i].X   Nodes.Items[i].Y ]');
594

595
  // convert 3D variables to CONREC type variables
596
  SetLength(Scx, Nx);
597
  SetLength(Scy, Ny);
598
  SetLength(Scz, Nz);
599

600
  case rgPlaneSelection.ItemIndex of
601
    0:
602
      begin
603
        SetLength(Mat, Nx, Ny);
604

605
        for i := 0 to Nx - 1 Do
606
          Scx[i] := Xarr[i, 0, Kfixed];
607
        for j := 0 to Ny - 1 Do
608
          Scy[j] := Yarr[0, j, Kfixed];
609

610
        for i := 0 to Nx - 1 Do
611
        begin
612
          for j := 0 to Ny - 1 Do
613
          begin
614
            Mat[i, j] := res3DPlane[i, j, Kfixed];
615
          end; // ----------------------------------------------------------------
616
        end;
617

618
        mi := 1E16;
619
        // ------------    Set the minimunm and maximum f of the data field
620
        ma := -1E16;
621

622
        for i := 0 to Nx - 1 Do
623
        begin
624
          for j := 0 to Ny - 1 Do
625
          begin
626
            if Mat[i, j] < mi then
627
              mi := Mat[i, j];
628
            if Mat[i, j] > ma then
629
              ma := Mat[i, j];
630
          end; // ----------------------------------------------------------------
631
        end;
632

633
        NC := TrackBarNC.Position;
634
        Z_Kfixed := TrackBarPosition.Position;
635
        SetLength(Hgt, NC);
636
        for i := 0 to NC - 1 Do // ----- create cut levels
637
          Hgt[i] := mi + i * (ma - mi) / (NC - 1);
638

639
        Isolines.Nodes.Clear;
640
        Isolines.Conrec(rgPlaneSelection.ItemIndex, PlaneXY, Mat, 0, Nx - 1, 0,
641
          Ny - 1, Scx, Scy, NC, Hgt, Z_Kfixed, res3DmaxForm3D, res3DminForm3D);
642
      end;
643
    1:
644
      begin
645
        SetLength(Mat, Ny, Nz);
646

647
        for j := 0 to Ny - 1 do
648
          Scy[j] := Yarr[Kfixed, j, 0];
649
        for k := 0 to Nz - 1 do
650
          Scz[k] := Zarr[Kfixed, 0, k];
651

652
        for j := 0 to Ny - 1 do
653
        begin
654
          for k := 0 to Nz - 1 do
655
          begin
656
            Mat[j, k] := res3DPlane[Kfixed, j, k];
657
          end; // ----------------------------------------------------------------
658
        end;
659

660
        mi := 1E16;
661
        // ------------    Set the minimunm and maximum f of the data field
662
        ma := -1E16;
663

664
        for j := 0 to Ny - 1 do
665
        begin
666
          for k := 0 to Nz - 1 do
667
          begin
668
            if Mat[j, k] < mi then
669
              mi := Mat[j, k];
670
            if Mat[j, k] > ma then
671
              ma := Mat[j, k];
672
          end; // ----------------------------------------------------------------
673
        end;
674

675
        NC := TrackBarNC.Position;
676
        Z_Kfixed := TrackBarPosition.Position;
677
        SetLength(Hgt, NC);
678
        for i := 0 to NC - 1 Do // ----- create cut levels
679
          Hgt[i] := mi + i * (ma - mi) / (NC - 1);
680

681
        Isolines.Nodes.Clear;
682
        Isolines.Conrec(rgPlaneSelection.ItemIndex, PlaneXY, Mat, 0, Ny - 1, 0,
683
          Nz - 1, Scy, Scz, NC, Hgt, Z_Kfixed, res3DmaxForm3D, res3DminForm3D);
684
      end;
685
    2:
686
      begin
687
        SetLength(Mat, Nz, Nx);
688

689
        for k := 0 to Nz - 1 do
690
          Scy[k] := Zarr[0, Kfixed, k];
691
        for i := 0 to Nx - 1 do
692
          Scz[i] := Xarr[i, Kfixed, 0];
693

694
        for k := 0 to Nz - 1 Do
695
        begin
696
          for i := 0 to Nx - 1 Do
697
          begin
698
            Mat[k, i] := res3DPlane[i, Kfixed, k];
699
          end; // ----------------------------------------------------------------
700
        end;
701

702
        mi := 1E16;
703
        // ------------    Set the minimunm and maximum f of the data field
704
        ma := -1E16;
705

706
        for k := 0 to Nz - 1 Do
707
        begin
708
          for i := 0 to Nx - 1 Do
709
          begin
710
            if Mat[k, i] < mi then
711
              mi := Mat[k, i];
712
            if Mat[k, i] > ma then
713
              ma := Mat[k, i];
714
          end; // ----------------------------------------------------------------
715
        end;
716

717
        NC := TrackBarNC.Position;
718
        Z_Kfixed := TrackBarPosition.Position;
719
        SetLength(Hgt, NC);
720
        for i := 0 to NC - 1 Do // ----- create cut levels
721
          Hgt[i] := mi + i * (ma - mi) / (NC - 1);
722
        Isolines.Conrec(rgPlaneSelection.ItemIndex, PlaneXY, Mat, 0, Nz - 1, 0,
723
          Nx - 1, Scz, Scx, NC, Hgt, Z_Kfixed, res3DmaxForm3D, res3DminForm3D);
724
      end;
725

726
  end;
727

728
  /// start write
729
  IsoValuesList := TList<Real>.Create;
730
  for i := 0 to Isolines.Nodes.Count - 1 do
731
  begin
732
    writeln(F38, Format('%10.2f %5.2f %5.2f',
733
      [Hgt[i], Isolines.Nodes.Items[i].x, Isolines.Nodes.Items[i].y]));
734
  end;
735

736
  IsoValuesList.Free;
737
  CloseFile(F38);
738
end;
739

740
procedure TLevelCurvesForm.FileSave1Execute(Sender: TObject);
741
begin
742
  SaveDialog.Execute;
743
end;
744

745

746
procedure TLevelCurvesForm.FileNew1Execute(Sender: TObject);
747
begin
748
  { Do nothing }
749
end;
750

751
procedure TLevelCurvesForm.FileOpen1Execute(Sender: TObject);
752
begin
753
  OpenDialog.Execute;
754
end;
755

756

757
procedure TLevelCurvesForm.FormKeyPress(Sender: TObject; var Key: Char);
758
begin
759
  UserAbort := Key = #27;
760
  with dc_cam do
761
    case Key of
762
      '7': RotateAbsolute(-15, 0, 0);
763
      '9': RotateAbsolute(+15, 0, 0);
764
      '4': RotateAbsolute(0, -15, 0);
765
      '6': RotateAbsolute(0, +15, 0);
766
      '1': RotateAbsolute(0, 0, -15);
767
      '3': RotateAbsolute(0, 0, +15);
768
    end;
769
end;
770

771
procedure TLevelCurvesForm.FileExit1Execute(Sender: TObject);
772
begin
773
  Close;
774
end;
775

776
procedure TLevelCurvesForm.HelpAbout1Execute(Sender: TObject);
777
begin
778
  with TAboutBox.Create(Self) do
779
    try
780
      ShowModal;
781
    finally
782
      Free;
783
    end;
784
end;
785

786
procedure TLevelCurvesForm.FormClose(Sender: TObject; var Action: TCloseAction);
787
var
788
  temp: Tcomponent;
789
begin
790
  SetLength(Mat,0);
791
  SetLength(Scx,0);
792
  SetLength(Scy,0);
793
  SetLength(Scz,0);
794

795
  SetLength(Hgt,0);
796
  SetLength(Xarr,0);
797
  SetLength(Yarr,0);
798
  SetLength(Zarr,0);
799
  SetLength(res3DPlane,0);
800
  PlaneXY.MeshObjects.Clear;
801
  Isolines.Nodes.Clear;
802
  Action := caFree;
803

804
  for i := ComponentCount - 1 downto 0 do
805
  begin
806
    temp := Components[i]; // if (Temp is TObject) then
807
    RemoveComponent(temp);
808
  end;
809
end;
810

811
end.
812