MathgeomGLS

Форк
0
/
fIntegrateX.pas 
461 строка · 11.6 Кб
1
unit fIntegrateX;
2

3
interface
4

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

22
type
23
  TIntegrateXForm = class(TForm)
24
    Label3: TLabel;
25
    Label1: TLabel;
26
    Label4: TLabel;
27
    MinIntegXLabel: TLabel;
28
    Label6: TLabel;
29
    ColorButton: TSpeedButton;
30
    Label5: TLabel;
31
    AreaLabel: TLabel;
32
    Label7: TLabel;
33
    PositiveButton: TSpeedButton;
34
    NegativeButton: TSpeedButton;
35
    MaxIntegXLabel: TLabel;
36
    NegAreaLabel: TLabel;
37
    PosAreaLabel: TLabel;
38
    MinIntegYLabel: TLabel;
39
    MaxIntegYLabel: TLabel;
40
    TotalAreaLabel: TLabel;
41
    CentreButton: TSpeedButton;
42
    EditIntegMin: TEdit;
43
    EditIntegMax: TEdit;
44
    EditCount: TEdit;
45
    UpDown1: TUpDown;
46
    RecalcBtn: TBitBtn;
47
    CloseBtn: TBitBtn;
48
    EditPenWidth: TEdit;
49
    UpDown2: TUpDown;
50
    EditConst: TEdit;
51
    IntegCheckBox: TCheckBox;
52
    ShadeCheckBox: TCheckBox;
53
    EditOpacity: TEdit;
54
    UpDown3: TUpDown;
55
    ColorDialog: TColorDialog;
56
    Label2: TLabel;
57
    KeepRangeCheckBox: TCheckBox;
58
    ColorPanel: TPanel;
59
    NegativePanel: TPanel;
60
    PositivePanel: TPanel;
61
    SumAreaLabel: TLabel;
62
    procedure FormShow(Sender: TObject);
63
    procedure FormActivate(Sender: TObject);
64
    procedure FormKeyPress(Sender: TObject; var Key: Char);
65
    procedure FormDeactivate(Sender: TObject);
66

67
    procedure ParseKeyPress(Sender: TObject; var Key: Char);
68
    procedure IntKeyPress(Sender: TObject; var Key: Char);
69
    procedure EditIntegMinKeyUp(Sender: TObject; var Key: Word;
70
                                 Shift: TShiftState);
71
    procedure EditIntegMaxKeyUp(Sender: TObject; var Key: Word;
72
                                 Shift: TShiftState);
73
    procedure EditCountKeyUp(Sender: TObject; var Key: Word;
74
                              Shift: TShiftState);
75
    procedure EditConstKeyUp(Sender: TObject; var Key: Word;
76
                              Shift: TShiftState);
77
    procedure EditPenWidthKeyUp(Sender: TObject; var Key: Word;
78
                                 Shift: TShiftState);
79
    procedure EditOpacityKeyUp(Sender: TObject; var Key: Word;
80
                                Shift: TShiftState);
81
    procedure EditCountExit(Sender: TObject);
82

83
    procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);
84
    procedure UpDown2Click(Sender: TObject; Button: TUDBtnType);
85
    procedure UpDown3Click(Sender: TObject; Button: TUDBtnType);
86
    procedure UpDown1MouseUp(Sender: TObject; Button: TMouseButton;
87
                              Shift: TShiftState; X, Y: Integer);
88

89
    procedure CheckBoxClick(Sender: TObject);
90
    procedure CentreButtonClick(Sender: TObject);
91
    procedure ColorButtonClick(Sender: TObject);
92
    procedure PositiveButtonClick(Sender: TObject);
93
    procedure NegativeButtonClick(Sender: TObject);
94
    procedure RecalcBtnClick(Sender: TObject);
95
    procedure CloseBtnClick(Sender: TObject);
96
    procedure IntegLabelClick(Sender: TObject);
97
    procedure KeepRangeCheckBoxClick(Sender: TObject);
98
  private
99
     
100
    procedure UpdateRangeData;
101
  public
102
     
103
    PlotIntegrated: byte; { piCalc = 0; piShow = 1; piArea = 2; piBoth = 3 }
