ArenaZ

1
unit uMainForm;
2

3
{$mode objfpc}{$H+}
4
{$INLINE ON}
5
{$MODESWITCH ADVANCEDRECORDS}
6

7
interface
8

9
uses
10
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
11
  Menus, StdCtrls, ComCtrls, GLVectorTypes, GLVectorGeometry, GLGeomObjects,
12
  GLObjects, GLScene, GLLCLViewer, GLMaterial, GLCadencer, GLColor,
13
  GLBitmapFont, GLWindowsFont, GLHUDObjects, GLGraph, uNavCube, GLZArrayClasses,
14
  Types;
15

16

17
// Simple MOL2 Tag Format description
18
Const
19
  MOL2_MOLECULE_HEADER = '@<TRIPOS>MOLECULE';
20
  MOL2_ATOM_HEADER     = '@<TRIPOS>ATOM';
21
  MOL2_BOND_HEADER     = '@<TRIPOS>BOND';
22
  MOL2_SUBSTR_HEADER   = '@<TRIPOS>SUBSTRUCTURE';
23

24
Const
25
  cAtomBondingTypeStr : array[1..4] of String =
26
    ('diatomic',
27
     'atomic',
28
     'metallic',
29
     'covalent network');
30

31
  cAtomGroupBlockStr : array[1..11] of string =
32
   ('nonmetal',
33
    'noble gas',
34
    'alkali metal',
35
    'alkaline earth metal',
36
    'metalloid',
37
    'halogen',
38
    'transition metal',
39
    'metal',
40
    'lanthanoid',
41
    'actinoid',
42
    'post-transition metal');
43

44
    cAtomStandardStateStr : array[1..3] of String =
45
        ('Gaz',
46
         'Liquid',
47
         'Solid'
48
         );
49
type
50
  // https://github.com/andrejewski/periodic-table/blob/master/data.csv
51
  // et une plus complète https://gist.githubusercontent.com/GoodmanSciences/c2dd862cd38f21b0ad36b8f96b4bf1ee/raw/1d92663004489a5b6926e944c1b3d9ec5c40900e/Periodic%2520Table%2520of%2520Elements.csv
52
  TAtomData = Record    // Données dans l'ordre de taille des propriétés
53
    atomicNumber : Byte;
54
    atomicRadius : Byte;
55
    standardState : Byte;
56
    symbol : String[2];
57
    ionizationEnergy : Integer;
58
    electronAffinity : Integer;
59
    meltingPoint : Integer;
60
    boilingPoint : Integer;
61

62
    bondingType : Integer;
63
    electronegativity : Double; // Extend
64
    vanDelWaalsRadius : Double; // Extend
65
    density : Double; // Extend
66
    atomicMass : String;    // Extend
67
    cpkColor : String; //TColorVector;
68
    name : String;
69
    electronicConfiguration : String;
70
    ionRadius : String;
71
    oxidationStates : String;
72
    groupBlock : String;
73
    yearDiscovered  : String; //Integer;
74
  end;
75

76
  TMoleculeAtomData = record
77
    AtomNumber: integer;
78
    Pos: TAffineVector;
79
    class operator =(Constref A, B : TMoleculeAtomData):Boolean;overload;
80

81
    procedure Create(ElemNum : Byte; aPos : TAffineVector); overload;
82
    procedure Create(ElemSym : String; aPos : TAffineVector); overload;
83
  end;
84

85
  TMoleculeAtomLinkData = record
86
    BondingType: integer;
87
    IdStart, IdEnd: integer;
88
    class operator =(Constref A, B : TMoleculeAtomLinkData):Boolean;overload;
89

90
    procedure Create(el1,el2, elType : Integer);
91
  end;
92

93

94
  { TGLAtomDataList }
95
  generic TGLCustomArray<T> = class(specialize TGLZBaseArray<T>);
96

97
  TAtomDataList = class(specialize TGLCustomArray<TAtomData>);
98

99
  TMoleculeAtomDataList = class(specialize TGLCustomArray<TMoleculeAtomData>);
100

101
  TMoleculeAtomLinkDataList = class(specialize TGLCustomArray<TMoleculeAtomLinkData>); //Links = Bonds = Liaison
102

103
  //TCPKColorList = class(specialize TGLCustomArray<TColorVector>);
104

105

106
  { TGLMolecule }
107

108
  TGLMolecule = class(TObject)
109
    private
110
      FAtoms: TMoleculeAtomDataList;
111
      FLinks: TMoleculeAtomLinkDataList;
112
      FDisplayName: string;
113
      FRootObject : TGLBaseSceneObject;
114
      FAtomsInfos, FBondsInfos : TStringList;
115
      //FColorMapCPK : TCPKColorList;
116
      FViewMode : Byte; // 0 = Atoms+Bonds, 1= Atoms 2 = Bonds
117
      procedure SetDisplayName(const Value: string);
118
      procedure SetViewMode(AValue: Byte);
119
    protected
120
      DCAtoms, DCLinks : TGLDummyCube;
121
      //procedure InitCPK;virtual;
122
      function getAtomColor(anAtom : TAtomData):TColorVector;
123
      function getLinkColor(Idx:Byte):TColorVector;
124
    public
125
      constructor Create;
126
      destructor Destroy; override;
127
      procedure Clear;
128

129
      procedure LoadFromFile(Const FileName : String);
130
      procedure CreateMolecule(Const RootObj : TGLBaseSceneObject);
131

132
      function getAtomsInfos :TStringList;
133
      function getBondsInfos : TStringList;
134

135
      property Atoms: TMoleculeAtomDataList read FAtoms;
136
      property Links: TMoleculeAtomLinkDataList read FLinks;
137
      property DisplayName: string read FDisplayName write SetDisplayName;
138

139
      property ViewMode : Byte read FViewMode Write SetViewMode;
140
      //property RootObject : TGLBaseSceneObject read FRootObject;
141
    end;
142

143
  // function GetPeriodicTableData : TAtomDataList;
144

145
type
146

147
  { TMainForm }
148

149
  TMainForm = class(TForm)
150
    CheckBox1: TCheckBox;
151
    CheckBox2: TCheckBox;
152
    CheckBox3: TCheckBox;
153
    GLCadencer: TGLCadencer;
154
    DCWorld: TGLDummyCube;
155
    DCMoleculeWorld: TGLDummyCube;
156

157
    GLCamera: TGLCamera;
158
    DCTarget: TGLDummyCube;
159
    DCWorldGrid: TGLDummyCube;
160
    DCGrids: TGLDummyCube;
161
    DCGridXY: TGLDummyCube;
162
    DCGridXZ: TGLDummyCube;
163
    DCGridYZ: TGLDummyCube;
164
    GLPoints1: TGLPoints;
165
    GridYZ: TGLXYZGrid;
166
    GridXZ: TGLXYZGrid;
167
    GridXY: TGLXYZGrid;
168
    WorldGrid: TGLXYZGrid;
169
    MainLightSource1: TGLLightSource;
170
    DCMolInfos: TGLDummyCube;
171
    lblMolInfo2: TGLHUDText;
172
    GLWindowsBitmapFont1: TGLWindowsBitmapFont;
173
    LblMolInfo: TGLFlatText;
174
    MainStatusBar: TStatusBar;
175
    MoleculeAxis: TGLCube;
176
    DCMolecule: TGLDummyCube;
177
    GLMatLib: TGLMaterialLibrary;
178
    GLScene: TGLScene;
179
    GLViewer: TGLSceneViewer;
180
    GroupBox1: TGroupBox;
181
    GroupBox2: TGroupBox;
182
    Label1: TLabel;
183
    lblMolName: TLabel;
184
    MainMenu1: TMainMenu;
185
    mmoMolAtoms: TMemo;
186
    MenuItem1: TMenuItem;
187
    MenuItem2: TMenuItem;
188
    MenuItem3: TMenuItem;
189
    MenuItem4: TMenuItem;
190
    MenuItem5: TMenuItem;
191
    MenuItem6: TMenuItem;
192
    MenuItem8: TMenuItem;
193
    MenuItem9: TMenuItem;
194
    mmoMolBonds: TMemo;
195
    OpenDlg: TOpenDialog;
196
    Panel1: TPanel;
197
    Panel2: TPanel;
198
    Panel3: TPanel;
199
    Panel4: TPanel;
200
    RadioGroup1: TRadioGroup;
201
    MainTimer: TTimer;
