MathgeomGLS

1
unit fVolumeX;
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.Clipbrd,
13
  Vcl.Graphics,
14
  Vcl.Controls,
15
  Vcl.Forms,
16
  Vcl.Dialogs,
17
  Vcl.Menus,
18
  Vcl.StdCtrls,
19
  Vcl.Buttons,
20
  Vcl.ComCtrls,
21
  Vcl.ExtCtrls;
22

23
type
24
  TVolumeXForm = class(TForm)
25
    Label3: TLabel;
26
    Label4: TLabel;
27
    Label5: TLabel;
28
    Label6: TLabel;
29
    Label1: TLabel;
30
    Label2: TLabel;
31
    Label7: TLabel;
32
    Label8: TLabel;
33
    PositiveButton: TSpeedButton;
34
    NegativeButton: TSpeedButton;
35
    TotalVolumeLabel: TLabel;
36
    EditIntegMin: TEdit;
37
    EditIntegMax: TEdit;
38
    EditCount: TEdit;
39
    UpDown1: TUpDown;
40
    EditOpacity: TEdit;
41
    UpDown2: TUpDown;
42
    RecalcBtn: TBitBtn;
43
    CloseBtn: TBitBtn;
44
    KeepRangeCheckBox: TCheckBox;
45
    ColorDialog: TColorDialog;
46
    HideFunctionCheckBox: TCheckBox;
47
    PositivePanel: TPanel;
48
    NegativePanel: TPanel;
49
    SurfaceAreaLabel: TLabel;
50
    procedure FormShow(Sender: TObject);
51
    procedure FormActivate(Sender: TObject);
52
    procedure FormKeyPress(Sender: TObject; var Key: Char);
53
    procedure FormDeactivate(Sender: TObject);
54
    procedure ParseKeyPress(Sender: TObject; var Key: Char);
55
    procedure IntKeyPress(Sender: TObject; var Key: Char);
56
    procedure EditIntegMinKeyUp(Sender: TObject; var Key: Word;
57
                                 Shift: TShiftState);
58
    procedure EditIntegMaxKeyUp(Sender: TObject; var Key: Word;
59
                                 Shift: TShiftState);
60
    procedure EditCountKeyUp(Sender: TObject; var Key: Word;
61
                              Shift: TShiftState);
62
    procedure EditOpacityKeyUp(Sender: TObject; var Key: Word;
63
                                Shift: TShiftState);
64
    procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);
65
    procedure UpDown2Click(Sender: TObject; Button: TUDBtnType);
66
    procedure UpDown1MouseUp(Sender: TObject; Button: TMouseButton;
67
                              Shift: TShiftState; X, Y: Integer);
68
    procedure PositiveButtonClick(Sender: TObject);
69
    procedure NegativeButtonClick(Sender: TObject);
70
    procedure RecalcBtnClick(Sender: TObject);
71
    procedure IntegLabelClick(Sender: TObject);
72
    procedure KeepRangeCheckBoxClick(Sender: TObject);
73
    procedure CloseBtnClick(Sender: TObject);
74
    procedure HideFunctionCheckBoxClick(Sender: TObject);
75
  private
76
     
77
    procedure UpdateRangeData;
78
  public
79
     
80
    procedure ShowData;
81
  end;
82

83
var
84
  VolumeXForm: TVolumeXForm;
85

86
//===============================================================
87
implementation
88
//===============================================================
89

90
uses
91
  uParser,
92
  uGlobal,
93
  fFuncts,
94
  fPlot1D;
95

96
{$R *.dfm}
97

98
procedure TVolumeXForm.FormShow(Sender: TObject);
99
begin
100
  KeepRangeCheckBox.Checked := KeepRange;
101
  ShowData;
102
end;
103

104
procedure TVolumeXForm.HideFunctionCheckBoxClick(Sender: TObject);
105
begin
106
  MainForm.GLViewer.Invalidate;
