MathgeomGLS

Форк
0
346 строк · 8.3 Кб
1
unit faStyle;
2

3
interface
4

5
uses
6
  Winapi.Windows,
7
  Winapi.Messages,
8
  System.SysUtils,
9
  System.UITypes,
10
  System.Variants,
11
  System.Classes,
12
  Vcl.Graphics,
13
  Vcl.Controls,
14
  Vcl.Forms,
15
  Vcl.Dialogs,
16
  Vcl.StdCtrls,
17
  Vcl.Buttons,
18

19
  Graf.Global1d;
20

21
type
22
  TStyleNameForm = class(TForm)
23
    BitBtn1: TBitBtn;
24
    StyleListBox: TListBox;
25
    EditName: TEdit;
26
    procedure FormShow(Sender: TObject);
27
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
28
    procedure EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
29
    procedure EditKeyPress(Sender: TObject; var Key: Char);
30
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
31
    procedure StyleListBoxDblClick(Sender: TObject);
32
  private
33
    StyleAltered: Boolean;
34
    procedure SaveToFile;
35
  public
36
    Selecting: Boolean;
37
     
38
  end;
39

40
var
41
  StyleNameForm: TStyleNameForm;
42

43
//====================================================================
44
implementation
45
//====================================================================
46

47
uses
48
  faGraf1D,
49
  faFunc1d,
50
  faNumeric;
51

52
{$R *.dfm}
53

54
procedure TStyleNameForm.FormShow(Sender: TObject);
55
  procedure ReadStyles;
56
  var
57
    F: File of TPlotStyle;
58
    s: TPlotStyle;
59
    so: TPlotStyleObject;
60

61
  begin
62
    AssignFile(F, StyleFName);
63
    Reset(F);
64
    while not Eof(F) do
65
    begin
66
      Read(F, s);
67
      so := TPlotStyleObject.Create(s);
68
      StyleListBox.Items.AddObject(String(s.StyleName), so);
69
    end;
70
    CloseFile(F);
71
  end;
72

73
begin
74
  if Selecting then
75
  begin
76
    StyleListBox.Enabled := true;
77
    StyleListBox.ItemIndex := -1;
78
    EditName.Visible := false;
79
    Caption := '   Select a style';
80
    BitBtn1.Hint := 'OK to apply selected style.';
81
    StyleListBox.Hint := 'Press Del to delete an item.';
82
    Hint := 'Press escape to deselect style.'
83
  end
84
  else
85
  begin
86
    StyleListBox.Enabled := false;
87
    EditName.Visible := true;
88
    Caption := '   Save a style as...';
89
    BitBtn1.Hint := 'OK to add the current graph style.';
90
    StyleListBox.Hint := '';
91
    Hint := '';
92
  end;
93
  StyleAltered := false;
94

95
  if FileExists(StyleFName) then ReadStyles;
96
  StyleListBox.ItemIndex := -1;
97

98
  with Layout do
99
  begin
100
    if Left = 0 then
101
    begin
102
      Left := (Screen.Width - Width) div 2;
103
      Top := (Screen.Height - Height) div 2;
104
    end
105
    else
106
    begin
107
      Left := StyleLeft;
108
      Top := StyleTop;
109
    end;
110
  end;
111
end;
112

113
procedure TStyleNameForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
114
  procedure ApplyStyle;
115
  var
116
    s: TPlotStyle;
117
    so: TPlotStyleObject;
118
    i: integer;
119

120
  begin
121
    if StyleListbox.ItemIndex = -1 then exit;
122
    so := TPlotStyleObject(StyleListBox.Items.Objects[StyleListBox.ItemIndex]);
123
    s := so.Style;
124
    with GraphData do
125
    begin
126
      AreaAlpha := s.AreaAlpha;
127
      FontName := String(s.FontName);
128
      FontStyle := s.FontStyle;
129
      FontSize := s.FontSize;
130
      AxisWidth := s.AxisWidth;