202
    procedure CheckBox1Change(Sender: TObject);
203
    procedure CheckBox2Change(Sender: TObject);
204
    procedure CheckBox3Change(Sender: TObject);
205
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
206
    procedure FormCreate(Sender: TObject);
207
    procedure FormKeyPress(Sender: TObject; var Key: char);
208
    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
209
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
210
    procedure FormShow(Sender: TObject);
211
    procedure GLCadencerProgress(Sender: TObject; const deltaTime, newTime: Double);
212
    procedure GLViewerMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
213
    procedure GLViewerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
214
    procedure GLViewerMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
215
    procedure MainTimerTimer(Sender: TObject);
216
    procedure MenuItem2Click(Sender: TObject);
217
    procedure MenuItem4Click(Sender: TObject);
218
    procedure MenuItem6Click(Sender: TObject);
219
    procedure MenuItem9Click(Sender: TObject);
220
    procedure RadioGroup1Click(Sender: TObject);
221
  private
222
    oldPick, CurrentPick : TGLCustomSceneObject;
223
    oldColor : TColorVector;
224

225
    procedure ShowCameraLocation;
226
    procedure ShowFocalLength;
227
    procedure ShowLightLocation;
228
    procedure ShowTargetLocation;
229

230
  protected
231
    MousePoint: TPoint;
232
    md:Boolean;
233
    DoMouseMoveObj : Integer;
234

235
    procedure UpdateAtomInfosForm(anAtom : TAtomData);
236
  public
237

238
     Mol: TGLMolecule;
239
  end;
240

241
const
242
  crLightxz  = 1;
243
  crLightyz  = 2;
244
  crLightxy  = 3;
245
  crSlidexy  = 4;
246
  crSlideyz  = 5;
247
  crSlidexz  = 6;
248
  crRotate   = 7;
249
  crZoom     = 8;
250
  crHandMove = 9;
251
  crSlidezy  = 10;
252

253
Const
254
  cUnknownAtom : TAtomData = (
255
    atomicNumber : 0;
256
    atomicRadius : 0;
257
    standardState : 0;
258
    symbol : '--';
259
    ionizationEnergy : 0;
260
    electronAffinity : 0;
261
    meltingPoint : 0;
262
    boilingPoint : 0;
263
    bondingType : 0;
264
    electronegativity : 0;
265
    vanDelWaalsRadius : 0;
266
    density : 0;
267
    atomicMass : 'na';
268
    cpkColor : 'clrBlack';
269
    name : 'Unknown';
270
    electronicConfiguration : 'Unknown';
271
    ionRadius : 'Unknown';
272
    oxidationStates : 'Unknown';
273
    groupBlock : 'Unknown';
274
    yearDiscovered  : 'Unknown';
275
  );
276

277
var
278
  MainForm: TMainForm;
279
  NavCube: TGLNavCube;
280
  PeriodicTable : TAtomDataList;
281

282
implementation
283

284
{$R *.lfm}
285
{$R Cursors.res}
286

287
uses
288
  LazFileUtils,
289
  GLZStringUtils,
290
  uCPKForm, uHelpCommandsForm, uAtomInfosForm;
291

