MathgeomGLS

Форк
0
1259 строк · 34.0 Кб
1
unit faGraf2d;
2

3
interface
4

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

23
  GLS.OpenGLTokens,
24
  GLS.PersistentClasses,
25
  GLS.Scene,
26
  GLS.VectorTypes,
27
  GLS.GeomObjects,
28
  GLS.HUDObjects,
29
  GLS.Objects,
30
  GLS.Graph,
31
  GLS.Coordinates,
32

33
  GLS.SceneViewer,
34
  GLS.BitmapFont,
35
  GLS.WindowsFont,
36
  GLS.Particles,
37
  GLS.Color,
38
  GLS.BaseClasses,
39
  GLS.VectorGeometry,
40
  GLS.State,
41
  GLS.Material,
42

43
  Graf.Global2d,
44
  Graf.Parser2d,
45
  faEvaluate,
46
  faGridColors,
47
  faAddPlotColors,
48
  faCoordOptions,
49
  faGridOptions,
50
  faDerivativeOptions,
51
  faPlotColors,
52
  fAbout;
53

54
type
55
  TFormPlotStars = class(TForm)
56
    GLSViewer: TGLSceneViewer;
57
    GLScene: TGLScene;
58
    GLLight: TGLLightSource;
59
    CameraCube: TGLDummyCube;
60
    Camera: TGLCamera;
61
    GLxyGrid: TGLXYZGrid;
62
    Fields: TGLDummyCube;
63
    GLWinBmpFont: TGLWindowsBitmapFont;
64
    StatusBar: TStatusBar;
65
    MainMenu: TMainMenu;
66
    miFile: TMenuItem;
67
    miNew: TMenuItem;
68
    miOptions: TMenuItem;
69
    miDefaultLayout: TMenuItem;
70
    miOpenFile: TMenuItem;
71
    miSave: TMenuItem;
72
    miSaveas: TMenuItem;
73
    miExit: TMenuItem;
74
    miGrid: TMenuItem;
75
    miGridColours: TMenuItem;
76
    miEvaluate: TMenuItem;
77
    GLxzGrid: TGLXYZGrid;
78
    GLyzGrid: TGLXYZGrid;
79
    TargetCube: TGLDummyCube;
80
    xCoordLine: TGLLines;
81
    yCoordLine: TGLLines;
82
    zCoordLine: TGLLines;
83
    BoxLine1: TGLLines;
84
    BoxLine2: TGLLines;
85
    BoxLine3: TGLLines;
86
    BoxLine4: TGLLines;
87
    miCoordText: TMenuItem;
88
    YCoordsCube: TGLDummyCube;
89
    XCoordsCube: TGLDummyCube;
90
    ZCoordsCube: TGLDummyCube;
91
    xArrow: TGLArrowLine;
92
    yArrow: TGLArrowLine;
93
    miRecent: TMenuItem;
94
    miDerivativeOps: TMenuItem;
95
    AddedField: TGLDummyCube;
96
    AddXLine: TGLLines;
97
    AddYLine: TGLLines;
98
    AddZLine: TGLLines;
99
    miPlotColours: TMenuItem;
100
    miDerivativePlotColours: TMenuItem;
101
    VolumeLines: TGLDummyCube;
102
    N2: TMenuItem;
103
    N3: TMenuItem;
104
    N4: TMenuItem;
105
    miHelp: TMenuItem;
106
    miAbout: TMenuItem;
107
    miView: TMenuItem;
108
    miGraf1d: TMenuItem;
109
    miGraf2d: TMenuItem;
110
    miRuwiki: TMenuItem;
111
    N1: TMenuItem;
112
    procedure FormCreate(Sender: TObject);
113
    procedure FormShow(Sender: TObject);
114
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
115
    procedure GLSViewerMouseDown(Sender: TObject; Button: TMouseButton;
116
      Shift: TShiftState; X, Y: Integer);
117
    procedure GLSViewerMouseMove(Sender: TObject; Shift: TShiftState;
118
      X, Y: Integer);
119
    procedure GLSViewerMouseUp(Sender: TObject; Button: TMouseButton;
120
      Shift: TShiftState; X, Y: Integer);
121
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
122
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
123
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
124
    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
125
    procedure miDefaultLayoutClick(Sender: TObject);
126
    procedure miExitClick(Sender: TObject);
127
    procedure miGridClick(Sender: TObject);
128
    procedure miGridColoursClick(Sender: TObject);
129
    procedure miEvaluateClick(Sender: TObject);
130
    procedure miNewClick(Sender: TObject);
131
    procedure miOpenFileClick(Sender: TObject);
132
    procedure miSaveClick(Sender: TObject);
133
    procedure miSaveasClick(Sender: TObject);
134
    procedure FormDestroy(Sender: TObject);
135
    procedure FormActivate(Sender: TObject);
136
    procedure miCoordTextClick(Sender: TObject);
137
    procedure RecentFilesClick(Sender: TObject);
138
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
139
    procedure miDerivativeOpsClick(Sender: TObject);
140
    procedure miPlotColoursClick(Sender: TObject);
141
    procedure miDerivativePlotColoursClick(Sender: TObject);
142
    procedure miAboutClick(Sender: TObject);
143
  private
144
    AtStart: Boolean;
145
    SelectedData: TPlotData; // data used to evaluate dz/dx or dz/dy
146
    procedure ShowCameraLocation;
147
    procedure ShowFocalLength;
148
    procedure ShowLightLocation;
149
    procedure DefaultView;
150
    procedure DefaultLayout;
151
    procedure Formulate(const X, Y: Single; var z: Single;
152
      var Color: TGLColorVector; var texPoint: TTexPoint);
153
    procedure CreateHeightFields(const n: Integer);
154
    procedure PlotFunctions;
155
    procedure CreateAddedField;
156
    procedure PlotDerivativeField;
157
    procedure PlotIntegralField;
158
  public
159
    MousePoint: TPoint;
160
    procedure ShowDisplacement;