131
      xMinorGrad := s.xMinorGrad;
132
      yMinorGrad := s.yMinorGrad;
133
      xMajorGrad := s.xMajorGrad;
134
      yMajorGrad := s.yMajorGrad;
135
      MinorWidth := s.MinorWidth;
136
      MajorWidth := s.MajorWidth;
137
      CoordWidth := s.CoordWidth;
138
      dydxWidth := s.dydxWidth;
139
      d2ydx2Width := s.d2ydx2Width;
140
      IntegCount := s.IntegCount;
141
      ydxWidth := s.ydxWidth;
142

143
      BackColor := s.BackColor;
144
      GridColor := s.GridColor;
145
      xAxisColor := s.xAxisColor;
146
      yAxisColor := s.yAxisColor;
147
      CoordColor := s.CoordColor;
148
      dydxColor := s.dydxColor;
149
      d2ydx2Color := s.d2ydx2Color;
150
      ydxColor := s.ydxColor;
151
      PosAreaColor := s.PosAreaColor;
152
      NegAreaColor := s.NegAreaColor;
153
      Grid := s.Grid;
154
      with FunctionsForm.CheckListBox do
155
      begin
156
        for i := 0 to Count -1 do
157
        with TPlotDataObject(Items.Objects[i]).Data do
158
        begin
159
          PlotWidth := s.Pens[i mod 12].PenWidth;
160
          PlotColor := s.Pens[i mod 12].PenColor;
161
        end;
162
      end;
163

164
      with NumericForm.CheckListBox do
165
      begin
166
        for i := 0 to Count -1 do
167
        with TNumericObject(Items.Objects[i]).Data do
168
        begin
169
          PlotWidth := s.NumLines[i mod 12].PenWidth;
170
          PlotColor := s.NumLines[i mod 12].PenColor;
171
          PointSize := s.NumPoints[i mod 12].PenWidth;
172
          PointColor := s.NumPoints[i mod 12].PenColor;
173
        end;
174
      end;
175
    end;
176
    MainForm.GLViewer.Buffer.BackgroundColor := GraphData.BackColor;
177
  end;    { ApplyStyle }
178

179
  function UniqueName(s: string): Boolean;
180
  var
181
    i: integer;
182
    Found: Boolean;
183

184
  begin
185
    i := 0;
186
    Found := false;
187
    while not Found and (i < StyleListBox.Items.Count) do
188
    begin
189
      Found := LowerCase(s) = LowerCase(StyleListBox.Items[i]);
190
      Inc(i);
191
    end;
192
    Result := not Found;
193
  end;   { UniqueName }
194

195
  procedure AddToList;
196
  var
197
    s: TPlotStyle;
198
    so: TPlotStyleObject;
199
    i: integer;
200

201
  begin
202
    with GraphData do
203
    begin
204
      s.AreaAlpha := AreaAlpha;
205
      s.FontName := ShortString(FontName);
206
      s.StyleName := ShortString(EditName.Text);
207
      s.FontStyle := FontStyle;
208
      s.FontSize := FontSize;
209
      s.AxisWidth := AxisWidth;
210
      s.xMinorGrad := xMinorGrad;
211
      s.yMinorGrad := yMinorGrad;
212
      s.xMajorGrad := xMajorGrad;
213
      s.yMajorGrad := yMajorGrad;
214
      s.MinorWidth := MinorWidth;
215
      s.MajorWidth := MajorWidth;
216
      s.CoordWidth := CoordWidth;
217
      s.dydxWidth := dydxWidth;
218
      s.d2ydx2Width := d2ydx2Width;
219
      s.IntegCount := IntegCount;
220
      s.ydxWidth := ydxWidth;
221

222
      s.BackColor := BackColor;
223
      s.GridColor := GridColor;
224
      s.xAxisColor := xAxisColor;
225
      s.yAxisColor := yAxisColor;
226
      s.CoordColor := CoordColor;
227
      s.dydxColor := dydxColor;
