MathgeomGLS

1
unit faTextBlocks;
2

3
interface
4

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

22
  Graf.Global1d;
23

24
type
25
  TTextBlocksForm = class(TForm)
26
    RichEdit: TRichEdit;
27
    BlockListBox: TCheckListBox;
28
    ApplyBitBtn: TBitBtn;
29
    BitBtn1: TBitBtn;
30
    Label2: TLabel;
31
    EditLeft: TEdit;
32
    EditTop: TEdit;
33
    Label3: TLabel;
34
    EditLineHeight: TEdit;
35
    UpDown1: TUpDown;
36
    ColorButton: TSpeedButton;
37
    ColorPanel: TPanel;
38
    FontButton: TSpeedButton;
39
    Label1: TLabel;
40
    AddButton: TSpeedButton;
41
    DeleteButton: TSpeedButton;
42
    UpButton: TSpeedButton;
43
    DownButton: TSpeedButton;
44
    EditCaption: TEdit;
45
    FontDialog: TFontDialog;
46
    ColorDialog: TColorDialog;
47
    procedure FormDestroy(Sender: TObject);
48
    procedure FormShow(Sender: TObject);
49
    procedure FloatKeyPress(Sender: TObject; var Key: Char);
50
    procedure IntKeyPress(Sender: TObject; var Key: Char);
51
    procedure EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
52
    procedure EditLeftKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
53
    procedure EditTopKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
54
    procedure EditCaptionKeyUp(Sender: TObject; var Key: Word;
55
                                Shift: TShiftState);
56
    procedure IntKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
57
    procedure LineHeightChange(Sender: TObject);
58
    procedure BitBtn1Click(Sender: TObject);
59
    procedure ApplyBitBtnClick(Sender: TObject);
60
    procedure FontButtonClick(Sender: TObject);
61
    procedure AddButtonClick(Sender: TObject);
62
    procedure BlockListBoxClick(Sender: TObject);
63
    procedure ColorPanelClick(Sender: TObject);
64
    procedure RichEditChange(Sender: TObject);
65
    procedure BlockListBoxClickCheck(Sender: TObject);
66
    procedure DeleteButtonClick(Sender: TObject);
67
    procedure UpButtonClick(Sender: TObject);
68
    procedure DownButtonClick(Sender: TObject);
69
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
70
  private
71
     
72
    TextData: TTextData;
73
    function DefaultData: TTextData;
74
    procedure UpdateTextLines;
75
  public
76
     
77
    procedure ClearTextBlocks;
78
    procedure UpdateRichLines;
79
    procedure ShowData(Sender: TObject);
80
  end;
81

82
var
83
  TextBlocksForm: TTextBlocksForm;
84

85
const
86
  yIncFactor = 1.65;
87

88
//=====================================================================
89
implementation
90
//=====================================================================
91

92
uses
93
  faGraf1D;
94

95
{$R *.dfm}
96

97
procedure TTextBlocksForm.FormCloseQuery(Sender: TObject;
98
                                   var CanClose: Boolean);
99
begin
100
  if ApplyBitBtn.Visible then
101
  begin
102
    case MessageDlg('The current data has been altered.'+
103
              #13#10'To save the change press the Apply Change Button.'+
104
              #13#10'Do you wish to save the alterations ?', mtConfirmation,
105
                    [mbYes, mbNo], 0) of
106
      mrYes: CanClose := False;
107
    end;
108
  end;
109
end;
110

111
procedure TTextBlocksForm.FormDestroy(Sender: TObject);
112
var
113
  i: integer;
114

115
begin
116
  for i := 0 to BlocklistBox.Count - 1
117
  do BlockListBox.Items.Objects[i].Free;
118
  RichEdit.Clear;
119
end;
120

121
procedure TTextBlocksForm.FormShow(Sender: TObject);
122
begin
123
  Caption := GraphFName;
124
  if BlockListBox.Count = 0 then TextData := DefaultData
125
  else
126
  begin
127
    UpdateRichLines;
128
    ColorPanel.Color := RichEdit.DefAttributes.Color;