292
Const
293
 {_GLRatio / _FPColorRatio : rapport Byte/Float d'une couleur }
294
  _FPColorRatio: single = 1/255;
295

296
{%region%=====[ Functions Tools  ]==============================================}
297

298
function LoadCursorFromRes(CursorName:String):THandle;
299
var
300
   Cur: TCursorImage;
301
begin
302
   Cur := TCursorImage.Create;
303
   Cur.LoadFromResourceName(HInstance,CursorName);
304
   result := Cur.ReleaseHandle;
305
   Cur.Free;
306
end;
307

308
procedure Split(const Delimiter: Char; Input: string; const Strings: TStrings);
309
begin
310
   Assert(Assigned(Strings)) ;
311
   Strings.Clear;
312
   Strings.StrictDelimiter := true;
313
   Strings.Delimiter := Delimiter;
314
   Strings.DelimitedText := Input;
315
end;
316

317
function HexColorToColorVector(const aHexValue : String):TColorVector;
318
begin
319

320
  result.x  := (StrToInt('$'+Copy(aHexValue,1,2)))*_FPColorRatio;
321
  result.y  := (StrToInt('$'+Copy(aHexValue,3,2)))*_FPColorRatio;
322
  result.z  := (StrToInt('$'+Copy(aHexValue,5,2)))*_FPColorRatio;
323
  result.w := 1.0;//AlphaOpaque;
324
end;
325

326
const
327
  WhiteSpaces = [#8, #9, #13, #10, #32];
328

329
procedure SkipWhiteSpace(var Line: string);
330
begin
331
  while (Length(Line) > 0) and (Line[1] in WhiteSpaces) do
332
    Delete(Line, 1, 1);
333
end;
334

335
function ReadString(var Line: string): string;
336
begin
337
  Result := '';
338
  SkipWhiteSpace(Line);
339
  while (Length(Line) > 0) and not(Line[1] in WhiteSpaces) do
340
  begin
341
    SetLength(Result, Length(Result) + 1);
342
    Result[Length(Result)] := Line[1];
343
    Delete(Line, 1, 1);
344
  end;
345
end;
346

347
function ReadInt(var Line: string): Integer;
348
Var
349
   i:Integer;
350
   s : string;
351
begin
352
  result := 0;
353
  s := ReadString(Line);
354
  if TryStrToInt(s,i) then result := i; //StrToInt(s);
355
end;
356

357
function ReadFloat(var Line: string): Double;
358
begin
359
  Result := StrToFloat(ReadString(Line));
360
end;
361

362
function AtomSymbolToAtomicNum(const symbol: string): byte;
363
var s: string;
364
begin
365
  s := LowerCase(symbol);
366
  if s = 'h' then Result := 1 else
367
  if s = 'he' then Result := 2 else
368
  if s = 'li' then Result := 3 else
369
  if s = 'be' then Result := 4 else
370
  if s = 'b' then Result := 5 else
371
  if s = 'c' then Result := 6 else
372
  if s = 'n' then Result := 7 else
373
  if s = 'o' then Result := 8 else
374
  if s = 'f' then Result := 9 else
375
  if s = 'ne' then Result := 10 else
376
  if s = 'na' then Result := 11 else
377
  if s = 'mg' then Result := 12 else
378
  if s = 'al' then Result := 13 else
379
  if s = 'si' then Result := 14 else
380
  if s = 'p' then Result := 15 else
381
  if s = 's' then Result := 16 else
382
  if s = 'cl' then Result := 17 else
383
  if s = 'ar' then Result := 18 else
384
  if s = 'k' then Result := 19 else
385
  if s = 'ca' then Result := 20 else
386
  if s = 'sc' then Result := 21 else
387
  if s = 'ti' then Result := 22 else
388
  if s = 'v' then Result := 23 else
389
  if s = 'cr' then Result := 24 else
390
  if s = 'mn' then Result := 25 else
391
  if s = 'fe' then Result := 26 else
392
  if s = 'co' then Result := 27 else
393
  if s = 'ni' then Result := 28 else
394
  if s = 'cu' then Result := 29 else
395
  if s = 'zn' then Result := 30 else
396
  if s = 'ga' then Result := 31 else
397
  if s = 'ge' then Result := 32 else
398
  if s = 'as' then Result := 33 else
399
  if s = 'se' then Result := 34 else
400
  if s = 'br' then Result := 35 else
401
  if s = 'kr' then Result := 36 else
402
  if s = 'rb' then Result := 37 else
403
  if s = 'sr' then Result := 38 else
404
  if s = 'y' then Result := 39 else
405
  if s = 'zr' then Result := 40 else
406
  if s = 'nb' then Result := 41 else
407
  if s = 'mo' then Result := 42 else
408
  if s = 'tc' then Result := 43 else
409
  if s = 'ru' then Result := 44 else
410
  if s = 'rh' then Result := 45 else
411
  if s = 'pd' then Result := 46 else
412
  if s = 'ag' then Result := 47 else
413
  if s = 'cd' then Result := 48 else
414
  if s = 'in' then Result := 49 else
415
  if s = 'sn' then Result := 50 else
416
  if s = 'sb' then Result := 51 else
417
  if s = 'te' then Result := 52 else
418
  if s = 'i' then Result := 53 else
419
  if s = 'xe' then Result := 54 else
420
  if s = 'cs' then Result := 55 else
421
  if s = 'ba' then Result := 56 else
422
  if s = 'la' then Result := 57 else
423
  if s = 'ce' then Result := 58 else
424
  if s = 'pr' then Result := 59 else
425
  if s = 'nd' then Result := 60 else
426
  if s = 'pm' then Result := 61 else
427
  if s = 'sm' then Result := 62 else
428
  if s = 'eu' then Result := 63 else
429
  if s = 'gd' then Result := 64 else
430
  if s = 'tb' then Result := 65 else
431
  if s = 'dy' then Result := 66 else
432
  if s = 'ho' then Result := 67 else
433
  if s = 'er' then Result := 68 else
434
  if s = 'tm' then Result := 69 else
435
  if s = 'yb' then Result := 70 else
436
  if s = 'lu' then Result := 71 else
437
  if s = 'hf' then Result := 72 else
438
  if s = 'ta' then Result := 73 else
439
  if s = 'w' then Result := 74 else
440
  if s = 're' then Result := 75 else
441
  if s = 'os' then Result := 76 else
442
  if s = 'ir' then Result := 77 else
443
  if s = 'pt' then Result := 78 else
444
  if s = 'au' then Result := 79 else
445
  if s = 'hg' then Result := 80 else
446
  if s = 'tl' then Result := 81 else
447
  if s = 'pb' then Result := 82 else
448
  if s = 'bi' then Result := 83 else
449
  if s = 'po' then Result := 84 else
450
  if s = 'at' then Result := 85 else
451
  if s = 'rn' then Result := 86 else
452
  if s = 'fr' then Result := 87 else
453
  if s = 'ra' then Result := 88 else
454
  if s = 'ac' then Result := 89 else
455
  if s = 'th' then Result := 90 else
456
  if s = 'pa' then Result := 91 else
457
  if s = 'u' then Result := 92 else
458
  if s = 'np' then Result := 93 else
459
  if s = 'pu' then Result := 94 else
460
  if s = 'am' then Result := 95 else
461
  if s = 'cm' then Result := 96 else
462
  if s = 'bk' then Result := 97 else
463
  if s = 'cf' then Result := 98 else
464
  if s = 'es' then Result := 99 else
465
  if s = 'fm' then Result := 100 else
466
  if s = 'md' then Result := 101 else
467
  if s = 'no' then Result := 102 else
468
  if s = 'lr' then Result := 103 else
469
  if s = 'rf' then Result := 104 else
470
  if s = 'db' then Result := 105 else
471
  if s = 'sg' then Result := 106 else
472
  if s = 'bh' then Result := 107 else
473
  if s = 'hs' then Result := 108 else
474
  if s = 'mt' then Result := 109 else
475
  if s = 'ds' then Result := 110 else
476
  if s = 'rg' then Result := 111 else
477
  if s = 'cn' then Result := 112 else
478
  if s = 'uut' then Result := 113 else
479
  if s = 'uuq' then Result := 114 else
480
  if s = 'uup' then Result := 115 else
481
  if s = 'uuh' then Result := 116 else
482
  if s = 'uus' then Result := 117 else
483
  if s = 'uuo' then Result := 118 else
484
    Result := 0;
485
end;
486

487

488
procedure QuaternionRotation(var Obj:TGLBaseSceneObject;Ex,Ey,eZ:Double);
489
var
490
 q : TQuaternion;
491
 m : TMatrix;
492
 vFrom, vTo : TAffineVector;
493
begin
494
 q := QuaternionFromRollPitchYaw(eX,eZ,eY);
495
 //QuaternionToPoints(q, vFrom, vTo);
496
 m := QuaternionToMatrix(QuaternionConjugate(q));
497
 Obj.Matrix := MatrixMultiply(Obj.Matrix,m);
498
 Obj.TransformationChanged;
499
end;
500

501
{%endregion%}
502

503
{%region%=====[ TGLMoleculeAtomDataList ]=======================================}
504

505
class operator TMoleculeAtomData.=(Constref A, B: TMoleculeAtomData): Boolean;
506
begin
507
  Result := (A.AtomNumber = B.AtomNumber) And (VectorEquals(A.Pos,B.Pos));
508
end;
509

510
procedure TMoleculeAtomData.Create(ElemNum : Byte; aPos : TAffineVector);
511
begin
512
  with Self do
513
  begin
514
    AtomNumber:=ElemNum; // Numero de l'element de la table periodique
515
    Pos  := aPos;
516
  end;
517
end;
518

519
procedure  TMoleculeAtomData.Create(ElemSym : String; aPos : TAffineVector);
520
begin
521
  with Self do
522
  begin
523
    AtomNumber:=AtomSymbolToAtomicNum(ElemSym); // Numero de l'element de la table periodique
524
    Pos  := aPos;
525
  end;
526
end;
527

528
class operator TMoleculeAtomLinkData.=(Constref A, B: TMoleculeAtomLinkData): Boolean;
529
begin
530
  Result := (A.BondingType = B.BondingType) And (A.IdEnd = B.IdEnd) And (A.IdStart = B.IdStart);
531
end;
532

533
procedure TMoleculeAtomLinkData.Create(el1,el2, elType : Integer);
534
begin
535
  with Self do
536
  begin
537
    BondingType:=elType;
538
    idStart:= el1;
539
    idEnd  := el2;
540
  end;
541
end;
542

543
{%endregion%}
544

545
{%region%=====[ TGLMolecule ]===================================================}
546

547
constructor TGLMolecule.Create;
548
begin
549
  inherited;
550
  FAtoms := TMoleculeAtomDataList.Create;
551
  FLinks := TMoleculeAtomLinkDataList.Create;
552
  FAtomsInfos := TStringList.Create;
553
  FBondsInfos := TStringList.Create;
554
  FViewMode := 0;
555
  //FColorMapCPK := TCPKColorList.Create;
556
  //InitCPK;
557
end;
558

559
destructor TGLMolecule.Destroy;
560
begin
561
  //FColorMapCPK.Free;
562
  FBondsInfos.Free;
563
  FAtomsInfos.Free;
564
  FLinks.Free;
565
  FAtoms.Free;
566
  inherited;
567
end;
568

569
procedure TGLMolecule.Clear;
570
begin
571
  FAtoms.Clear;
572
  FLinks.Clear;
573
end;
574

575
procedure TGLMolecule.LoadFromFile(const FileName: String);
576
var
577
 ext : String;
578
 sl : TStringList;
579
 s : String;
580
 nba,nbb, i, cnt, linepos : Integer;
581
 px,py,pz : Double;
582
 atomSym : String;
583
 iStart, iEnd, iType, iNum : Integer;
584
 MolAtomData: TMoleculeAtomData;
585
 MolLinkData: TMoleculeAtomLinkData;
586
begin
587

588
  // Prise ne charge basique des fichiers au format .MOL et .MOL2
589

590
  // mol2 file format description : https://fr.scribd.com/document/218351247/mol2
591
  // https://docs.chemaxon.com/display/docs/MDL+MOLfiles%2C+RGfiles%2C+SDfiles%2C+Rxnfiles%2C+RDfiles+formats
592
  // http://infochim.u-strasbg.fr/recherche/Download/Fragmentor/MDL_SDF.pdf
593

594
  ext := lowercase(ExtractFileExt(FileName));
595

596
  if (ext = '.mol') then
597
  begin
598
    // On efface les anciennes données
599
    FAtoms.Clear;
600
    FLinks.Clear;
601

602
    sl := TStringList.Create;
603
    sl.LoadFromFile(FileName);
604

605
    // Read Header block
606
    DisplayName := sl[0];
607

608
    // Skip comments and other infos header (2 lines)
609
    s:=sl[3];
610

611
    // Counts Line
612
    nba := readInt(s); // nb atoms
613
    nbb := readInt(s); // nb bonds
614

615
    // Read Atoms block
616
    cnt := nba-1;
617
    linepos := 4;
618
    for i:= 0 to cnt do
619
    begin
620
      s := sl[LinePos];
621
      px := ReadFloat(s);
622
      py := ReadFloat(s);
623
      pz := ReadFloat(s);
624
      atomSym := ReadString(s);
625

626
      MolAtomData.Create(AtomSym,AffineVectorMake(px,py,pz));
627
      FAtoms.Add(MolAtomData);
628
      inc(LinePos);
629
    end;
630

631
    // Read Bonds block
632
    cnt := nbb -1;
633
    for i:= 0 to cnt do
634
    begin
635
      s := sl[LinePos];
636
      iStart := ReadInt(s);
637
      iEnd := ReadInt(s);
638
      iType := ReadInt(s);
639
      MolLinkData.Create(iStart,iEnd,iType);
640
      FLinks.Add(MolLinkData);
641
      inc(LinePos);
642
    end;
643
    // Read properties block
644
    {@TODO}
645

646
    sl.Free;
647
  end
648
  else if (ext = '.mol2') then
649
  begin
650
    sl := TStringList.Create;
651
    sl.Free;
652
  end;
653

654
end;
655

656
procedure TGLMolecule.CreateMolecule(const RootObj: TGLBaseSceneObject);
657
var
658
  i,k: integer;
659
  sf: double;
660
  sph: TGLSphere;
661
  MolAtomData: TMoleculeAtomData;
662
  MolLinkData: TMoleculeAtomLinkData;
663
  AtomData : TAtomData;
664
  pStart, pEnd, pMid, pAngle: TAffineVector;
665
  cyl: TGLCylinder;
666
  Lines : TGLLines;
667
  //aNodeStart,
668
  //aNodeEnd : TGLLinesNode;
669

670
  //aZ,aX : Double;
671
begin
672
  FRootObject := RootObj;
673
  FRootObject.DeleteChildren;
674
  FAtomsInfos.Clear;
675
  FBondsInfos.Clear;
676

677
  DCAtoms := TGLDummyCube.CreateAsChild(FRootObject);
678
  DCLinks := TGLDummyCube.CreateAsChild(FRootObject);
679
  for i := 0 to Atoms.Count-1 do
680
  begin
681
    MolAtomData := (FAtoms.Items[i]);
682
    AtomData := PeriodicTable.Items[MolAtomData.AtomNumber];
683
    sph := TGLSphere.CreateAsChild(DCAtoms);
684
    //sf := AtomicNrToScale(atomData.AtomKind);
685
    sf:=1.0;
686
    With sph do
687
    begin
688
      //Material.MaterialOptions:= [moNoLighting];
689
      Material.FrontProperties.Diffuse.DirectColor := getAtomColor(atomData);
690
      Radius := 0.5 * (AtomData.atomicRadius*0.01) ;
691
      Position.AsAffineVector := MolAtomData.Pos;
692
      FAtomsInfos.Add('Atom : ' + i.ToString +' | ( '+TAtomData(PeriodicTable.Items[MolAtomData.AtomNumber]).symbol
693
                     +' ) [' + sph.Position.AsString + ']');
694
      Scale.AsAffineVector := AffineVectorMake(sf,sf,sf);
695
      Tag := MolAtomData.AtomNumber;
696
      k:=i+1;
697
      Hint := 'Atom : ' + k.ToString +' | ( '+TAtomData(PeriodicTable.Items[MolAtomData.AtomNumber]).symbol
698
             +' ) [' + sph.Position.AsString + ']';
699
    end;
700
  end;
701

702
  for i := 0 to Links.Count-1 do
703
  begin
704
    MolLinkData := FLinks.Items[i];
705
    Lines := TGLLines.CreateAsChild(DCLinks);
706
    With Lines do
707
    begin
708
      Antialiased := true;
709
      LineColor.DirectColor := getLinkColor(MolLinkData.BondingType);
710
      NodeColor.DirectColor := clrBrightGold;
711
      NodesAspect := lnaDodecahedron;
712
      NodeSize := 0.1;
713
      LineWidth := 2;
714
      Pickable := True;
715
      k:=i+1;
716
      Hint := 'Link : ' + k.ToString + ' | Type : '+ IntToStr((MolLinkData.BondingType))+' [' + MolLinkData.IdStart.ToString + '-->' + MolLinkData.IdEnd.ToString + ']';
717
    end;
718
    pStart := Atoms.Items[MolLinkData.IdStart-1].Pos;
719
    pEnd := Atoms.Items[MolLinkData.IdEnd-1].Pos;
720

721
    Lines.Nodes.AddNode(pStart);
722
    Lines.Nodes.AddNode(pEnd);
723

724

725
   { C'est, stupide mais je n'arrive pas  à visualiser comment calculer
726
   les bons angles de rotations avec des cylindres.....;(
727

728
    //if VectorMorethen(pStart,pEnd) then
729
    //begin
730
    //  pMid := pStart;
731
    //  pStart := pEnd;
732
    //  pEnd :=pMid;
733
    //end;
734
    pMid :=  AffineVectorMake((pStart.X+pEnd.X)*0.5,(pStart.Y+pEnd.Y)*0.5,(pStart.Z+pEnd.Z)*0.5);
735
    cyl := TGLCylinder.CreateAsChild(DCLinks);
736
    with cyl do
737
    begin
738
      Material.FrontProperties.Diffuse.DirectColor := getLinkColor(MolLinkData.BondingType);
739
      //Position.AsAffineVector := pMid;
740
      Height :=  VectorDistance(pStart,pEnd);
741
      TopRadius := 0.05;
742
      BottomRadius:= 0.05;
743
      Tag := i;
744
      Hint := 'Link : ' + i.ToString + '| Type : '+ IntToStr((MolLinkData.BondingType))+' [' + MolLinkData.IdStart.ToString + '-->' + MolLinkData.IdEnd.ToString + ']';
745
    end;
746

747
    // C'est la dedans que ça foire
748
     pAngle.X := 180/Pi*ArcTan2(pEnd.X-pStart.X, pEnd.Y-pStart.Y);
749
     pAngle.Y := 180/Pi*ArcTan2(pEnd.X-pStart.X, pEnd.Z-pStart.Z);
750
     pAngle.Z := 180/Pi*ArcTan2(pEnd.Z-pStart.Z, pEnd.Y-pStart.Y);
751

752
    //if pAngle.X<>0 then Cyl.Roll(pAngle.X);
753
    //if pAngle.Z<>0 then Cyl.Pitch(pAngle.Z);
754
    //if pAngle.Y<>0 then Cyl.Turn(pAngle.Y);
755
    //Cyl.RotateAbsolute(pAngle.X,pAngle.Y,pAngle.Z);
756
    QuaternionRotation(TGLBaseSceneObject(Cyl),pAngle.X,pAngle.Y,pAngle.Z);
757
    Cyl.Position.AsAffineVector := pMid;
758
    }
759

760

761
    FBondsInfos.Add(Lines.Hint);
762
  end;
763

764
end;
765

766
function TGLMolecule.getAtomsInfos: TStringList;
767
begin
768
  result:= FAtomsInfos;
769
end;
770

771
function TGLMolecule.getBondsInfos: TStringList;
772
begin
773
 result := FBondsInfos;
774
end;
775

776
procedure TGLMolecule.SetDisplayName(const Value: string);
777
begin
778
  FDisplayName := Value;
779
end;
780

781
procedure TGLMolecule.SetViewMode(AValue: Byte);
782
var
783
  i: integer;
784
  sph: TGLSphere;
785
 // cyl: TGLCylinder;
786
  lines : TGLLines;
787
begin
788
  if FViewMode=AValue then Exit;
789
  FViewMode:=AValue;
790

791
  for i := 0 to DCAtoms.Count-1 do
792
  begin
793
      sph := TGLSphere(DCAtoms.Children[i]);
794
      sph.Visible := ((FViewMode = 0) or (FViewMode = 1));
795
  end;
796

797
  for i := 0 to DCLinks.Count-1 do
798
  begin
799
    Lines := TGLLines(DCLinks.Children[i]);
800
    Lines.Visible:= ((FViewMode = 0) or (FViewMode = 2));
801
    //cyl := TGLCylinder(DCLinks.Children[i]);
802
    //cyl.Visible := ((FViewMode = 0) or (FViewMode = 2));
803
  end;
804

805
end;
806

807
//procedure TGLMolecule.InitCPK;
808
//begin
809
//  FColorMapCPK.Capacity:=118;
810
//  FColorMapCPK.Items[0] := VectorMake(0.96,0.96,0.96); //
811
//  FColorMapCPK.Items[1] := VectorMake(0.80,0.50,1.00); //
812
//  FColorMapCPK.Items[2] := VectorMake(0.67,0.36,0.95); //
813
//  FColorMapCPK.Items[3] := VectorMake(0.56,0.25,0.83); //
814
//  FColorMapCPK.Items[4] := VectorMake(0.44,0.18,0.69); //
815
//  FColorMapCPK.Items[5] := VectorMake(0.34,0.09,0.56); //
816
//  FColorMapCPK.Items[6] := VectorMake(0.40,0.40,0.40); // C
817
//  FColorMapCPK.Items[7] := VectorMake(1.0,0.0,0.0);    //
818
//
819
//  FColorMapCPK.Items[8] := VectorMake(0.96,0.96,0.96); // Be
820
//  FColorMapCPK.Items[9] := VectorMake(0.96,0.96,0.96); // Mg
821
//  FColorMapCPK.Items[10] := VectorMake(0.96,0.96,0.96);// Ca
822
//  FColorMapCPK.Items[11] := VectorMake(0.96,0.96,0.96);// Sr
823
//  FColorMapCPK.Items[12] := VectorMake(0.96,0.96,0.96);// Ba
824
//  FColorMapCPK.Items[13] := VectorMake(0.96,0.96,0.96);// Ra
825
//
826
//  FColorMapCPK.Items[14] := VectorMake(0.96,0.96,0.96); // Sc
827
//  FColorMapCPK.Items[15] := VectorMake(0.96,0.96,0.96); // Y
828
//  FColorMapCPK.Items[16] := VectorMake(0.96,0.96,0.96); // Lu
829
//  FColorMapCPK.Items[17] := VectorMake(0.96,0.96,0.96); // Lr
830
//  FColorMapCPK.Items[18] := VectorMake(0.96,0.96,0.96);
831
//  FColorMapCPK.Items[19] := VectorMake(0.96,0.96,0.96);
832
//
833
//  FColorMapCPK.Items[20] := VectorMake(0.96,0.96,0.96);
834
//  FColorMapCPK.Items[21] := VectorMake(0.96,0.96,0.96);
835
//  FColorMapCPK.Items[22] := VectorMake(0.96,0.96,0.96);
836
//  FColorMapCPK.Items[23] := VectorMake(0.96,0.96,0.96);
837
//  FColorMapCPK.Items[24] := VectorMake(0.96,0.96,0.96);
838
//  FColorMapCPK.Items[25] := VectorMake(0.96,0.96,0.96);
839
//  FColorMapCPK.Items[26] := VectorMake(0.96,0.96,0.96);
840
//  FColorMapCPK.Items[27] := VectorMake(0.96,0.96,0.96);
841
//  FColorMapCPK.Items[28] := VectorMake(0.96,0.96,0.96);
842
//  FColorMapCPK.Items[29] := VectorMake(0.96,0.96,0.96);
843
//  FColorMapCPK.Items[30] := VectorMake(0.96,0.96,0.96);
844
//  FColorMapCPK.Items[31] := VectorMake(0.96,0.96,0.96);
845
//  FColorMapCPK.Items[32] := VectorMake(0.96,0.96,0.96);
846
//  FColorMapCPK.Items[33] := VectorMake(0.96,0.96,0.96);
847
//  FColorMapCPK.Items[34] := VectorMake(0.96,0.96,0.96);
848
//  FColorMapCPK.Items[35] := VectorMake(0.96,0.96,0.96);
849
//  FColorMapCPK.Items[36] := VectorMake(0.96,0.96,0.96);
850
//  FColorMapCPK.Items[37] := VectorMake(0.96,0.96,0.96);
851
//  FColorMapCPK.Items[38] := VectorMake(0.96,0.96,0.96);
852
//  FColorMapCPK.Items[39] := VectorMake(0.96,0.96,0.96);
853
//
854
//  FColorMapCPK.Items[40] := VectorMake(0.96,0.96,0.96);
855
//  FColorMapCPK.Items[41] := VectorMake(0.96,0.96,0.96);
856
//  FColorMapCPK.Items[42] := VectorMake(0.96,0.96,0.96);
857
//  FColorMapCPK.Items[43] := VectorMake(0.96,0.96,0.96);
858
//  FColorMapCPK.Items[44] := VectorMake(0.96,0.96,0.96);
859
//  FColorMapCPK.Items[45] := VectorMake(0.96,0.96,0.96);
860
//  FColorMapCPK.Items[46] := VectorMake(0.96,0.96,0.96);
861
//  FColorMapCPK.Items[47] := VectorMake(0.96,0.96,0.96);
862
//  FColorMapCPK.Items[48] := VectorMake(0.96,0.96,0.96);
863
//  FColorMapCPK.Items[49] := VectorMake(0.96,0.96,0.96);
864
//  FColorMapCPK.Items[50] := VectorMake(0.96,0.96,0.96);
865
//  FColorMapCPK.Items[51] := VectorMake(0.96,0.96,0.96);
866
//  FColorMapCPK.Items[52] := VectorMake(0.96,0.96,0.96);
867
//  FColorMapCPK.Items[53] := VectorMake(0.96,0.96,0.96);
868
//  FColorMapCPK.Items[54] := VectorMake(0.96,0.96,0.96);
869
//  FColorMapCPK.Items[55] := VectorMake(0.96,0.96,0.96);
870
//  FColorMapCPK.Items[56] := VectorMake(0.96,0.96,0.96);
871
//  FColorMapCPK.Items[57] := VectorMake(0.96,0.96,0.96);
872
//  FColorMapCPK.Items[58] := VectorMake(0.96,0.96,0.96);
873
//  FColorMapCPK.Items[59] := VectorMake(0.96,0.96,0.96);
874
//
875
//  FColorMapCPK.Items[60] := VectorMake(0.96,0.96,0.96);
876
//  FColorMapCPK.Items[61] := VectorMake(0.96,0.96,0.96);
877
//  FColorMapCPK.Items[62] := VectorMake(0.96,0.96,0.96);
878
//  FColorMapCPK.Items[63] := VectorMake(0.96,0.96,0.96);
879
//  FColorMapCPK.Items[64] := VectorMake(0.96,0.96,0.96);
880
//  FColorMapCPK.Items[65] := VectorMake(0.96,0.96,0.96);
881
//  FColorMapCPK.Items[66] := VectorMake(0.96,0.96,0.96);
882
//  FColorMapCPK.Items[67] := VectorMake(0.96,0.96,0.96);
883
//  FColorMapCPK.Items[68] := VectorMake(0.96,0.96,0.96);
884
//  FColorMapCPK.Items[69] := VectorMake(0.96,0.96,0.96);
885
//  FColorMapCPK.Items[70] := VectorMake(0.96,0.96,0.96);
886
//  FColorMapCPK.Items[71] := VectorMake(0.96,0.96,0.96);
887
//  FColorMapCPK.Items[72] := VectorMake(0.96,0.96,0.96);
888
//  FColorMapCPK.Items[73] := VectorMake(0.96,0.96,0.96);
889
//  FColorMapCPK.Items[74] := VectorMake(0.96,0.96,0.96);
890
//  FColorMapCPK.Items[75] := VectorMake(0.96,0.96,0.96);
891
//  FColorMapCPK.Items[76] := VectorMake(0.96,0.96,0.96);
892
//  FColorMapCPK.Items[77] := VectorMake(0.96,0.96,0.96);
893
//  FColorMapCPK.Items[78] := VectorMake(0.96,0.96,0.96);
894
//  FColorMapCPK.Items[79] := VectorMake(0.96,0.96,0.96);
895
//
896
//  FColorMapCPK.Items[80] := VectorMake(0.96,0.96,0.96);
897
//  FColorMapCPK.Items[81] := VectorMake(0.96,0.96,0.96);
898
//  FColorMapCPK.Items[82] := VectorMake(0.96,0.96,0.96);
899
//  FColorMapCPK.Items[83] := VectorMake(0.96,0.96,0.96);
900
//  FColorMapCPK.Items[84] := VectorMake(0.96,0.96,0.96);
901
//  FColorMapCPK.Items[85] := VectorMake(0.96,0.96,0.96);
902
//  FColorMapCPK.Items[86] := VectorMake(0.96,0.96,0.96);
903
//  FColorMapCPK.Items[87] := VectorMake(0.96,0.96,0.96);
904
//  FColorMapCPK.Items[88] := VectorMake(0.96,0.96,0.96);
905
//  FColorMapCPK.Items[89] := VectorMake(0.96,0.96,0.96);
906
//  FColorMapCPK.Items[90] := VectorMake(0.96,0.96,0.96);
907
//  FColorMapCPK.Items[91] := VectorMake(0.96,0.96,0.96);
908
//  FColorMapCPK.Items[92] := VectorMake(0.96,0.96,0.96);
909
//  FColorMapCPK.Items[93] := VectorMake(0.96,0.96,0.96);
910
//  FColorMapCPK.Items[94] := VectorMake(0.96,0.96,0.96);
911
//  FColorMapCPK.Items[95] := VectorMake(0.96,0.96,0.96);
912
//  FColorMapCPK.Items[96] := VectorMake(0.96,0.96,0.96);
913
//  FColorMapCPK.Items[97] := VectorMake(0.96,0.96,0.96);
914
//  FColorMapCPK.Items[98] := VectorMake(0.96,0.96,0.96);
915
//  FColorMapCPK.Items[99] := VectorMake(0.96,0.96,0.96);
916
//
917
//  FColorMapCPK.Items[100] := VectorMake(0.96,0.96,0.96);
918
//  FColorMapCPK.Items[101] := VectorMake(0.96,0.96,0.96);
919
//  FColorMapCPK.Items[102] := VectorMake(0.96,0.96,0.96);
920
//  FColorMapCPK.Items[103] := VectorMake(0.96,0.96,0.96);
921
//  FColorMapCPK.Items[104] := VectorMake(0.96,0.96,0.96);
922
//  FColorMapCPK.Items[105] := VectorMake(0.96,0.96,0.96);
923
//  FColorMapCPK.Items[106] := VectorMake(0.96,0.96,0.96);
924
//  FColorMapCPK.Items[107] := VectorMake(0.96,0.96,0.96);
925
//  FColorMapCPK.Items[108] := VectorMake(0.96,0.96,0.96);
926
//  FColorMapCPK.Items[109] := VectorMake(0.96,0.96,0.96);
927
//  FColorMapCPK.Items[110] := VectorMake(0.96,0.96,0.96);
928
//  FColorMapCPK.Items[111] := VectorMake(0.96,0.96,0.96);
929
//  FColorMapCPK.Items[112] := VectorMake(0.96,0.96,0.96);
930
//  FColorMapCPK.Items[113] := VectorMake(0.96,0.96,0.96);
931
//  FColorMapCPK.Items[114] := VectorMake(0.96,0.96,0.96);
932
//  FColorMapCPK.Items[115] := VectorMake(0.96,0.96,0.96);
933
//  FColorMapCPK.Items[116] := VectorMake(0.96,0.96,0.96);
934
//  FColorMapCPK.Items[117] := VectorMake(0.96,0.96,0.96);
935
//
936
//end;
937

938
function TGLMolecule.getAtomColor(anAtom: TAtomData): TColorVector;
939
begin
940
  Result := HexColorToColorVector(anAtom.cpkColor);
941
end;
942

943
function TGLMolecule.getLinkColor(Idx: Byte): TColorVector;
944
begin
945
  Case Idx of
946
    1 : Result := clrYellow;
947
    2 : Result := clrBlue;
948
    3 : Result := clrGreen;
949
    4 : Result := clrFuchsia;
950
    else Result := clrRed; // Liaison inconnue
951
  end;
952
end;
953

954
{%endregion%}
955

956

957
{ TMainForm }
958

959
procedure TMainForm.FormCreate(Sender: TObject);
960
Var
961
  AnAtomData : TMoleculeAtomData;
962
  AnAtomLinkData : TMoleculeAtomLinkData;
963

964
  procedure LoadPeriodicTable;
965
  var
966
    sl : TStringList;
967
    s : String;
968
    dpt : TStringList;
969
    i : Integer;
970
    anAtom : TAtomData;
971
  begin
972
    sl := TStringList.Create;
973
    dpt := TStringList.Create;
974
    sl.LoadFromFile('periodictable.dat');
975

976
    PeriodicTable.Add(cUnknownAtom);
977

978
    for i:=0 to sl.Count-1 do
979
    begin
980
      s := sl.Strings[i];
981
      dpt := StrOps.Explode(s,',');
982

983
      //showMessage('Out : '+dpt.Strings[0]+' - '+dpt.Strings[1]+' - '+dpt.Strings[2]);
984
      //ShowMessage('Exploded = '+ dpt.Text);
985
      with anAtom do
986
      begin
987
        atomicNumber := strToInt(dpt[0]);
988
        atomicRadius := strToInt(dpt[7]);
989
        standardState := strToInt(dpt[13]); //****
990
        symbol := dpt[1];
991
        ionizationEnergy := strToInt(dpt[10]);
992
        electronAffinity := strToInt(dpt[11]);
993
        meltingPoint := strToInt(dpt[15]);
994
        boilingPoint := strToInt(dpt[16]);
995
        bondingType := strToInt(dpt[14]);
996
        atomicMass := dpt[3]; //StrToFloat(dpt[3]);
997
        electronegativity := StrToFloat(dpt[6]);
998
        vanDelWaalsRadius := StrToFloat(dpt[9]);
999
        density := StrToFloat(dpt[17]);
1000
        cpkColor := dpt[4];//clrBlack;
1001
        name := dpt[2];
1002
        electronicConfiguration := dpt[5];
1003
        ionRadius := dpt[8];
1004
        oxidationStates := dpt[12];
1005
        groupBlock := dpt[18];
1006
        yearDiscovered  := dpt[19]; //strToInt(dpt[19]);
1007
      end;
1008
      PeriodicTable.Add(anAtom);
1009
    end;
1010
    dpt.Free;
1011
    sl.Free;
1012
  end;
1013

1014
begin
1015
  PeriodicTable := TAtomDataList.Create;
1016
  LoadPeriodicTable;
1017

1018
  Screen.Cursors[crLightxy] := LoadCursorFromRes('LIGHTXY');
1019
  Screen.Cursors[crLightyz] := LoadCursorFromRes('LIGHTYZ');
1020
  Screen.Cursors[crLightxz] := LoadCursorFromRes('LIGHTXZ');
1021
  Screen.Cursors[crSlidexy] := LoadCursorFromRes('SLIDEXY');
1022
  Screen.Cursors[crSlidexz] := LoadCursorFromRes('SLIDEXZ');
1023
  Screen.Cursors[crSlideyz] := LoadCursorFromRes('SLIDEYZ');
1024
  Screen.Cursors[crRotate]  := LoadCursorFromRes('ROTATE');
1025
  Screen.Cursors[crZoom]    := LoadCursorFromRes('ZOOM');
1026
  Screen.Cursors[crSlidezy] := LoadCursorFromRes('SLIDEZY');
1027

1028
  NavCube := TGLNavCube.CreateAsChild(GLScene.Objects);
1029
  NavCube.SceneViewer := GLViewer;
1030
  NavCube.Camera:=GLCamera;
1031
  NavCube.ActiveMouse:=True;
1032
  NavCube.FPS := 30;
1033
  DoMouseMoveObj := 0;
1034

1035
  Mol := TGLMolecule.Create;
1036
  With Mol do
1037
  begin
1038
    DisplayName :='Benzene';
1039
    With Atoms do
1040
    begin
1041
       AnAtomData.Create(6,AffineVectorMake(1.9050,-0.7932,0.0000));
1042
       Add(AnAtomData);
1043
       AnAtomData.Create(6,AffineVectorMake(1.9050, -2.1232,0.0000));
1044
       Add(AnAtomData);
1045
       AnAtomData.Create(6,AffineVectorMake(0.7531,-0.1282 ,0.0000));
1046
       Add(AnAtomData);
1047
       AnAtomData.Create(6,AffineVectorMake(0.7531,-2.7882,0.0000));
1048
       Add(AnAtomData);
1049
       AnAtomData.Create(6,AffineVectorMake(-0.3987,-0.7932,0.0000));
1050
       Add(AnAtomData);
1051
       AnAtomData.Create(6,AffineVectorMake(-0.3987,-2.1232,0.0000));
1052
       Add(AnAtomData);
1053
    end;
1054

1055
    With Links do
1056
    begin
1057
       AnAtomLinkData.Create(2,1,1);
1058
       Add(AnAtomLinkData);
1059
       AnAtomLinkData.Create(3,1,2);
1060
       Add(AnAtomLinkData);
1061
       AnAtomLinkData.Create(4,2,2);
1062
       Add(AnAtomLinkData);
1063
       AnAtomLinkData.Create(5,3,1);
1064
       Add(AnAtomLinkData);
1065
       AnAtomLinkData.Create(6,4,1);
1066
       Add(AnAtomLinkData);
1067
       AnAtomLinkData.Create(6,5,2);
1068
       Add(AnAtomLinkData);
1069
    end;
1070
  end;
1071
end;
1072

1073
procedure TMainForm.ShowCameraLocation;
1074
begin
1075
  with GLCamera.Position do
1076
  MainStatusBar.Panels[0].Text := 'Camera: '+FloatToStrF(X, ffNumber, 5, 2)+', '+
1077
  FloatToStrF(Y, ffNumber, 5, 2)+', '+FloatToStrF(Z, ffNumber, 5, 2);
1078
end;
1079

1080
procedure TMainForm.ShowTargetLocation;
1081
begin
1082
  with DCTarget.Position do
1083
  MainStatusBar.Panels[2].Text := 'Target: '+
1084
  FloatToStrF(-X, ffNumber, 5, 2)+', '+FloatToStrF(-Y, ffNumber, 5, 2)+', '+
1085
  FloatToStrF(-Z, ffNumber, 5, 2);
1086
end;
1087

1088
procedure TMainForm.ShowFocalLength;
1089
begin
1090
  with GLCamera do
1091
  MainStatusBar.Panels[1].Text := 'Focal: '+FloatToStrF(FocalLength, ffnumber, 5, 2);
1092
end;
1093

1094
procedure TMainForm.ShowLightLocation;
1095
begin
1096
  with MainLightSource1.Position do
1097
  MainStatusBar.Panels[3].Text := 'Light: '+
1098
  FloatToStrF(X, ffNumber, 5, 2)+', '+FloatToStrF(Y, ffNumber, 5, 2)+', '+
1099
  FloatToStrF(Z, ffNumber, 5, 2);
1100
end;
1101

1102
procedure TMainForm.FormKeyPress(Sender: TObject; var Key: char);
1103
begin
1104
  if Key = 'x' then DoMouseMoveObj := 1
1105
  else if Key = 'y' then DoMouseMoveObj := 2
1106
  else if Key = 'z' then DoMouseMoveObj := 3
1107
  else DoMouseMoveObj := 0;
1108
end;
1109

1110
procedure TMainForm.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
1111
begin
1112
  DoMouseMoveObj := 0;
1113
end;
1114

1115
procedure TMainForm.CheckBox1Change(Sender: TObject);
1116
begin
1117
  MoleculeAxis.Visible:= not(MoleculeAxis.Visible);
1118
end;
1119

1120
procedure TMainForm.CheckBox2Change(Sender: TObject);
1121
begin
1122
  DCWorld.ShowAxes:= not(DCWorld.ShowAxes);
1123
end;
1124

1125
procedure TMainForm.CheckBox3Change(Sender: TObject);
1126
begin
1127
 DCWorldGrid.Visible:= not(DCWorldGrid.Visible);
1128
end;
1129

1130
procedure TMainForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
1131
begin
1132
  GLCadencer.Enabled:= False;
1133
end;
1134

1135
procedure TMainForm.FormMouseWheel(Sender: TObject; Shift: TShiftState;
1136
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
1137
begin
1138
  //if (MousePoint.X >= GLViewer.Left) and
1139
  //   (MousePoint.X <= GLViewer.Left + GLViewer.Width) and
1140
  //   (MousePoint.Y >= GLViewer.Top) and
1141
  //   (MousePoint.y <= GLViewer.Top + GLViewer.Height) then
1142
  //begin
1143
    { a wheel step = WheelDelta/300; each step adjusts target distance by 2.5%
1144
      another method to zoom in or out }
1145
      GLCamera.AdjustDistanceToTarget(Power(1.025, WheelDelta / 300));
1146
      GLCamera.DepthOfView := 2 * GLCamera.DistanceToTarget + 2 * DCMoleculeWorld.BoundingSphereRadius;
1147
   // end;
1148
    Handled := True;
1149

1150
end;
1151

1152
procedure TMainForm.FormShow(Sender: TObject);
1153
begin
1154
  Mol.CreateMolecule(DCMolecule);
1155
  mmoMolAtoms.Clear;
1156
  mmoMolAtoms.Lines := Mol.getAtomsInfos;
1157
  mmoMolBonds.Clear;
1158
  mmoMolBonds.Lines := Mol.getBondsInfos;
1159
  lblMolName.Caption := Mol.DisplayName;
1160

1161
  ShowCameraLocation;
1162
  ShowFocalLength;
1163
  ShowTargetLocation;
1164
  //ShowLightLocation;
1165

1166
  GLCadencer.Enabled:= true;
1167

1168
end;
1169

1170
procedure TMainForm.GLCadencerProgress(Sender: TObject; const deltaTime,newTime: Double);
1171
begin
1172
  // Fait tourner la scene sur elle même sur l'axe des Y
1173
  if NavCube.InactiveTime > 5 then
1174
  begin
1175
    if NavCube.InactiveTime < 8 then
1176
      GLCamera.TurnAngle := GLCamera.TurnAngle + (NavCube.InactiveTime - 5) * deltaTime * 2
1177
    else
1178
      GLCamera.TurnAngle := GLCamera.TurnAngle + deltatime * 6;
1179
  end;
1180
  GLViewer.Refresh;
1181
  if Self.Focused then GLViewer.Invalidate;
1182
end;
1183

1184
procedure TMainForm.GLViewerMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1185
Var
1186
  AtomData : TAtomData;
1187
begin
1188
  MousePoint.X := X;
1189
  MousePoint.Y := Y;
1190
  if ssCtrl in Shift then
1191
  begin
1192
    if ssRight in Shift then Screen.Cursor := crRotate;
1193
  end
1194
  else if ssShift in Shift then
1195
  begin
1196
    Screen.Cursor := crDrag;
1197
  end
1198
  else
1199
  begin // no Shift, no Ctrl, no Alt
1200
    if ssleft in Shift then
1201
    begin
1202
      if Assigned(CurrentPick) then
1203
      begin
1204
        if CurrentPick is TGLSphere then
1205
        begin
1206
          if not(AtomInfosForm.Visible) then AtomInfosForm.Show;
1207
          AtomData := PeriodicTable.Items[CurrentPick.Tag];
1208
          UpdateAtomInfosForm(AtomData);
1209
        end;
1210
      end;
1211
      if DoMouseMoveObj>0 then
1212
      begin
1213
         NavCube.ActiveMouse := False;
1214
         if (DoMouseMoveObj = 1) then Screen.Cursor := crSlidexy
1215
         else if (DoMouseMoveObj = 2) then Screen.Cursor := crSlidezy
1216
         else if (DoMouseMoveObj = 3) then Screen.Cursor := crSlideyz;
1217
      end
1218
      else
1219
      begin
1220
        Screen.Cursor := crRotate;
1221
        NavCube.ActiveMouse := True;
1222
      end;
1223
    end
1224
    else if ssRight in Shift then Screen.Cursor := crZoom;
1225
  end;
1226

1227
  md:=true;
1228

1229
end;
1230

1231
procedure TMainForm.GLViewerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
1232
var
1233
  d: double;
1234
begin
1235
  if md and (Shift <> []) then
1236
  begin
1237
    if ssLeft in Shift then
1238
    begin
1239
      if ssShift in Shift then
1240
      begin
1241
        if ssCtrl in Shift then
1242
        begin
1243
          d :=  0.01 * (X - MousePoint.x );
1244
          DCTarget.Translate(d, 0, 0);
1245
          d :=  0.01 * (Y - MousePoint.y );
1246
          DCTarget.Translate(0, 0, d);
1247
        end
1248
        else
1249
        begin
1250
          d :=  0.01 * (X - MousePoint.x );
1251
          DCTarget.Translate(d, 0, 0);
1252
          d :=  0.01 * (Y - MousePoint.y );
1253
          DCTarget.Translate(0, d, 0);
1254
        end;
1255
      end
1256
      else
1257
      begin
1258
        if DoMouseMoveObj >0 then   // Translate Object
1259
        begin
1260
          d := GLCamera.DistanceToTarget * 0.01 * (X - MousePoint.x + Y - MousePoint.y);
1261
          if (DoMouseMoveObj = 1) then DCMolecule.Translate(d, 0, 0)
1262
          else if (DoMouseMoveObj = 2) then DCMolecule.Translate(0, d, 0)
1263
          else if (DoMouseMoveObj = 3) then DCMolecule.Translate(0, 0, d);
1264

1265
          // Surely not working under *nix system
1266
          //if IsKeyDown('x') then DCMoleculeWorld.Translate(d, 0, 0)
1267
          //else if IsKeyDown('y') then DCMoleculeWorld.Translate(0, d, 0)
1268
          //else if IsKeyDown('z') then DCMoleculeWorld.Translate(0, 0, d)
1269
        end
1270
        else
1271
        begin // Move Around the world, like a Daft punk
1272
          // NavCube.ActiveMouse:=False;
1273
          GLCamera.MoveAroundTarget((MousePoint.y - Y) * 0.1, (MousePoint.x - X) * 0.1)
1274
        end;
1275
      end;
1276
    end
1277
    else if ssRight in Shift then
1278
    begin
1279
      if ssShift in Shift then   //Adjuste Camera Distance to LookAt Target Object
1280
      begin
1281
        with GLCamera do AdjustDistanceToTarget(Power(1.0125, MousePoint.y - Y));
1282
      end
1283
      else if(ssCtrl in Shift) then  // Rotate Target Object
1284
      begin
1285
        if (ssAlt in Shift) then
1286
          // 1st Solution : Rotate object with a very little step thrue Camera
1287
          GLCamera.RotateObject(DCMolecule, (MousePoint.y - Y) * 0.1, (MousePoint.x - X) * 0.1)
1288
          //GLCamera.RotateObject(DCMolecule, MousePoint.y - Y, MousePoint.x - X);
1289
        else
1290
          begin
1291
            // 2nd Solution : Rotate object directly by using Roll, Turn, Pitch functions
1292
            DCMolecule.Turn(MousePoint.y - Y);
1293
            DCMolecule.Pitch(MousePoint.x - X);
1294

1295
            // 3rd Solution : Rotate object thrue RotationAbsolute Functions
1296
            // DCMolecule.RotateAbsolute(MousePoint.x - X, MousePoint.y - Y,0);
1297

1298
            // 4rd Solution : Rotate object thrue Rotation propertie
1299
            // Note the all the follow lines don't work
1300
            // It's have a bug in the notification scheme of TGLCoordinates object
1301
            // DCMolecule.Rotation.X := MousePoint.x - X;
1302
            // DCMolecule.Rotation.Y := MousePoint.y - Y;
1303
            // or
1304
            //DCMolecule.Rotation.Rotate(XVector,90);
1305
            //DCMolecule.Rotation.Rotate(YVector,45);
1306

1307

1308
          end;
1309
      end
1310
      else
1311
      begin
1312
        with GLCamera do
1313
        begin
1314
          // Change Focal (FOV)
1315
          FocalLength  := FocalLength - (MousePoint.y - Y);
1316
          if FocalLength > 3000 then FocalLength := 3000;   { max focal length }
1317
          if FocalLength < 10 then FocalLength := 10;       { min focal length }
1318
        end;       { display in statusbar palel }
1319
      end;
1320
    end
1321
  end
1322
  else
1323
  begin
1324
    // find what's under the mouse
1325
    CurrentPick := (GLViewer.Buffer.GetPickedObject(x, y) as TGLCustomSceneObject);
1326
    // if it has changed since last MouseMove...
1327
    if (CurrentPick  <> oldPick) then
1328
    begin
1329
      // ...turn to black previous "hot" object...
1330
      if Assigned(oldPick) then
1331
      begin
1332
        if (oldPick is TGLLines) then
1333
          TGLLines(oldPick).LineColor.DirectColor := OldColor
1334
        else
1335
          oldPick.Material.FrontProperties.Emission.Color := clrBlack;
1336
      end;
1337
      // ...and heat up the new selection...
1338
      if Assigned(CurrentPick ) then
1339
      begin
1340
        if CurrentPick is TGLLines then
1341
        begin
1342
          OldColor := TGLLines(CurrentPick).LineColor.DirectColor;
1343
          TGLLines(CurrentPick).LineColor.DirectColor := clrIndian;
1344
        end
1345
        else
1346
          CurrentPick .Material.FrontProperties.Emission.Color := clrIndian;
1347

1348
        LblMolInfo2.Text:= AnsiToUTF8(CurrentPick.Hint);
1349
        LblMolInfo2.Visible:=true;
1350
      end
1351
      else LblMolInfo2.Visible:=False;
1352

1353
      // ...and don't forget it !
1354
      oldPick := CurrentPick ;
1355

1356
    end;
1357
  end;
1358

1359

1360

1361
    MousePoint.X := X;         { update mouse position }
1362
    MousePoint.Y := Y;
1363

1364
end;
1365

1366
procedure TMainForm.GLViewerMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1367
begin
1368
  Screen.Cursor := crDefault;
1369
  md := False;
1370
end;
1371

1372
procedure TMainForm.MainTimerTimer(Sender: TObject);
1373
begin
1374
  ShowCameraLocation;
1375
  ShowFocalLength;
1376
  ShowTargetLocation;
1377
 // ShowLightLocation;
1378
  MainStatusBar.Panels[4].Text := Format('%.1f  FPS', [GLViewer.FramesPerSecond]);
1379
  GLViewer.ResetPerformanceMonitor;
1380
end;
1381

1382
procedure TMainForm.MenuItem2Click(Sender: TObject);
1383
begin
1384
  if OpenDlg.Execute then
1385
  begin
1386
    Mol.LoadFromFile(OpenDlg.FileName);
1387
    Mol.CreateMolecule(DCMolecule);
1388
    mmoMolAtoms.Clear;
1389
    mmoMolAtoms.Lines := Mol.getAtomsInfos;
1390
    mmoMolBonds.Clear;
1391
    mmoMolBonds.Lines := Mol.getBondsInfos;
1392
    lblMolName.Caption := Mol.DisplayName;
1393
  end;
1394
end;
1395

1396
procedure TMainForm.MenuItem4Click(Sender: TObject);
1397
begin
1398
  Application.Terminate;
1399
end;
1400

1401
procedure TMainForm.MenuItem6Click(Sender: TObject);
1402
begin
1403
  HelpCommandsForm.ShowModal;
1404
end;
1405

1406
procedure TMainForm.MenuItem9Click(Sender: TObject);
1407
begin
1408
  CPKForm.Show;
1409
end;
1410

1411
procedure TMainForm.RadioGroup1Click(Sender: TObject);
1412
begin
1413
  Mol.ViewMode:= RadioGroup1.ItemIndex;
1414
  GLViewer.Invalidate;
1415
end;
1416

1417
procedure TMainForm.UpdateAtomInfosForm(anAtom: TAtomData);
1418
begin
1419
  if AtomInfosForm.Visible then
1420
  begin
1421
    with AtomInfosForm do
1422
    begin
1423
      lblAtomName.Caption := anAtom.name;
1424
      lblAtomicNum.Caption := IntToStr(anAtom.atomicNumber);
1425
      lblAtomSym.Caption := anAtom.symbol;
1426
      lblAtomYear.Caption := anAtom.yearDiscovered;
1427
      lblAtomBondType.Caption := cAtomBondingTypeStr[anAtom.bondingType];
1428
      lblIonizationNrj.Caption := IntToStr(anAtom.ionizationEnergy);
1429
      lblElectronAffinity.Caption := IntToStr(anAtom.electronAffinity);
1430
      lblElectronNeg.Caption := FloatToStr(anAtom.electronegativity);
1431
      lblAtomelectronicCfg.Caption := anAtom.electronicConfiguration;
1432
      lblDelWaalsRadius.Caption := FloatToStr(anAtom.vanDelWaalsRadius);
1433
      lblAtomicMass.Caption := anAtom.atomicMass;
1434
      lblonRadius.Caption := anAtom.ionRadius;
1435
      lblAtomicradius.Caption := IntToStr(anAtom.atomicRadius);
1436
      lblAtomDensity.Caption := FloatToStr(anAtom.density);
1437
      lblAtomOxidationState.Caption := anAtom.oxidationStates;
1438
      lblAtomBoilingPoint.Caption := IntToStr(anAtom.boilingPoint);
1439
      lblAtomMeltingPoint.Caption := IntToStr(anAtom.meltingPoint);
1440
      lblAtomStandardState.Caption := cAtomStandardStateStr[anAtom.standardState];
1441
      lblAtomGroup.Caption := anAtom.groupBlock; //cAtomGroupBlockStr[
1442
    end;
1443
  end;
1444
end;
1445

1446

1447
end.
1448

1449