107
end;
108

109
procedure TVolumeXForm.FormActivate(Sender: TObject);
110
begin
111
  EditIntegMin.SetFocus;
112
  EditIntegMin.SelText;
113
end;
114

115
procedure TVolumeXForm.FormKeyPress(Sender: TObject; var Key: Char);
116
begin
117
  case Key of
118
#13:begin
119
      RecalcBtnClick(Sender);
120
      Key := #0;
121
    end;
122
#27:begin
123
      Key := #0;
124
      Close;
125
    end;
126
  end;
127
end;
128

129
procedure TVolumeXForm.FormDeactivate(Sender: TObject);
130
begin
131
  if KeepRange then UpdateRangeData;
132
end;
133

134
procedure TVolumeXForm.ParseKeyPress(Sender: TObject; var Key: Char);
135
begin
136
  with Sender as TEdit do
137
  begin
138
    if not CharInSet(UpCase(Key),
139
   [' ', '!', '(', ')', '*', '+', '-', '.', ',', '/', '0'..'9',
140
    'A'..'C', 'E', 'G'..'I', 'L', 'N'..'T', 'X', '^', '`', #8]) then
141
    begin
142
      Key := #0;
143
      Exit;
144
    end;
145
    if Key = '`' then Key := '�';
146
  end;
147
end;
148

149
procedure TVolumeXForm.RecalcBtnClick(Sender: TObject);
150
begin
151
  MainForm.GLViewer.Invalidate;
152
end;
153

154
procedure TVolumeXForm.IntegLabelClick(Sender: TObject);
155
begin
156
  Clipboard.Clear;
157
  with Sender as TLabel do
158
  Clipboard.AsText := Copy(Caption,  pos('=', Caption)+2, Length(Caption));
159
end;
160

161
procedure TVolumeXForm.IntKeyPress(Sender: TObject; var Key: Char);
162
begin
163
  with Sender as TEdit do
164
  if not CharInSet(Key, ['0'..'9', #8]) then Key := #0
165
end;
166

167
procedure TVolumeXForm.KeepRangeCheckBoxClick(Sender: TObject);
168
begin
169
  KeepRange := KeepRangeCheckBox.Checked;
170
end;
171

172
procedure TVolumeXForm.NegativeButtonClick(Sender: TObject);
173
begin
174
  ColorDialog.Color := GraphData.NegAreaColor;
175
  if ColorDialog.Execute then
176
  begin
177
    GraphData.NegAreaColor := ColorDialog.Color;
178
    NegativePanel.Color := GraphData.NegAreaColor;
179
    MainForm.GLViewer.Invalidate;
180
    Altered := TRUE
181
  end;
182
end;
183

184
procedure TVolumeXForm.PositiveButtonClick(Sender: TObject);
185
begin
186
  ColorDialog.Color := GraphData.PosAreaColor;
187
  if ColorDialog.Execute then
188
  begin
189
    GraphData.PosAreaColor := ColorDialog.Color;
190
    PositivePanel.Color := GraphData.PosAreaColor;
191
    MainForm.GLViewer.Invalidate;
192
    Altered := TRUE
193
  end;
194
end;
195

196
procedure TVolumeXForm.UpDown1Click(Sender: TObject; Button: TUDBtnType);
197
var
198
  k: word;
199

200
begin
201
  k := 0;
202
  EditCountKeyUp(Sender, k, []);
203
end;
204

205
procedure TVolumeXForm.UpDown1MouseUp(Sender: TObject; Button: TMouseButton;
206
                                       Shift: TShiftState; X, Y: Integer);
207
begin
208
  RecalcBtnClick(Sender);
209
end;
210

211
procedure TVolumeXForm.UpDown2Click(Sender: TObject; Button: TUDBtnType);
212
var
213
  k: word;
214

215
begin
216
  k := 0;
217
  EditOpacityKeyUp(Sender, k, []);
218
end;
219

220
procedure TVolumeXForm.EditIntegMinKeyUp(Sender: TObject; var Key: Word;
221
                                         Shift: TShiftState);
222
var
223
  s: string;
224
  e: byte;
225

226
begin
227
  s := ScanText(EditIntegMin.Text);
228
  IntegMin := ParseAndEvaluate(s, e);
229
//  if isNAN(IntegMin) then IntegMin := 0;
230
//  if e > 0 then IntegMin := 0;
231
  if isNAN(IntegMin) or isInfinite(IntegMin) or (e > 0) then IntegMin := 0;
232
end;
233

234
procedure TVolumeXForm.EditIntegMaxKeyUp(Sender: TObject; var Key: Word;
235
                                         Shift: TShiftState);
236
var
237
  s: string;
238
  e: byte;
239

240
begin
241
  s := ScanText(EditIntegMax.Text);
242
  IntegMax := ParseAndEvaluate(s, e);
243
//if isNAN(IntegMax) then IntegMax := 0;
244
//if e > 0 then IntegMax := 0;
245
  if isNAN(IntegMax) or isInfinite(IntegMax) or (e > 0) then IntegMax := 0;
246
end;
247

248
procedure TVolumeXForm.CloseBtnClick(Sender: TObject);
249
begin
250
  Close;
251
end;
252

253
procedure TVolumeXForm.EditCountKeyUp(Sender: TObject; var Key: Word;
254
                                      Shift: TShiftState);
255
begin
256
  with GraphData do
257
  begin
258
    try
259
      IntegCount := StrToInt(EditCount.Text);
260
      if IntegCount = 0 then IntegCount := IntegCountPos;
261
    except
262
      IntegCount := IntegCountPos;
263
    end;
264
    if IntegCount > IntegCountMax then IntegCount := IntegCountMax;
265
  end;
266
  Altered := true;
267
end;
268

269
procedure TVolumeXForm.EditOpacityKeyUp(Sender: TObject; var Key: Word;
270
                                        Shift: TShiftState);
271
var
272
  n: integer;
273

274
begin
275
  try
276
    n := StrToInt(EditOpacity.Text);
277
  except
278
    n := 1;
279
  end;
280
  GraphData.AreaAlpha := n/100;
281
  Altered := true;
282
  MainForm.GLViewer.Invalidate;
283
end;
284

285
procedure TVolumeXForm.UpdateRangeData;
286
begin
287
  KeptMin := IntegMin;
288
  KeptMax := IntegMax;
289
end;
290

291
procedure TVolumeXForm.ShowData;
292
begin
293
  with GraphData, PlotData do
294
  begin
295
    EditCount.Text := IntToStr(IntegCount);
296
    UpDown2.Position := round(AreaAlpha*100);
297
    if TextStr = '' then Caption := '' else Caption := 'y = '+TextStr;
298

299
    KeepRangeCheckBox.Checked := KeepRange;
300
    PositivePanel.Color := PosAreaColor;
301
    NegativePanel.Color := NegAreaColor;
302

303
    if IsSegment then
304
    begin
305
      if KeepRange then
306
      begin
307
        IntegMin := KeptMin;
308
        IntegMax := KeptMax;
309
      end
310
      else
311
      begin
312
        IntegMin := SegMin;
313
        IntegMax := SegMax;
314
      end;
315
    end
316
    else
317
    begin
318
      if KeepRange then
319
      begin
320
        IntegMin := KeptMin;
321
        IntegMax := KeptMax;
322
      end
323
      else
324
      begin
325
        IntegMin := xMin;
326
        IntegMax := xMax;
327
      end;
328
    end;
329
  end;
330
  EditIntegMin.Text := FloatToStrF(IntegMin, ffGeneral, 13, 4);
331
  EditIntegMax.Text := FloatToStrF(IntegMax, ffGeneral, 13, 4);
332
end;
333

334
end.
335