104
    procedure ShowData;
105
  end;
106

107
var
108
  IntegrateXForm: TIntegrateXForm;
109

110
//======================================================================
111
implementation
112
//======================================================================
113

114
uses
115
  uParser,
116
  uGlobal,
117
  fFuncts,
118
  fPlot1D,
119
  Clipbrd;
120

121
{$R *.dfm}
122

123
procedure TIntegrateXForm.FormShow(Sender: TObject);
124
begin
125
  KeepRangeCheckBox.Checked := KeepRange;
126
  ShowData;
127
end;
128

129
procedure TIntegrateXForm.FormActivate(Sender: TObject);
130
begin
131
  EditIntegMin.SetFocus;
132
  EditIntegMin.SelText;
133
end;
134

135
procedure TIntegrateXForm.FormKeyPress(Sender: TObject; var Key: Char);
136
begin
137
  case Key of
138
#13:begin
139
      RecalcBtnClick(Sender);
140
      Key := #0;
141
    end;
142
#27:begin
143
      Key := #0;
144
      Close;
145
    end;
146
  end;
147
end;
148

149
procedure TIntegrateXForm.FormDeactivate(Sender: TObject);
150
begin
151
  if KeepRange then UpdateRangeData;
152
end;
153

154
procedure TIntegrateXForm.ParseKeyPress(Sender: TObject; var Key: Char);
155
begin
156
  with Sender as TEdit do
157
  begin