129
    with BlockListBox do
130
    TextData := TTextDataObject(Items.Objects[ItemIndex]).Data;
131
    with FontDialog.Font, TextData do
132
    begin
133
      Name := FontName;
134
      Size := FontSize;
135
      Style := FontStyle;
136
      Color := ColorPanel.Color;
137
    end;
138
  end;
139
  ShowData(Sender);
140
end;
141

142
procedure TTextBlocksForm.FloatKeyPress(Sender: TObject; var Key: Char);
143
begin
144
  with Sender as TEdit do
145
  if not CharInSet(Key, ['-', '0'..'9', '.', 'e', 'E', #8]) then Key := #0
146
  else if Active then ApplyBitBtn.Visible := RichEdit.Lines.Count > 0;
147
end;
148

149
procedure TTextBlocksForm.IntKeyPress(Sender: TObject; var Key: Char);
150
begin
151
  with Sender as TEdit do
152
  if not CharInSet(Key, ['0'..'9', #8]) then Key := #0
153
  else ApplyBitBtn.Visible := RichEdit.Lines.Count > 0;
154
end;
155

156
procedure TTextBlocksForm.EditKeyDown(Sender: TObject; var Key: Word;
157
                                       Shift: TShiftState);
158
begin
159
  if (Key = VK_DELETE) or (Key = VK_BACK)
160
  then ApplyBitBtn.Visible := RichEdit.Lines.Count > 0;
161
end;
162

163
procedure TTextBlocksForm.EditLeftKeyUp(Sender: TObject; var Key: Word;
164
                                         Shift: TShiftState);
165
begin
166
  with TextData do
167
  try
168
    xLoc := StrToFloat(EditLeft.Text);
169
  except
170
    if GraphData.Grid.xAxisStyle = asLog then xLoc :=  0.1 else xLoc := -0.1;
171
  end;
172
  with BlockListBox do
173
  TTextDataObject(Items.Objects[ItemIndex]).Data.xLoc := TextData.xLoc;
174
  ApplyBitBtn.Visible := RichEdit.Lines.Count > 0;
175
end;
176

177
procedure TTextBlocksForm.EditTopKeyUp(Sender: TObject; var Key: Word;
178
                                        Shift: TShiftState);
179
begin
180
  with TextData do
181
  try
182
    yLoc := StrToFloat(EditTop.Text);
183
  except
184
    if GraphData.Grid.yAxisStyle = asLog then yLoc :=  0.1 else yLoc := -0.1;
185
  end;
186
  with BlockListBox do
187
  TTextDataObject(Items.Objects[ItemIndex]).Data.yLoc := TextData.yLoc;
188
  ApplyBitBtn.Visible := RichEdit.Lines.Count > 0;
189
end;
190

191
procedure TTextBlocksForm.EditCaptionKeyUp(Sender: TObject; var Key: Word;
192
                                            Shift: TShiftState);
193
begin
194
  with BlockListBox do
195
  begin
196
    TTextDataObject(Items.Objects[ItemIndex]).Data.Caption := EditCaption.Text;
197
    Items[ItemIndex] := EditCaption.Text;
198
  end;
199
end;
200

201
procedure TTextBlocksForm.RichEditChange(Sender: TObject);
202
begin
203
  if Active then
204
  begin
205
    ApplyBitBtn.Visible := (BlockListBox.Count > 0) and
206
   (TTextDataObject(BlockListBox.Items.Objects[BlockListBox.ItemIndex]).
207
     TextLines.Count > 0) and (RichEdit.Lines.Count > 0);
208
  end;
209
end;
210

211
procedure TTextBlocksForm.IntKeyUp(Sender: TObject; var Key: Word;
212
                                    Shift: TShiftState);
213
begin
214
  if Active then
215
  begin
216
    with Sender as TEdit do
217
    try
218
      TextData.yInc := StrToInt(Text);
219
    except
220
      TextData.yInc := round(TextData.FontSize*yIncFactor);
221
    end;
222
    with BlockListBox do
223
    TTextDataObject(Items.Objects[ItemIndex]).Data.yInc := TextData.yInc;
224
    ApplyBitBtn.Visible := RichEdit.Lines.Count > 0;
225
  end;
226
end;
227

228
procedure TTextBlocksForm.LineHeightChange(Sender: TObject);
229
var
230
  k: word;
231

232
begin
233
  if Active then
234
  begin
235
    k := 0;
236
    IntKeyUp(Sender, k, []);
237
  end;
238
end;
239

240
procedure TTextBlocksForm.BitBtn1Click(Sender: TObject);
241
begin
242
  Close;
243
end;
244

245
procedure TTextBlocksForm.ApplyBitBtnClick(Sender: TObject);
246
begin
247
  UpdateTextLines;
248
  Altered := True;
249
  MainForm.GLViewer.Invalidate;
250
  ApplyBitBtn.Visible := False;
251
end;
252

253
procedure TTextBlocksForm.FontButtonClick(Sender: TObject);
254
var
255
  Cpos: integer;
256
  i: integer;
257

258
begin
259
  if RichEdit.Lines.Count = 0 then RichEdit.Lines.Add('Sample text.');
260
  UpdateTextLines;
261
  Cpos := RichEdit.SelStart;
262

263
  if FontDialog.Execute then
264
  begin
265
    with TextData, FontDialog.Font do
266
    begin
267
      FontName := Name;
268
      FontStyle := Style;
269
      FontSize := Size;
270
      FontColor := Color;
271
      yInc := round(FontSize*yIncFactor);
272
      ColorPanel.Color := FontColor;
273
      UpDown1.Position := yInc;
274
    end;
275

276
    with FontDialog,
277
    TTextDataObject(BlockListBox.Items.Objects[BlockListBox.ItemIndex]) do
278
    begin
279
      with Data do
280
      begin
281
        FontName := Font.Name;
282
        FontStyle := Font.Style;
283
        FontSize := Font.Size;
284
        FontColor := Font.Color;
285
        yInc := round(FontSize*yIncFactor);
286

287
        with RichEdit do if Lines.Count > 0 then
288
        begin
289
          UpdateTextLines;
290
          TextLines.Clear;
291
          for i := 0 to Lines.Count -1
292
          do TextLines.Add(TTextLineObject.Create(Lines[i], FontColor));
293
          Lines.Clear;
294
          with DefAttributes do
295
          begin
296
            Name := FontName;
297
            Style := FontStyle;
298
            Size := FontSize;
299
            Color := FontColor;
300
          end;
301
          for i := 0 to TextLines.Count -1 do
302
          with TTextLineObject(TextLines[i]) do Lines.Add(Text);
303
        end;
304

305
      end;
306
    end;
307
    RichEdit.SelStart := Cpos;
308
    ApplyBitBtn.Visible := RichEdit.Lines.Count > 0;
309
  end;
310
end;
311

312
procedure TTextBlocksForm.AddButtonClick(Sender: TObject);
313
begin
314
  with BlockListBox do
315
  begin
316
    if Count = 0 then TextData := DefaultData
317
    else TextData := TTextDataObject(Items.Objects[ItemIndex]).Data;
318

319
    with FontDialog.Font, TextData do
320
    begin
321
      Name := FontName;
322
      Size := FontSize;
323
      Style := FontStyle;
324
      Color := FontColor;
325
    end;
326

327
    with TextData do Caption := 'Text Block';
328
    AddItem(TextData.Caption, TTextDataObject.Create(TextData));
329
    ItemIndex := Count -1;
330
    Checked[ItemIndex] := True;
331
    RichEdit.Clear;
332
  end;
333
  ShowData(Sender);
334
  EditCaption.SetFocus;
335
  FontButtonClick(Sender);
336
end;
337

338
procedure TTextBlocksForm.BlockListBoxClick(Sender: TObject);
339
begin
340
  with BlockListBox do
341
  TextData := TTextDataObject(Items.Objects[ItemIndex]).Data;
342

343
  with FontDialog.Font, TextData do
344
  begin
345
    Name := FontName;
346
    Size := FontSize;
347
    Style := FontStyle;
348
    Color := FontColor;
349
    ColorPanel.Color := Color;
350
  end;
351

352
  UpdateRichLines;
353
  ShowData(Sender);
354
end;
355

356
procedure TTextBlocksForm.BlockListBoxClickCheck(Sender: TObject);
357
begin
358
  ApplyBitBtn.Visible := True;
359
end;
360

361
procedure TTextBlocksForm.ColorPanelClick(Sender: TObject);
362
var
363
  Cpos: integer;
364
  idx: cardinal;
365
  s: string;
366

367
begin
368
  with RichEdit do
369
  begin
370
    if Lines.Count = 0 then
371
    begin
372
      Lines.Add('Sample text.');
373
      UpdateTextLines;
374
      SelStart := 1;
375
    end;
376

377
    Cpos := SelStart;
378

379
    if ActiveLineNo >= cardinal(Lines.Count) then SelStart := Length(Text) -1;
380
  end;
381
  MainForm.StatusBar.Panels[2].Text := '';
382

383
  ColorDialog.Color := ColorPanel.Color;
384
  if ColorDialog.Execute then
385
  begin
386
    ColorPanel.Color := ColorDialog.Color;
387
    with RichEdit do
388
    begin
389
      Idx := ActiveLineNo;
390
      s := Lines[Idx];
391
      Lines.Delete(Idx);
392
      SelAttributes.Color := ColorPanel.Color;
393
      Lines.Insert(Idx, s);
394
    end;
395
  end;
396

397
  RichEdit.SelStart := cPos;
398
  ApplyBitBtn.Visible := RichEdit.Lines.Count > 0;
399
end;
400

401
function TTextBlocksForm.DefaultData: TTextData;
402
begin
403
  with Result do
404
  begin
405
    Caption := 'Text Block #';
406
    xLoc := 0.0;
407
    yLoc := 0.0;
408
    FontName := 'Tahoma';
409
    FontStyle := [];
410
    FontSize := 12;
411
    FontColor := clBlack;
412
    yInc := round(FontSize*yIncFactor);
413
  end;
414
end;
415

416
procedure TTextBlocksForm.DeleteButtonClick(Sender: TObject);
417
var
418
  i: integer;
419

420
begin
421
  if BlockListBox.Count > 0 then
422
  begin
423
    RichEdit.Clear;
424
    with BlockListBox do
425
    begin
426
      i := ItemIndex;
427
      with Items.Objects[i] as TTextDataObject do Free;
428
      Items.Delete(i);
429
      if i > Count -1 then i := Count -1;
430
      ItemIndex := i;
431
      DeleteButton.Enabled := Count > 0;
432
    end;
433

434
    if BlockListBox.Count > 0 then BlockListBoxClick(Sender);
435
    ApplyBitBtn.Visible := True;
436
  end;
437
end;
438

439
procedure TTextBlocksForm.DownButtonClick(Sender: TObject);
440
var
441
  i: integer;
442

443
begin
444
  with BlockListBox do
445
  begin
446
    i := ItemIndex;
447
    if i < Count -1 then Items.Move(i, i+1);
448
    ItemIndex := i+1;
449
  end;
450
  BlockListBoxClick(Sender);
451
end;
452

453
procedure TTextBlocksForm.ShowData(Sender: TObject);
454
var
455
  a: Boolean;
456

457
begin
458
{ if BlockListBox.Count = 0 then disable all except AddButton }
459
  a := Altered;
460
  RichEdit.Color := GraphData.BackColor;
461
  DeleteButton.Enabled := BlockListBox.Count > 0;
462
  UpButton.Enabled := DeleteButton.Enabled and (BlockListBox.Count > 1);
463
  DownButton.Enabled := DeleteButton.Enabled and (BlockListBox.Count > 1);
464
  FontButton.Enabled := DeleteButton.Enabled;
465
  BlockListBox.Enabled := DeleteButton.Enabled;
466
  EditCaption.Enabled := DeleteButton.Enabled;
467
  EditLeft.Enabled := DeleteButton.Enabled;
468
  EditTop.Enabled := DeleteButton.Enabled;
469
  EditLineHeight.Enabled := DeleteButton.Enabled;
470
  upDown1.Enabled := DeleteButton.Enabled;
471
  ColorButton.Enabled := DeleteButton.Enabled;
472
  ColorPanel.Enabled := DeleteButton.Enabled;
473
  RichEdit.Enabled := DeleteButton.Enabled;
474
  ApplyBitBtn.Visible := Active and (Sender.ClassName <> 'TSpeedButton') and
475
                                (RichEdit.Lines.Count > 0);
476

477
  with BlockListBox do if Count > 0 then
478
  begin;
479
    with TTextDataObject(Items.Objects[ItemIndex]).Data do
480
    begin
481
      EditCaption.Text := Caption;
482
      EditLeft.Text := FloatToStrF(xLoc, ffGeneral, 4, 3);
483
      EditTop.Text := FloatToStrF(yLoc, ffGeneral, 4, 3);
484
      EditLineHeight.Text := IntToStr(yInc);
485

486
      with RichEdit, TTextDataObject(Items.Objects[ItemIndex]) do
487
      if (Lines.Count > 1) and (ActiveLineNo < cardinal(Lines.Count))
488
      then ColorDialog.Color := TTextLineObject(TextLines[ActiveLineNo]).Color;
489
    end;
490
  end;
491
  Altered := a;
492
end;
493

494
procedure TTextBlocksForm.UpButtonClick(Sender: TObject);
495
var
496
  i: integer;
497

498
begin
499
  with BlockListBox do
500
  begin
501
    i := ItemIndex;
502
    if i > 0 then Items.Move(i, i-1);
503
    if i > 1 then ItemIndex := i-1 else ItemIndex := 0;
504
  end;
505
  BlockListBoxClick(Sender);
506
end;
507

508
procedure TTextBlocksForm.UpdateTextLines;
509
var
510
  i: integer;
511

512
begin
513
  with BlockListBox, TTextDataObject(Items.Objects[ItemIndex]) do
514
  begin
515
    for i := 0 to TextLines.Count -1 do
516
    begin
517
      TTextLineObject(TextLines.Items[i]).Free;
518
    end;
519
    TextLines.Clear;
520
  end;
521

522
  RichEdit.SelStart := 0;
523
  with BlockListBox, TTextDataObject(Items.Objects[ItemIndex]) do
524
  for i := 0 to RichEdit.Lines.Count -1 do
525
  begin
526
    TextLines.Add(TTextLineObject.Create(RichEdit.Lines[i],
527
                                         RichEdit.SelAttributes.Color));
528

529
    RichEdit.SelStart := RichEdit.SelStart + Length(RichEdit.Lines[i]) +1;
530
  end;
531
end;
532

533
procedure TTextBlocksForm.UpdateRichLines;
534
var
535
  i: integer;
536

537
begin
538
  with TTextDataObject(BlockListBox.Items.Objects[BlockListBox.ItemIndex]) do
539
  begin
540
    with RichEdit.DefAttributes do
541
    begin
542
      Name := Data.FontName;
543
      Style := Data.FontStyle;
544
      Size := Data.FontSize;
545
      Color := Data.FontColor;
546
    end;
547

548
    with RichEdit do
549
    begin
550
      Lines.Clear;
551
      for i := 0 to TextLines.Count -1 do
552
      with TTextLineObject(TextLines.Items[i]) do
553
      begin
554
        SelAttributes.Color := Color;
555
        Lines.Add(Text);
556
      end;
557
    end;
558
  end;
559
end;
560

561
procedure TTextBlocksForm.ClearTextBlocks;
562
var
563
  i: integer;
564

565
begin
566
  with BlockListBox do
567
  begin
568
    for i := 0 to Count -1 do Items.Objects[i].Free;
569
    Clear;
570
  end;
571

572
  RichEdit.Clear;
573
end;
574

575
end.
576