LightCurveViewer/unitTableDialog.pas at main · mpyat2/LightCurveViewer · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
unit unitTableDialog;

{$mode ObjFPC}{$H+}

{$include lcv.inc}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Grids, Menus, ActnList,
  ExtCtrls, StdCtrls, lcvtypes;

type

  { TFormTable }

  TFormTable = class(TForm)
    ActionSelectAll: TAction;
    ActionCopy: TAction;
    ActionList1: TActionList;
    Button1: TButton;
    DrawGrid1: TDrawGrid;
    MenuItem1: TMenuItem;
    MenuItemCopy: TMenuItem;
    Panel1: TPanel;
    PopupMenu1: TPopupMenu;
    procedure ActionCopyExecute(Sender: TObject);
    procedure ActionSelectAllExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    FTimes: TDoubleArray;
    FMagnitudes: TDoubleArray;
    FErrors: TDoubleArray;
    FPeriod: Double;
    FEpoch: Double;
    function GetGridCell(Grid: TDrawGrid; C, R: Integer): string;
    procedure GridDrawCell(Sender: TObject; aCol, aRow: Integer; aRect: TRect; aState: TGridDrawState);
  public

  end;

procedure ShowObservations(const Times, Magnitudes, Errors: TDoubleArray; Period, Epoch: Double; Title: string);

implementation

{$R *.lfm}

uses
  DateUtils, Clipbrd, math, miscutils, guiutils;

procedure ShowObservations(const Times, Magnitudes, Errors: TDoubleArray; Period, Epoch: Double; Title: string);
var
  F: TFormTable;
begin
  if Length(times) <> Length(magnitudes) then
    raise Exception.Create('X and Y arrays must be of equal length');
  F := TFormTable.Create(Application);
  try
    F.Caption := Title;
    F.FTimes := Times;
    F.FMagnitudes := Magnitudes;
    F.FErrors := Errors;
    F.FPeriod := Period;
    F.FEpoch := Epoch;
    if (not IsNan(Period)) and (not IsNan(Epoch)) then
      F.DrawGrid1.ColCount := 6
    else
      F.DrawGrid1.ColCount := 5;
    F.DrawGrid1.FixedCols := 1;
    F.DrawGrid1.RowCount := Length(Times) + 1;
    F.DrawGrid1.FixedRows := 1;
    F.ShowModal;
  finally
    FreeAndNil(F);
  end;
end;

{ TFormTable }

procedure TFormTable.FormCreate(Sender: TObject);
begin
  DrawGrid1.OnDrawCell := @GridDrawCell;
  DrawGrid1.DefaultColWidth := 128;
  DrawGrid1.ColWidths[0] := 64;
end;

procedure TFormTable.ActionCopyExecute(Sender: TObject);
var
  WCursorIntf: IUnknown;
begin
  WCursorIntf := TWaitCursor.Create as IUnknown; // will be freed automatically
  Clipboard.AsText := GetGridSelectionAsText(DrawGrid1, @GetGridCell);
end;

procedure TFormTable.ActionSelectAllExecute(Sender: TObject);
var
  Selection: TRect;
begin
  Selection.Top := DrawGrid1.FixedRows;
  Selection.Bottom := DrawGrid1.RowCount - 1;
  Selection.Left := DrawGrid1.FixedCols;
  Selection.Right := DrawGrid1.ColCount - 1;
  DrawGrid1.Selection := Selection;
end;

function TFormTable.GetGridCell(Grid: TDrawGrid; C, R: Integer): string;
var
  DateTime: TDateTime;
  Idx: Integer;
begin
  Result := '';
  if R < 1 then begin
    case C of
      1: Result := 'Time';
      2: Result := 'Magnitude';
      3: Result := 'Error';
      4: Result := 'Calendar Date/Time';
      5: Result := 'Phase';
    end;
  end
  else begin
    Idx := R - 1;
    if (Idx >= 0) and (Idx < Length(FTimes)) then begin
      case C of
        0: Result := Format('%8d', [Idx + 1]);
        1: Result := FloatToStr(FTimes[Idx]);
        2: Result := FloatToStr(FMagnitudes[Idx]);
        3: Result := FloatToStr(FErrors[Idx]);
        4: try
             DateTime := JulianDateToDateTime(FTimes[Idx]);
             Result := FormatDateTime('yyyy"-"mm"-"dd" "hh":"nn":"ss', DateTime);
           except
             on E: Exception do begin
               Result := E.Message;
             end;
           end;
        5: try
             Result := FloatToStr(CalculatePhase(FTimes[Idx], FPeriod, FEpoch));
           except
             on E: Exception do begin
               Result := E.Message;
             end;
           end;
      end;
    end;
  end;
end;

procedure TFormTable.GridDrawCell(Sender: TObject; aCol, aRow: Integer; aRect: TRect; aState: TGridDrawState);
var
  GridCanvas: TCanvas;
begin
  GridCanvas := DrawGrid1.Canvas;
  GridCanvas.TextRect(aRect, aRect.Left + 2, aRect.Top + 2, GetGridCell(DrawGrid1, aCol, aRow));
end;


end.