161
    procedure UpdatePlot;
162
    procedure UpdateAdded;
163
    procedure ClearAddedField;
164
    procedure ClearAddedLines;
165
  end;
166

167
const
168
  crLightxz = 1;
169
  crLightyz = 2;
170
  crLightxy = 3;
171
  crSlidexy = 4;
172
  crSlideyz = 5;
173
  crSlidexz = 6;
174
  crRotate = 7;
175
  crZoom = 8;
176
  crHandMove = 9;
177
  crSlidezy = 10;
178

179
var
180
  FormPlotStars: TFormPlotStars;
181

182
// =====================================================================
183
implementation
184
// =====================================================================
185

186
{$R *.dfm}
187

188
uses
189
  faFunctions;
190

191
procedure TFormPlotStars.FormCreate(Sender: TObject);
192
begin
193
  BinPath := ExtractFilePath(ParamStr(0));
194
  BinPath := IncludeTrailingPathDelimiter(BinPath);
195
//  PlotPath := BinPath;
196
//  Delete(PlotPath, Length(PlotPath) - 4, 4);
197
  DataPath := BinPath + 'data\plot2d\';
198
  SetCurrentDir(DataPath);
199
  ImagePath := BinPath + 'data\images\';
200
  LayoutFName := BinPath + 'Layout2d.lay';
201
  RecentFName := BinPath + 'Recent.ini';
202

203
  Screen.Cursors[crLightxy] := LoadCursor(HInstance, 'LIGHTXY');
204
  Screen.Cursors[crLightyz] := LoadCursor(HInstance, 'LIGHTYZ');
205
  Screen.Cursors[crLightxz] := LoadCursor(HInstance, 'LIGHTXZ');
206
  Screen.Cursors[crSlidexy] := LoadCursor(HInstance, 'SLIDEXY');
207
  Screen.Cursors[crSlidexz] := LoadCursor(HInstance, 'SLIDEXZ');
208
  Screen.Cursors[crSlideyz] := LoadCursor(HInstance, 'SLIDEYZ');
209
  Screen.Cursors[crRotate] := LoadCursor(HInstance, 'ROTATE');
210
  Screen.Cursors[crZoom] := LoadCursor(HInstance, 'ZOOM');
211
  Screen.Cursors[crSlidezy] := LoadCursor(HInstance, 'SLIDEZY');
212
  AtStart := True;
213
end;
214

215
procedure TFormPlotStars.FormShow(Sender: TObject);
216
var
217
  LayFile: File of TLayout;
218
  ini: TIniFile;
219
  i, c: Integer;
220
  s: string;
221

222
begin
223
  if FileExists(LayoutFName) then
224
  begin
225
    try
226
      AssignFile(LayFile, LayoutFName);
227
      try
228
        Reset(LayFile);
229
        Read(LayFile, Layout);
230
      finally
231
        CloseFile(LayFile);
232
      end;
233
      with Layout do
234
      begin
235
        if IsMaximize then
236
          WindowState := wsMaximized
237
        else
238
        begin
239
          WindowState := wsNormal;
240
          Left := MainLeft;
241
          Top := MainTop;
242
          Width := MainWidth;
243
          Height := MainHeight;
244
        end;
245
        GraphFName := CurrentGraphFName;
246
        DataPath := CurrentDataPath;
247
        ImagePath := CurrentImagePath;
248
        // ����� �������
249
        FunctionsForm.Left := FuncLeft;
250
        FunctionsForm.Top := FuncTop;
251
        FunctionsForm.Width := FuncWidth;
252
        FunctionsForm.Height := FuncHeight;
253
        // ����� ���������� �����
254
        if GridsVisible then
255
          FormGridOptions.Show;
256
        FormGridOptions.Left := GridsLeft;
257
        FormGridOptions.Top := GridsTop;
258
        // ����� ����� �����
259
        GridColorsForm.Left := GridColorsLeft;
260
        GridColorsForm.Top := GridColorsTop;
261
        // ����� ����� �������
262
        PlotColorsForm.Left := PlotColorsLeft;
263
        PlotColorsForm.Top := PlotColorsTop;
264
        // ����� ������ �������
265
        if EvaluateVisible then
266
          EvaluateForm.Show;
267
        EvaluateForm.Left := EvaluateLeft;
268
        EvaluateForm.Top := EvaluateTop;
269
        // ����� ���������
270
        if CoordVisible then
271
          CoordsForm.Show;
272
        CoordsForm.Left := CoordLeft;
273
        CoordsForm.Top := CoordTop;
274
        // ����� �����������
275
        DerivativesForm.Left := DerivLeft;
276
        DerivativesForm.Top := DerivTop;
277
        // ����� �������������� ������ �������
278
        AddPlotColorsForm.Left := AddColorsLeft;
279
        AddPlotColorsForm.Top := AddColorsTop;
280
      end;
281
      FunctionsForm.EditMinX.SetFocus;
282
    except