158
    if not CharInSet(UpCase(Key),
159
   [' ', '!', '(', ')', '*', '+', '-', '.', ',', '/', '0'..'9',
160
    'A'..'C', 'E', 'G'..'I', 'L', 'N'..'T', 'X', '^', '`', #8]) then
161
    begin
162
      Key := #0;
163
      Exit;
164
    end;
165
    if Key = '`' then Key := '�';
166
  end;
167
end;
168

169
procedure TIntegrateXForm.IntKeyPress(Sender: TObject; var Key: Char);
170
begin
171
  with Sender as TEdit do
172
  if not CharInSet(Key, ['0'..'9', #8]) then Key := #0
173
end;
174

175
procedure TIntegrateXForm.EditIntegMinKeyUp(Sender: TObject; var Key: Word;
176
                                             Shift: TShiftState);
177
var
178
  s: string;
179
  e: byte;
180

181
begin
182
  s := ScanText(EditIntegMin.Text);
183
  IntegMin := ParseAndEvaluate(s, e);
184
//if isNAN(IntegMin) then IntegMin := 0;
185
//if e > 0 then IntegMin := 0;
186
  if isNAN(IntegMin) or isInfinite(IntegMin) or (e > 0) then IntegMin := 0;
187
end;
188

189
procedure TIntegrateXForm.EditIntegMaxKeyUp(Sender: TObject; var Key: Word;
190
                                             Shift: TShiftState);
191
var
192
  s: string;
193
  e: byte;
194

195
begin
196
  s := ScanText(EditIntegMax.Text);
197
  IntegMax := ParseAndEvaluate(s, e);
198
//  if isNAN(IntegMax) then IntegMax := 0;
199
//  if e > 0 then IntegMax := 0;
200
  if isNAN(IntegMax) or isInfinite(IntegMax) or (e > 0) then IntegMax := 0;
201
end;
202

203
procedure TIntegrateXForm.EditCountKeyUp(Sender: TObject; var Key: Word;
204
                                          Shift: TShiftState);
205
begin
206
  with GraphData do
207
  begin
208
    try
209
      IntegCount := StrToInt(EditCount.Text);
210
      if IntegCount = 0 then IntegCount := IntegCountPos;
211
    except
212
      IntegCount := IntegCountPos;
213
    end;
214
    if IntegCount > IntegCountMax then IntegCount := IntegCountMax;
215
  end;
216
  Altered := true;
217
end;
218

219
procedure TIntegrateXForm.EditConstKeyUp(Sender: TObject; var Key: Word;
220
                                          Shift: TShiftState);
221
begin
222
  try
223
    IntegConst := StrToFloat(EditConst.Text);
224
  except
225
    IntegConst := 0;
226
  end;
227
end;
228

229
procedure TIntegrateXForm.EditPenWidthKeyUp(Sender: TObject; var Key: Word;
230
                                             Shift: TShiftState);
231
begin
232
  try
233
    GraphData.ydxWidth := StrToInt(EditPenWidth.Text);
234
    if Graphdata.ydxWidth = 0 then GraphData.ydxWidth := 1;
235
  except
236
    GraphData.ydxWidth := 1;
237
  end;
238
  Altered := true;
239
  MainForm.GLViewer.Invalidate;
240
end;
241

242
procedure TIntegrateXForm.EditOpacityKeyUp(Sender: TObject; var Key: Word;
243
                                            Shift: TShiftState);
244
var
245
  n: integer;
246

247
begin
248
  try
249
    n := StrToInt(EditOpacity.Text);
250
  except
251
    n := 1;
252
  end;
253
  GraphData.AreaAlpha := n/100;
254
  Altered := true;
255
  MainForm.GLViewer.Invalidate;
256
end;
257

258
procedure TIntegrateXForm.EditCountExit(Sender: TObject);
259
begin
260
  EditCount.Text := IntToStr(GraphData.IntegCount);
261
end;
262

263
procedure TIntegrateXForm.UpDown1Click(Sender: TObject; Button: TUDBtnType);
264
var
265
  k: word;
266

267
begin
268
  k := 0;
269
  EditCountKeyUp(Sender, k, []);
270
end;
271

272
procedure TIntegrateXForm.UpDown2Click(Sender: TObject; Button: TUDBtnType);
273
var
274
  k: word;
275

276
begin
277
  k := 0;
278
  EditPenWidthKeyUp(Sender, k, []);
279
end;
280

281
procedure TIntegrateXForm.UpDown3Click(Sender: TObject; Button: TUDBtnType);
282
var
283
  k: word;
284

285
begin
286
  k := 0;
287
  EditOpacityKeyUp(Sender, k, []);
288
end;
289

290
procedure TIntegrateXForm.UpDown1MouseUp(Sender: TObject; Button: TMouseButton;
291
                                          Shift: TShiftState; X, Y: Integer);
292
begin
293
  RecalcBtnClick(Sender);
294
end;
295

296
procedure TIntegrateXForm.CheckBoxClick(Sender: TObject);
297
begin
298
  with Sender as TCheckBox do
299
  if Checked then
300
  begin  { tag = piShow for IntegCheckBox; piArea for ShadeCheckBox }
301
    if not Ord(PlotIntegrated) and Tag = Tag
302
    then Inc(PlotIntegrated, Tag);  { now selected }
303
  end
304
  else
305
  if Ord(PlotIntegrated) and Tag = Tag
306
  then Dec(PlotIntegrated, Tag);  { now de-selected }
307
  RecalcBtnClick(Sender);
308
end;
309

310
procedure TIntegrateXForm.CentreButtonClick(Sender: TObject);
311
var
312
  y1, y2: extended;
313

314
begin
315
  y1 := StrToFloat(Copy(MinIntegYLabel.Caption,
316
                   pos('=', MinIntegYLabel.Caption)+2,
317
                     Length(MinIntegYLabel.Caption)));
318
  y2 := StrToFloat(Copy(MaxIntegYLabel.Caption,
319
                   pos('=', MaxIntegYLabel.Caption)+2,
320
                     Length(MaxIntegYLabel.Caption)));
321
  IntegConst := IntegConst-(y1 + y2)/2;
322
  EditConst.Text := FloatToStr(IntegConst);
323
  RecalcBtnclick(Sender);
324
end;
325

326
procedure TIntegrateXForm.ColorButtonClick(Sender: TObject);
327
begin
328
  ColorDialog.Color := GraphData.ydxColor;
329
  if ColorDialog.Execute then
330
  begin
331
    GraphData.ydxColor := ColorDialog.Color;
332
    ColorPanel.Color := GraphData.ydxColor;
333
    MainForm.GLViewer.Invalidate;
334
    Altered := TRUE
335
  end;
336
end;
337

338
procedure TIntegrateXForm.PositiveButtonClick(Sender: TObject);
339
begin
340
  ColorDialog.Color := GraphData.PosAreaColor;
341
  if ColorDialog.Execute then
342
  begin
343
    GraphData.PosAreaColor := ColorDialog.Color;
344
    PositivePanel.Color := GraphData.PosAreaColor;
345
    MainForm.GLViewer.Invalidate;
346
    Altered := TRUE
347
  end;
348
end;
349

350
procedure TIntegrateXForm.NegativeButtonClick(Sender: TObject);
351
begin
352
  ColorDialog.Color := GraphData.NegAreaColor;
353
  if ColorDialog.Execute then
354
  begin
355
    GraphData.NegAreaColor := ColorDialog.Color;
356
    NegativePanel.Color := GraphData.NegAreaColor;
357
    MainForm.GLViewer.Invalidate;
358
    Altered := TRUE
359
  end;
360
end;
361

362
procedure TIntegrateXForm.RecalcBtnClick(Sender: TObject);
363
begin
364
  MainForm.GLViewer.Invalidate;
365
end;
366

367
procedure TIntegrateXForm.IntegLabelClick(Sender: TObject);
368
begin
369
  Clipboard.Clear;
370
  with Sender as TLabel do
371
  Clipboard.AsText := Copy(Caption,  pos('=', Caption)+2, Length(Caption));
372
end;
373

374
procedure TIntegrateXForm.KeepRangeCheckBoxClick(Sender: TObject);
375
begin
376
  KeepRange := KeepRangeCheckBox.Checked;
377
end;
378

379
procedure TIntegrateXForm.CloseBtnClick(Sender: TObject);
380
begin
381
  Close;
382
end;
383

384
procedure TIntegrateXForm.UpdateRangeData;
385
begin
386
  KeptMin := IntegMin;
387
  KeptMax := IntegMax;
388
end;
389

390
procedure TIntegrateXForm.ShowData;
391
begin
392
  with GraphData, PlotData do
393
  begin
394
    EditCount.Text := IntToStr(IntegCount);
395
    UpDown2.Position := ydxWidth;
396
    UpDown3.Position := round(AreaAlpha*100);
397
    KeepRangeCheckBox.Checked := KeepRange;
398
    ColorPanel.Color := ydxColor;
399
    PositivePanel.Color := PosAreaColor;
400
    NegativePanel.Color := NegAreaColor;
401

402
    if PlotAsFx then
403
    begin
404
      if TextStr = '' then Caption := '' else Caption := 'y = '+TextStr;
405
      if IsSegment then
406
      begin
407
        if KeepRange then
408
        begin
409
          IntegMin := KeptMin;
410
          IntegMax := KeptMax;
411
        end
412
        else
413
        begin
414
          IntegMin := SegMin;
415
          IntegMax := SegMax;
416
        end;
417
      end
418
      else
419
      begin
420
        if KeepRange then
421
        begin
422
          IntegMin := KeptMin;
423
          IntegMax := KeptMax;
424
        end
425
        else
426
        begin
427
          IntegMin := xMin;
428
          IntegMax := xMax;
429
        end;
430
      end;
431

432
      Label1.Caption := 'where  a = x1';
433
      Label2.Caption := 'and  b = x2';
434
      Label5.Caption := 'Integral y at a = x1:';
435
      CentreButton.Caption := 'Centre to x a&xis';
436
    end
437
    else
438
    begin
439
      Caption := 'r = '+TextStr;
440
      if KeepRange then
441
      begin
442
        IntegMin := KeptMin;
443
        IntegMax := KeptMax;
444
      end
445
      else
446
      begin
447
        IntegMin := SegMin;
448
        IntegMax := SegMax;
449
      end;
450
      Label1.Caption := 'For a = �1';
451
      Label2.Caption := 'b = �2  (radians)';
452
      Label5.Caption := 'Integral r at (a = �1):';
453
      CentreButton.Caption := 'Centre to x a&xis';
454
    end;
455
  end;
456
  EditIntegMin.Text := FloatToStrF(IntegMin, ffGeneral, 13, 4);
457
  EditIntegMax.Text := FloatToStrF(IntegMax, ffGeneral, 13, 4);
458
  EditConst.Text := FloatToStrF(IntegConst, ffGeneral, 13, 4);
459
end;
460

461
end.
462

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

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

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

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