228
      s.d2ydx2Color := d2ydx2Color;
229
      s.ydxColor := ydxColor;
230
      s.PosAreaColor := PosAreaColor;
231
      s.NegAreaColor := NegAreaColor;
232

233
      s.Grid := Grid;
234

235
      for i := 0 to 11 do
236
      begin
237
        s.Pens[i].PenWidth := 1;
238
        s.Pens[i].PenColor := clBlack;
239
      end;
240

241
      with FunctionsForm.CheckListBox do
242
      begin
243
        for i := 0 to Count -1 do
244
        with TPlotDataObject(Items.Objects[i]).Data do
245
        begin
246
          s.Pens[i mod 12].PenWidth := PlotWidth;
247
          s.Pens[i mod 12].PenColor := PlotColor;
248
        end;
249
      end;
250

251
      with NumericForm.CheckListBox do
252
      begin
253
        for i := 0 to Count -1 do
254
        with TNumericObject(Items.Objects[i]).Data do
255
        begin
256
          s.NumLines[i mod 12].PenWidth := PlotWidth;
257
          s.NumLines[i mod 12].PenColor := PlotColor;
258
          s.NumPoints[i mod 12].PenWidth := PointSize;
259
          s.NumPoints[i mod 12].PenColor := PointColor;
260
        end;
261
      end;
262
    end;
263
    so := TPlotStyleObject.Create(s);
264
    StyleListBox.Items.AddObject(EditName.Text, so);
265
    SaveToFile;
266
  end;    { AddToList }
267

268
var
269
  i: integer;
270

271
begin
272
  if Selecting then ApplyStyle
273
  else if StyleAltered then
274
  begin
275
    EditName.Text := Trim(EditName.Text);
276
    if EditName.Text <> '' then
277
    begin
278
      if UniqueName(EditName.Text) then AddToList
279
      else
280
      begin
281
        MessageDlg('The Style Name entered is not unique.', mtError, [mbOK], 0);
282
        CanClose := false;
283
      end;
284
    end;
285
  end;
286
  if CanClose then
287
  begin
288
    for i := 0 to StyleListBox.Items.Count -1
289
     do StyleListBox.Items.Objects[i].Free;
290
    StyleListBox.Clear;
291
  end;
292
  with Layout do
293
  begin
294
    StyleLeft := Left;
295
    StyleTop := Top;
296
  end;
297
end;
298

299
procedure TStyleNameForm.EditKeyDown(Sender: TObject; var Key: Word;
300
                                     Shift: TShiftState);
301
begin
302
  if Key = VK_DELETE then StyleAltered := true;
303
end;
304

305
procedure TStyleNameForm.EditKeyPress(Sender: TObject; var Key: Char);
306
begin
307
  StyleAltered := true;
308
end;
309

310
procedure TStyleNameForm.FormKeyDown(Sender: TObject; var Key: Word;
311
                                     Shift: TShiftState);
312
begin
313
  if Key = VK_ESCAPE then StyleListBox.ItemIndex := -1;
314
  if (Key = VK_DELETE) and (StyleListBox.Items.Count > 0) then
315
  begin
316
    StyleListBox.DeleteSelected;
317
    SaveToFile;
318
  end;
319
end;
320

321
procedure TStyleNameForm.SaveToFile;
322

323
var
324
  F: File of TPlotStyle;
325
  s: TPlotStyle;
326
  so: TPlotStyleObject;
327
  i: integer;
328

329
begin
330
  AssignFile(F, StyleFName);
331
  Rewrite(F);
332
  for i := 0 to StyleListBox.Count -1 do
333
  begin
334
    so := TPlotStyleObject(StyleListBox.Items.Objects[i]);
335
    s := so.Style;
336
    write(F, s);
337
  end;
338
  CloseFile(F);
339
end;
340

341
procedure TStyleNameForm.StyleListBoxDblClick(Sender: TObject);
342
begin
343
  Close;
344
end;
345

346
end.
347

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

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

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

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