283
      MessageDlg('������ ������ �����!' +
284
        #13#10'"' + LayoutFName + '".' +
285
        #13#10'����� ������������ �������� ���������', mtError, [mbOK], 0);
286
      DefaultLayout;
287
    end;
288
  end
289
  else
290
    DefaultLayout;
291

292
  ShowCameraLocation;
293
  // focallength: right mouse drag up/down
294
  ShowFocalLength;
295
  (* displace origin: x axis: ctrl/left mouse drag left/right
296
    y axis: alt/left mouse drag up/down
297
    z axis: ctrl/left mouse drag up/down *)
298
  ShowDisplacement;
299
  (* move light: x axis: ctrl right mouse drag left/right
300
    y axis: alt right mouse drag up/down
301
    z axis: ctrl right mouse drag up/down *)
302
  ShowLightLocation;
303

304
  FunctionsForm.ReadAndShowInitialData;
305
  Caption := GraphFName;
306
  Altered := False;
307
  CreateHeightFields(FunctionsForm.CheckListBox.Count);
308

309
  ini := TIniFile.Create(RecentFName);
310
  with ini do
311
    try
312
      c := ReadInteger(Name, 'RecentCount', 0);
313
      for i := 0 to c - 1 do
314
      begin
315
        miRecent.Add(TMenuItem.Create(Self));
316
        miRecent.Items[i].Caption := ReadString(Name, IntToStr(i), '');
317
        miRecent.Items[i].OnClick := RecentFilesClick;
318
      end;
319
    finally
320
      Free;
321
    end;
322
end;
323

324
procedure TFormPlotStars.FormActivate(Sender: TObject);
325
begin
326
  if AtStart then
327
  begin
328
    PlotFunctions;
329
    if GridColorsForm.Visible then
330
      GridColorsForm.ShowGridColorData;
331
    if PlotColorsForm.Visible then
332
      PlotColorsForm.ShowPlotColorData;
333
    AtStart := False;
334
  end;
335
end;
336

337
procedure TFormPlotStars.FormClose(Sender: TObject; var Action: TCloseAction);
338
var
339
  ini: TIniFile;
340
  i: Integer;
341
begin
342
  ini := TIniFile.Create(RecentFName);
343
  try
344
    ini.WriteInteger(Name, 'RecentCount', miRecent.Count);
345
    for i := 0 to miRecent.Count - 1 do
346
      ini.WriteString(Name, IntToStr(i), miRecent.Items[i].Caption);
347
  finally
348
    ini.Free;
349
  end;
350
end;
351

352
procedure TFormPlotStars.FormDestroy(Sender: TObject);
353
begin
354
  while Fields.Count > 0 do
355
    TGLHeightField(Fields.Children[0]).Free;
356
  ClearAddedField;
357
  ClearAddedLines;
358
end;
359

360
procedure TFormPlotStars.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
361
var
362
  f: File of TLayout;
363

364
begin
365
  with Layout do
366
  begin
367
    IsMaximize := (Width >= Screen.Width) and (Height >= Screen.Height);
368
    MainLeft := Left;
369
    MainTop := Top;
370
    MainWidth := Width;
371
    MainHeight := Height;
372
    if GraphFName = '' then
373
      GraphFName := NewFName;
374
    CurrentGraphFName := GraphFName;
375
    CurrentDataPath := DataPath;
376
    CurrentImagePath := ImagePath;
377

378
    FuncLeft := FunctionsForm.Left;
379
    FuncTop := FunctionsForm.Top;
380
    FuncWidth := FunctionsForm.Width;
381
    FuncHeight := FunctionsForm.Height;
382

383
    GridsVisible := FormGridOptions.Visible;
384
    GridsLeft := FormGridOptions.Left;
385
    GridsTop := FormGridOptions.Top;
386

387
    GridColorsLeft := GridColorsForm.Left;
388
    GridColorsTop := GridColorsForm.Top;
389

390
    PlotColorsLeft := PlotColorsForm.Left;
391
    PlotColorsTop := PlotColorsForm.Top;
392

393
    EvaluateVisible := EvaluateForm.Visible;
394
    EvaluateLeft := EvaluateForm.Left;
395
    EvaluateTop := EvaluateForm.Top;
396

397
    CoordVisible := CoordsForm.Visible;
398
    CoordLeft := CoordsForm.Left;
399
    CoordTop := CoordsForm.Top;
400

401
    DerivLeft := DerivativesForm.Left;
402
    DerivTop := DerivativesForm.Top;
403
    if DerivativesForm.Visible then
404
      DerivativesForm.Close;
405

406
    AddColorsLeft := AddPlotColorsForm.Left;
407
    AddColorsTop := AddPlotColorsForm.Top;
408
    if AddPlotColorsForm.Visible then
409
      AddPlotColorsForm.Close;
410
  end;
411

412
  try
413
    AssignFile(f, LayoutFName);
414
    try
415
      Rewrite(f);
416
      write(f, Layout);
417
    finally
418
      CloseFile(f);
419
    end;
420
  except
421
    MessageDlg('������ ������ �����!' +
422
      #13#10'��� ������ � "' + LayoutFName + '".', mtError,
423
      [mbOK], 0);
424
  end;
425

426
  if Altered or GridColorsAltered or DerivativeAltered then
427
  begin
428
    case MessageDlg('��������� ������� ���� ��������.' +
429
      #13#10'��������� ��������� ?', mtConfirmation,
430
      [mbYes, mbNo, mbCancel], 0) of
431
      mrYes:
432
        FunctionsForm.miSaveClick(Sender);
433
      mrCancel:
434
        begin
435
          CanClose := False;
436
          Exit;
437
        end;
438
    end;
439
  end;
440
end;
441

442
//---------------------------------------------------------------
443
procedure TFormPlotStars.FormKeyDown(Sender: TObject; var Key: Word;
444
  Shift: TShiftState);
445
var
446
  d: Integer;
447
begin
448
  d := 0;
449
  case Key of
450
    VK_ADD:
451
      d := -1; // zoom in
452
    VK_SUBTRACT:
453
      d := 1; // zoom out
454
  end;
455
  if Key in [VK_ADD, VK_SUBTRACT] then
456
  begin
457
    Screen.Cursor := crZoom;
458
    GLSViewer.SetFocus;
459
    // each step adjusts target distance by 2.5% another method to zoom in or out
460
    Camera.AdjustDistanceToTarget(Power(1.025, d));
461
    ShowCameraLocation;
462
  end
463
  else
464
    case Key of
465
      VK_HOME, VK_NUMPAD7, 72:
466
        DefaultView; // 'H'/'h' key
467
      (* -> = 39
468
        <- = 37
469
        ^  = 38
470
        |  = 40
471
        -> and ^ = 33
472
        <- and | = 35 *)
473
    end;
474
  Key := 0;
475
end;
476

477
//---------------------------------------------------------------
478
procedure TFormPlotStars.FormKeyUp(Sender: TObject; var Key: Word;
479
  Shift: TShiftState);
480
begin
481
  Screen.Cursor := crDefault;
482
end;
483

484
procedure TFormPlotStars.FormMouseWheel(Sender: TObject; Shift: TShiftState;
485
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
486
begin
487
  if (MousePoint.X >= GLSViewer.Left) and
488
    (MousePoint.X <= GLSViewer.Left + GLSViewer.Width) and
489
    (MousePoint.Y >= GLSViewer.Top) and
490
    (MousePoint.Y <= GLSViewer.Top + GLSViewer.Height) then
491
  begin
492
    (*
493
      a wheel step = WheelDelta/300; each step adjusts target distance by 2.5%
494
      another method to zoom in or out
495
    *)
496
    GLSViewer.SetFocus;
497
    Camera.AdjustDistanceToTarget(Power(1.025, WheelDelta / 300));
498
    ShowCameraLocation;
499
  end;
500
end;
501

502
//---------------------------------------------------------------
503
procedure TFormPlotStars.GLSViewerMouseDown(Sender: TObject; Button: TMouseButton;
504
  Shift: TShiftState; X, Y: Integer);
505
begin
506
  MousePoint.X := X;
507
  MousePoint.Y := Y;
508
  if ssShift in Shift then // Shift key down
509
  begin
510
    if ssLeft in Shift then
511
      Screen.Cursor := crZoom;
512
  end
513
  else if ssCtrl in Shift then // Ctrl key down
514
  begin
515
    if ssLeft in Shift then
516
      Screen.Cursor := crSlidexz
517
    else if ssRight in Shift then
518
      Screen.Cursor := crLightxz;
519
  end
520
  else if ssAlt in Shift then // Alt key down
521
  begin
522
    if ssLeft in Shift then
523
      Screen.Cursor := crSlidezy
524
    else if ssRight in Shift then
525
      Screen.Cursor := crLightxy;
526
  end
527
  else // no shift, ctrl or alt key
528
  begin
529
    if Shift = [ssLeft] then
530
      Screen.Cursor := crRotate
531
    else if Shift = [ssRight] then
532
      Screen.Cursor := crZoom;
533
  end;
534
end;
535

536
//---------------------------------------------------------------
537
procedure TFormPlotStars.GLSViewerMouseMove(Sender: TObject; Shift: TShiftState;
538
  X, Y: Integer);
539
var
540
  dx, dy: Integer;
541

542
begin // refer GLScene\Demos\interface\camera\Camera.dpr
543
  if MousePoint.X = MaxInt then // FileOpenDialog is visible
544
  begin
545
    MousePoint.X := X;
546
    Exit;
547
  end;
548

549
  dx := MousePoint.X - X;
550
  dy := MousePoint.Y - Y;
551

552
  if ssShift in Shift then // shift key down
553
  begin
554
    if ssLeft in Shift then // shift - left mouse button
555
    begin
556
      (* dy = a step which adjusts target distance by 1.25%; zoom in or out *)
557
      Camera.AdjustDistanceToTarget(Power(1.0125, dy));
558
      ShowCameraLocation;
559
    end;
560
  end
561
  else if ssCtrl in Shift then // Ctrl key down
562
  begin
563
    if ssLeft in Shift then // Ctrl - left mouse button
564
    begin
565
      TargetCube.Position.X := TargetCube.Position.X - dx *
566
        GLxzGrid.XSamplingScale.Step / 10;
567
      TargetCube.Position.z := TargetCube.Position.z - dy *
568
        GLxzGrid.ZSamplingScale.Step * ViewData.xyGrid.zScale / 10;
569
      ShowDisplacement;
570
    end;
571
    if ssRight in Shift then // Ctrl - right mouse button
572
    begin
573
      GLLight.Position.z := GLLight.Position.z + dy / 10;
574
      GLLight.Position.X := GLLight.Position.X + dx / 10;
575
      ShowLightLocation;
576
    end;
577
  end
578
  else if ssAlt in Shift then // Alt key down
579
  begin
580
    if ssRight in Shift then // Alt - right mouse button
581
    begin
582
      GLLight.Position.X := GLLight.Position.X + dx / 10;
583
      GLLight.Position.Y := GLLight.Position.Y + dy / 10;
584
      ShowLightLocation;
585
    end
586
    else if ssLeft in Shift then // Alt - left mouse button
587
    begin
588
      TargetCube.Position.Y := TargetCube.Position.Y + dx *
589
        GLyzGrid.YSamplingScale.Step / 10;
590
      TargetCube.Position.z := TargetCube.Position.z - dy *
591
        GLyzGrid.ZSamplingScale.Step * ViewData.xyGrid.zScale / 10;
592
      ShowDisplacement;
593
    end;
594
  end
595
  else // no shift key
596
  begin
597
    if Shift = [ssLeft] then
598
    (* Left mouse button changes camera angle by moving around target *)
599
    begin
600
      Camera.MoveAroundTarget(dy, dx);
601
      ShowCameraLocation;
602
    end;
603
    if Shift = [ssRight] then
604
    begin
605
      (*
606
        Right mouse button alters the camera's focal length;
607
        zoom out or in by moving cursor up or down
608
      *)
609
      Camera.FocalLength := Camera.FocalLength - dy;
610
      if Camera.FocalLength > 3000 then
611
        Camera.FocalLength := 3000; // max focal length
612
      if Camera.FocalLength < 10 then
613
        Camera.FocalLength := 10; // min focal length
614

615
      ShowFocalLength; // display in statusbar palel
616
    end;
617
  end;
618
  MousePoint.X := X; // update mouse position
619
  MousePoint.Y := Y;
620
end;
621

622
//---------------------------------------------------------------
623
procedure TFormPlotStars.GLSViewerMouseUp(Sender: TObject; Button: TMouseButton;
624
  Shift: TShiftState; X, Y: Integer);
625
begin
626
  Screen.Cursor := crDefault;
627
end;
628

629
procedure TFormPlotStars.miNewClick(Sender: TObject);
630
begin
631
  FunctionsForm.miNewClick(Sender);
632
end;
633

634
procedure TFormPlotStars.miOpenFileClick(Sender: TObject);
635
begin
636
  FunctionsForm.miOpenFileClick(Sender);
637
end;
638

639
procedure TFormPlotStars.miSaveClick(Sender: TObject);
640
begin
641
  FunctionsForm.miSaveClick(Sender);
642
end;
643

644
procedure TFormPlotStars.miSaveasClick(Sender: TObject);
645
begin
646
  FunctionsForm.miSaveAsClick(Sender);
647
end;
648

649
procedure TFormPlotStars.ShowCameraLocation;
650
begin
651
  StatusBar.Panels[0].Text := '������: ' +
652
    FloatToStrF(Camera.Position.X, ffNumber, 5, 2) + ', ' +
653
    FloatToStrF(Camera.Position.Y, ffNumber, 5, 2) + ', ' +
654
    FloatToStrF(Camera.Position.Z, ffNumber, 5, 2);
655
end;
656

657
procedure TFormPlotStars.miGridColoursClick(Sender: TObject);
658
begin
659
  GridColorsForm.Show;
660
end;
661

662
procedure TFormPlotStars.miCoordTextClick(Sender: TObject);
663
begin
664
  CoordsForm.Show;
665
end;
666

667
procedure TFormPlotStars.ShowFocalLength;
668
begin
669
  StatusBar.Panels[1].Text := 'f = ' + FloatToStrF(Camera.FocalLength,
670
    ffNumber, 5, 2);
671
end;
672

673
procedure TFormPlotStars.ShowDisplacement;
674
begin
675
  StatusBar.Panels[2].Text := 'Displaced: ' +
676
    FloatToStrF(-TargetCube.Position.X, ffNumber, 5, 2) + ', ' +
677
    FloatToStrF(-TargetCube.Position.Y, ffNumber, 5, 2) + ', ' +
678
    FloatToStrF(-TargetCube.Position.Z, ffNumber, 5, 2);
679
end;
680

681
procedure TFormPlotStars.miEvaluateClick(Sender: TObject);
682
begin
683
  EvaluateForm.Show;
684
end;
685

686
procedure TFormPlotStars.ShowLightLocation;
687
begin
688
  StatusBar.Panels[3].Text := '����: ' +
689
    FloatToStrF(GLLight.Position.X, ffNumber, 5, 2) + ', ' +
690
    FloatToStrF(GLLight.Position.Y, ffNumber, 5, 2) + ', ' +
691
    FloatToStrF(GLLight.Position.Z, ffNumber, 5, 2);
692
end;
693

694
procedure TFormPlotStars.miGridClick(Sender: TObject);
695
begin
696
  FormGridOptions.Show;
697
end;
698

699
procedure TFormPlotStars.miDefaultLayoutClick(Sender: TObject);
700
begin
701
  DefaultLayout;
702
end;
703

704
procedure TFormPlotStars.DefaultView;
705
begin
706
  CameraCube.Position.SetPoint(0, 0, 0);
707
  ShowDisplacement;
708
  Camera.FocalLength := 200;
709
  ShowFocalLength;
710
  Camera.Position.SetPoint(50, 50, 30);
711
  Camera.DepthOfView := 1000;
712
  ShowCameraLocation;
713
  GLLight.Position.SetPoint(50, 50, 50);
714
  ShowLightLocation;
715
  TargetCube.Position.SetPoint(0, 0, 0);
716
end;
717

718
procedure TFormPlotStars.RecentFilesClick(Sender: TObject);
719
begin
720
  FunctionsForm.OpenRecentFile(TMenuItem(Sender).Caption);
721
end;
722

723
procedure TFormPlotStars.miExitClick(Sender: TObject);
724
begin
725
  Close;
726
end;
727

728
procedure TFormPlotStars.DefaultLayout;
729
begin
730
  WindowState := wsNormal;
731
  FormPlotStars.Left := 0;
732
  FormPlotStars.Top := 0;
733
  FunctionsForm.Width := 335;
734
  FunctionsForm.Height := 387;
735
  FormPlotStars.Width := Screen.Width - FunctionsForm.Width + 18;
736
  FormPlotStars.Height := Screen.Height - 40;
737
  FunctionsForm.Left := FormPlotStars.Left + FormPlotStars.Width - 14;
738
  FunctionsForm.Top := FormPlotStars.Top;
739
  FormGridOptions.Left := FunctionsForm.Left + 5;
740
  FormGridOptions.Top := FunctionsForm.Top + FunctionsForm.Height - 6;
741
  EvaluateForm.Left := FormGridOptions.Left;
742
  EvaluateForm.Top := FormGridOptions.Top + FormGridOptions.Height - 3;
743
  EvaluateForm.Show;
744
  FormGridOptions.Show;
745
  GridColorsForm.Left := 20;
746
  GridColorsForm.Top := 80;
747
  PlotColorsForm.Left := 30;
748
  PlotColorsForm.Top := 100;
749
  AddPlotColorsForm.Left := 40;
750
  AddPlotColorsForm.Top := 120;
751
  FunctionsForm.EditMinX.SetFocus;
752
end;
753

754
procedure TFormPlotStars.miDerivativeOpsClick(Sender: TObject);
755
begin
756
  if PlotColorsForm.Visible then
757
    PlotColorsForm.Close;
758
  miPlotColours.Enabled := False;
759
  miDerivativePlotColours.Enabled := True;
760
  DerivativesForm.Show;
761
end;
762

763
procedure TFormPlotStars.miDerivativePlotColoursClick(Sender: TObject);
764
begin
765
  if PlotColorsForm.Visible then
766
    PlotColorsForm.Close;
767
  miPlotColours.Enabled := False;
768
  AddPlotColorsForm.Show;
769
end;
770

771
procedure TFormPlotStars.PlotFunctions;
772

773
  procedure PlotFunction(i: Integer);
774
  begin
775
    with PlotData do
776
    begin
777
      with TGLHeightField(Fields.Children[i]) do
778
      begin
779
        XSamplingScale.Step := xInc;
780
        XSamplingScale.Min := xMin;
781
        XSamplingScale.Max := xMax;
782

783
        YSamplingScale.Step := yInc;
784
        YSamplingScale.Min := yMin;
785
        YSamplingScale.Max := yMax;
786

787
        case ViewMode of
788
          vmAmbient:
789
            ColorMode := hfcmAmbient;
790
          vmAmbientandDiffuse:
791
            ColorMode := hfcmAmbientAndDiffuse;
792
          vmDiffuse:
793
            ColorMode := hfcmDiffuse;
794
          vmEmmision:
795
            ColorMode := hfcmEmission;
796
          vmNone:
797
            ColorMode := hfcmNone;
798
        end;
799

800
        case fxyMode of
801
          fxyFill:
802
            Material.PolygonMode := pmFill;
803
          fxyLines:
804
            Material.PolygonMode := pmLines;
805
          fxyPoints:
806
            Material.PolygonMode := pmPoints;
807
        end;
808
        OnGetHeight := Formulate;
809
      end;
810
      GLSViewer.Refresh; // needed to display each zField data in list
811
    end;
812
  end;
813

814
var
815
  i: Integer;
816
  fxyParser: TfxyParser;
817
  PD: TPlotData; // save the current PlotData of selected function
818

819
begin // PlotFunctions
820
  Screen.Cursor := crHourGlass;
821
  PD := PlotData;
822
  fxyParser := TfxyParser.Create(0, 0);
823
  try
824
    with FunctionsForm.CheckListBox do
825
      for i := 0 to Items.Count - 1 do
826
        if Checked[i] then
827
        begin
828
          // an item is checked; get the plot data
829
          PlotData := TPlotDataObject(Items.Objects[i]).Data;
830
          PlotFunction(i);
831
        end;
832
  finally
833
    Screen.Cursor := crDefault;
834
    fxyParser.Destroy;
835
    PlotData := PD; // restor the current PlotData
836
  end;
837
end;
838

839
procedure TFormPlotStars.Formulate(const X, Y: Single; var z: Single;
840
  var Color: TGLColorVector; var texPoint: TTexPoint);
841
var
842
  e: byte;
843
  MaxZ, MinZ: TGLFloat;
844
  x1, x2, y1, y2, z1, z2: extended;
845

846
begin
847
  case AddedData.AddedAs of
848
    AddNone: // no AddedData to plot; just plot the PlotData
849
      begin
850
        z := ParseEvaluateFxy(X, Y, PlotData.fxyStr, e);
851
        z := z * ViewData.xyGrid.zScale;
852
        with PlotData do
853
        begin
854
          MaxZ := zMax * ViewData.xyGrid.zScale;
855
          MinZ := zMin * ViewData.xyGrid.zScale;
856
          if zCap then
857
          begin
858
            if zLim and (z > MaxZ) then
859
              z := MaxZ;
860
            if zLim and (z < MinZ) then
861
              z := MinZ;
862
          end
863
          else if zLim and ((z < MinZ) or (z > MaxZ)) then
864
            z := NaN;
865
          VectorLerp(LowerColor, UpperColor, z * ColorBlend - ColorMove, Color);
866
        end;
867
      end;
868

869
    AddDerivX: // this is for partial derivative wrt x
870
      begin
871
        x1 := X - AddedData.xInc;
872
        x2 := X + AddedData.xInc;
873
        z1 := ParseEvaluateFxy(x1, Y, SelectedData.fxyStr, e);
874
        // evaluate z1,x1,y
875
        z2 := ParseEvaluateFxy(x2, Y, SelectedData.fxyStr, e);
876
        // evaluate z2,x2,y
877
        z := (z2 - z1) / (x2 - x1); // z = slope wrt x axis
878
        z := z * ViewData.xyGrid.zScale;
879
        with AddedData do
880
        begin
881
          MaxZ := zMax * ViewData.xyGrid.zScale;
882
          MinZ := zMin * ViewData.xyGrid.zScale;
883
          if zCap then
884
          begin
885
            if zLim and (z > MaxZ) then
886
              z := MaxZ;
887
            if zLim and (z < MinZ) then
888
              z := MinZ;
889
          end
890
          else if zLim and ((z < MinZ) or (z > MaxZ)) then
891
            z := NaN;
892
          VectorLerp(LowerColor, UpperColor, z * ColorBlend - ColorMove, Color);
893
        end;
894
      end;
895

896
    AddDerivY: // this is for partial derivative wrt y
897
      begin
898
        y1 := Y - AddedData.yInc;
899
        y2 := Y + AddedData.yInc;
900
        z1 := ParseEvaluateFxy(X, y1, SelectedData.fxyStr, e);
901
        // evaluate z1,x,y1
902
        z2 := ParseEvaluateFxy(X, y2, SelectedData.fxyStr, e);
903
        // evaluate z2,x,y2
904
        z := (z2 - z1) / (y2 - y1); // z = slope wrt y axis
905
        z := z * ViewData.xyGrid.zScale;
906
        with AddedData do
907
        begin
908
          MaxZ := zMax * ViewData.xyGrid.zScale;
909
          MinZ := zMin * ViewData.xyGrid.zScale;
910
          if zCap then
911
          begin
912
            if zLim and (z > MaxZ) then
913
              z := MaxZ;
914
            if zLim and (z < MinZ) then
915
              z := MinZ;
916
          end
917
          else if zLim and ((z < MinZ) or (z > MaxZ)) then
918
            z := NaN;
919
          VectorLerp(LowerColor, UpperColor, z * ColorBlend - ColorMove, Color);
920
        end;
921
      end;
922

923
    AddVolume: // this is for double integral
924
      begin
925
        z := ParseEvaluateFxy(X, Y, PlotData.fxyStr, e);
926
        with AddedData do
927
        begin
928
          z := z * ViewData.xyGrid.zScale;
929
          MaxZ := zMax * ViewData.xyGrid.zScale;
930
          MinZ := zMin * ViewData.xyGrid.zScale;
931
          if zCap then
932
          begin
933
            if zLim and (z > MaxZ) then
934
              z := MaxZ;
935
            if zLim and (z < MinZ) then
936
              z := MinZ;
937
          end
938
          else if zLim and ((z < MinZ) or (z > MaxZ)) then
939
            z := NaN;
940
          VectorLerp(LowerColor, UpperColor, z * ColorBlend - ColorMove, Color);
941

942
          TGLLines.CreateAsChild(VolumeLines);
943
          with VolumeLines do
944
          begin
945
            with TGLLines(Children[Count - 1]) do
946
            begin
947
              LineColor.AsWinColor := AddLineColor;
948
              LineWidth := AddLineWidth;
949
              NodesAspect := LnaInvisible;
950

951
              Nodes.Add;
952
              Nodes[0].X := X; // start point
953
              Nodes[0].Y := Y;
954
              if zLim then
955
                Nodes[0].z := MinZ
956
              else
957
                Nodes[0].z := 0;
958

959
              Nodes.Add;
960
              Nodes[1].X := X; // end point
961
              Nodes[1].Y := Y;
962
              Nodes[1].z := z;
963
            end;
964
          end;
965
        end;
966
      end;
967
  end; // case AddedData.AddedAs of...
968
end;
969

970
procedure TFormPlotStars.PlotDerivativeField;
971
var
972
  i: Integer;
973
  FoundSelected: Boolean;
974

975
begin
976
  Screen.Cursor := crHourGlass;
977
  try
978
    i := 0;
979
    if FunctionsForm.CheckListBox.Count > 1 then // find Selected item
980
    begin
981
      FoundSelected := False;
982
      while not FoundSelected and (i < FunctionsForm.CheckListBox.Count) do
983
      begin
984
        FoundSelected := FunctionsForm.CheckListBox.Selected[i];
985
        if not FoundSelected then
986
          Inc(i);
987
      end;
988
    end;
989

990
    with FunctionsForm.CheckListBox do
991
      SelectedData := TPlotDataObject(Items.Objects[i]).Data;
992

993
    with AddedData do
994
    begin
995
      with TGLHeightField(AddedField.Children[0]) do
996
      begin
997
        with XSamplingScale do
998
        begin
999
          Step := xInc;
1000
          Min := xMin;
1001
          Max := xMax;
1002
        end;
1003

1004
        with YSamplingScale do
1005
        begin
1006
          Step := yInc;
1007
          Min := yMin;
1008
          Max := yMax;
1009
        end;
1010

1011
        case ViewMode of
1012
          vmAmbient:
1013
            ColorMode := hfcmAmbient;
1014
          vmAmbientandDiffuse:
1015
            ColorMode := hfcmAmbientAndDiffuse;
1016
          vmDiffuse:
1017
            ColorMode := hfcmDiffuse;
1018
          vmEmmision:
1019
            ColorMode := hfcmEmission;
1020
          vmNone:
1021
            ColorMode := hfcmNone;
1022
        end;
1023

1024
        case fxyMode of
1025
          fxyFill:
1026
            Material.PolygonMode := pmFill;
1027
          fxyLines:
1028
            Material.PolygonMode := pmLines;
1029
          fxyPoints:
1030
            Material.PolygonMode := pmPoints;
1031
        end;
1032
        OnGetHeight := Formulate;
1033
      end;
1034
      GLSViewer.Refresh; // needed to display each zField data in list
1035
    end;
1036
  finally
1037
    Screen.Cursor := crDefault;
1038
  end;
1039
end;
1040

1041
procedure TFormPlotStars.PlotIntegralField;
1042
  procedure PlotVolume;
1043
  begin // PlotVolume
1044
    with AddedData do
1045
    begin
1046
      with TGLHeightField(AddedField.Children[0]) do
1047
      begin
1048
        with XSamplingScale do
1049
        begin
1050
          Step := xInc;
1051
          Min := xMin;
1052
          Max := xMax;
1053
        end;
1054

1055
        with YSamplingScale do
1056
        begin
1057
          Step := yInc;
1058
          Min := yMin;
1059
          Max := yMax;
1060
        end;
1061

1062
        case ViewMode of
1063
          vmAmbient:
1064
            ColorMode := hfcmAmbient;
1065
          vmAmbientandDiffuse:
1066
            ColorMode := hfcmAmbientAndDiffuse;
1067
          vmDiffuse:
1068
            ColorMode := hfcmDiffuse;
1069
          vmEmmision:
1070
            ColorMode := hfcmEmission;
1071
          vmNone:
1072
            ColorMode := hfcmNone;
1073
        end;
1074

1075
        case fxyMode of
1076
          fxyFill:
1077
            Material.PolygonMode := pmFill;
1078
          fxyLines:
1079
            Material.PolygonMode := pmLines;
1080
          fxyPoints:
1081
            Material.PolygonMode := pmPoints;
1082
        end;
1083
        OnGetHeight := Formulate;
1084
      end;
1085
      GLSViewer.Refresh; // needed to display each zField data in list
1086
    end;
1087
  end; // PlotVolume
1088

1089
  procedure CalculateVolume;
1090
  var
1091
    e: byte;
1092
    i, j, iCount, jCount: Integer;
1093
    X, Y, z, x0, y0, a, VolPos, VolNeg: TGLFloat;
1094

1095
  begin // CalculateVolume
1096
    with AddedData do
1097
    begin
1098
      a := xInc * yInc; // base area
1099
      iCount := round((xMax - xMin) / xInc) - 1; // number of x points
1100
      jCount := round((yMax - yMin) / yInc) - 1; // number of y points
1101
      VolPos := 0;
1102
      VolNeg := 0;
1103
      x0 := xMin + xInc / 2; // base centre x0
1104
      y0 := yMin + yInc / 2; // base centre y0
1105
      for j := 0 to jCount do
1106
      begin
1107
        Y := y0 + j * yInc; // next column wrt y
1108
        for i := 0 to iCount do
1109
        begin
1110
          X := x0 + i * xInc; // next column wrt x
1111
          z := ParseEvaluateFxy(X, Y, PlotData.fxyStr, e);
1112

1113
          if zLim then // zLimit applied
1114
          begin
1115
            if (zMax >= 0) and (zMin <= 0) then // above and below zero
1116
            begin
1117
              if z > 0 then
1118
              begin
1119
                if z > zMax then
1120
                  VolPos := VolPos + a * zMax
1121
                else
1122
                  VolPos := VolPos + a * z;
1123
              end
1124
              else
1125
              begin
1126
                if z < zMin then
1127
                  VolNeg := VolNeg + a * zMin
1128
                else
1129
                  VolNeg := VolNeg + a * z;
1130
              end;
1131
            end
1132
            else if zMin > 0 then // both above zero
1133
            begin
1134
              if z >= zMin then
1135
              begin
1136
                if z > zMax then
1137
                  VolPos := VolPos + a * (zMax - zMin)
1138
                else
1139
                  VolPos := VolPos + a * (z - zMin);
1140
              end;
1141
            end
1142
            else if zMax < 0 then // both below zero
1143
            begin
1144
              if z <= zMax then
1145
              begin
1146
                if z < zMin then
1147
                  VolNeg := VolNeg + a * (zMax - zMin)
1148
                else
1149
                  VolNeg := VolNeg + a * (z - zMax);
1150
              end;
1151
            end;
1152
          end
1153
          else // no zLimit applied
1154
          begin
1155
            if z > 0 then
1156
              VolPos := VolPos + a * z
1157
            else
1158
              VolNeg := VolNeg + a * z;
1159
          end;
1160
        end;
1161
      end;
1162
    end;
1163

1164
    with DerivativesForm do
1165
    begin
1166
      PosVolLabel.Caption := '������������� �����: ' + FloatToStr(VolPos);
1167
      NegVolLabel.Caption := '������������� �����: ' + FloatToStr(VolNeg);
1168
      TotalLabel.Caption := '���������� �����: ' + FloatToStr(VolPos - VolNeg);
1169
      VolumeLabel.Caption := '������ �����: ' + FloatToStr(VolPos + VolNeg);
1170
    end;
1171
  end; // CalculateVolume
1172

1173
begin // TFormPlotStars.PlotIntegralField
1174
  Screen.Cursor := crHourGlass;
1175
  with AddedData do
1176
  begin
1177
    PlotVolume;
1178
    CalculateVolume;
1179
  end;
1180
  DerivativesForm.VolumeRB.Checked := False; //
1181
  Screen.Cursor := crDefault;
1182
end; // TFormPlotStars.PlotIntegralField
1183

1184
procedure TFormPlotStars.miPlotColoursClick(Sender: TObject);
1185
begin
1186
  PlotColorsForm.Show;
1187
end;
1188

1189
procedure TFormPlotStars.CreateHeightFields(const n: Integer);
1190
var
1191
  i: Integer;
1192

1193
begin
1194
  while Fields.Count > 0 do
1195
    TGLHeightField(Fields.Children[0]).Free;
1196
  for i := 0 to n - 1 do
1197
  begin
1198
    TGLHeightField.CreateAsChild(Fields);
1199
    TGLHeightField(Fields.Children[Fields.Count - 1]).Material.BlendingMode :=
1200
      bmTransparency;
1201
  end;
1202
end;
1203

1204
procedure TFormPlotStars.CreateAddedField;
1205
begin
1206
  ClearAddedField;
1207
  TGLHeightField.CreateAsChild(AddedField);
1208
  TGLHeightField(AddedField.Children[0]).Material.BlendingMode :=
1209
    bmTransparency;
1210
end;
1211

1212
procedure TFormPlotStars.UpdatePlot;
1213
begin
1214
  CreateHeightFields(FunctionsForm.CheckListBox.Count);
1215
  PlotFunctions;
1216
end;
1217

1218
procedure TFormPlotStars.UpdateAdded;
1219
begin
1220
  CreateAddedField;
1221
  AddXLine.LineColor.AsWinColor := AddedData.AddLineColor;
1222
  AddYLine.LineColor.AsWinColor := AddedData.AddLineColor;
1223
  AddZLine.LineColor.AsWinColor := AddedData.AddLineColor;
1224
  AddXLine.LineWidth := AddedData.AddLineWidth;
1225
  AddYLine.LineWidth := AddedData.AddLineWidth;
1226
  AddZLine.LineWidth := AddedData.AddLineWidth;
1227
  if AddedData.AddedAs = AddVolume then
1228
    PlotIntegralField
1229
  else
1230
    PlotDerivativeField;
1231
end;
1232

1233
procedure TFormPlotStars.miAboutClick(Sender: TObject);
1234
begin
1235
  with TFormAbout.Create(Self) do
1236
    try
1237
      ShowModal;
1238
    finally
1239
      Free;
1240
    end;
1241
end;
1242

1243
procedure TFormPlotStars.ClearAddedField;
1244
begin
1245
  with TGLHeightField(AddedField) do
1246
    if Count > 0 then
1247
      Children[0].Free;
1248
end;
1249

1250
procedure TFormPlotStars.ClearAddedLines;
1251
begin
1252
  Screen.Cursor := crHourGlass;
1253
  with TGLLines(VolumeLines) do
1254
    while Count > 0 do
1255
      Children[Count - 1].Free;
1256
  Screen.Cursor := crDefault;
1257
end;
1258

1259
end.
1260

Использование cookies

Мы используем файлы cookie в соответствии с Политикой конфиденциальности и Политикой использования cookies.

Нажимая кнопку «Принимаю», Вы даете АО «СберТех» согласие на обработку Ваших персональных данных в целях совершенствования нашего веб-сайта и Сервиса GitVerse, а также повышения удобства их использования.

Запретить использование cookies Вы можете самостоятельно в настройках Вашего браузера.