source: cprs/branches/foia-cprs/CPRS-Chart/Options/fOptionsSurrogate.pas@ 1382

Last change on this file since 1382 was 459, checked in by Kevin Toppenberg, 16 years ago

Adding foia-cprs branch

File size: 6.5 KB
Line 
1unit fOptionsSurrogate;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, ORCtrls, ORDtTmRng, ORFn, ExtCtrls;
8
9type
10 TfrmOptionsSurrogate = class(TForm)
11 lblSurrogate: TLabel;
12 cboSurrogate: TORComboBox;
13 btnSurrogateDateRange: TButton;
14 dlgSurrogateDateRange: TORDateRangeDlg;
15 lblSurrogateText: TStaticText;
16 btnRemove: TButton;
17 lblStart: TStaticText;
18 lblStop: TStaticText;
19 pnlBottom: TPanel;
20 bvlBottom: TBevel;
21 btnCancel: TButton;
22 btnOK: TButton;
23 procedure FormShow(Sender: TObject);
24 procedure btnSurrogateDateRangeClick(Sender: TObject);
25 procedure cboSurrogateNeedData(Sender: TObject;
26 const StartFrom: String; Direction, InsertAt: Integer);
27 procedure btnOKClick(Sender: TObject);
28 procedure btnRemoveClick(Sender: TObject);
29 procedure cboSurrogateChange(Sender: TObject);
30 procedure cboSurrogateKeyDown(Sender: TObject; var Key: Word;
31 Shift: TShiftState);
32 private
33 { Private declarations }
34 procedure LabelInfo;
35 public
36 { Public declarations }
37 end;
38
39var
40 frmOptionsSurrogate: TfrmOptionsSurrogate;
41
42procedure DialogOptionsSurrogate(topvalue, leftvalue, fontsize: integer; var info: string);
43
44implementation
45
46uses rOptions, uOptions, rCore;
47
48var
49 Surrogate, TempSurrogate: TSurrogate;
50
51{$R *.DFM}
52
53procedure DialogOptionsSurrogate(topvalue, leftvalue, fontsize: integer; var info: string);
54// create the form and make it modal
55var
56 frmOptionsSurrogate: TfrmOptionsSurrogate;
57begin
58 frmOptionsSurrogate := TfrmOptionsSurrogate.Create(Application);
59 Surrogate := TSurrogate.Create; // saved settings
60 TempSurrogate := TSurrogate.Create; // unsaved settings
61 try
62 with frmOptionsSurrogate do
63 begin
64 if (topvalue < 0) or (leftvalue < 0) then
65 Position := poScreenCenter
66 else
67 begin
68 Position := poDesigned;
69 Top := topvalue;
70 Left := leftvalue;
71 end;
72 ResizeAnchoredFormToFont(frmOptionsSurrogate);
73 with Surrogate do
74 begin
75 IEN := StrToInt64Def(Piece(info, '^', 1), -1);
76 Name := Piece(info, '^', 2);
77 Start := MakeFMDateTime(Piece(info, '^', 3));
78 Stop := MakeFMDateTime(Piece(info, '^', 4));
79 end;
80 with TempSurrogate do
81 begin
82 IEN := Surrogate.IEN;
83 Name := Surrogate.Name;
84 Start := Surrogate.Start;
85 Stop := Surrogate.Stop;
86 end;
87 ShowModal;
88 info := '';
89 info := info + IntToStr(Surrogate.IEN) + '^';
90 info := info + Surrogate.Name + '^';
91 info := info + FloatToStr(Surrogate.Start) + '^';
92 info := info + FloatToStr(Surrogate.Stop) + '^';
93 end;
94 finally
95 frmOptionsSurrogate.Release;
96 Surrogate.Free;
97 TempSurrogate.Free;
98 end;
99end;
100
101procedure TfrmOptionsSurrogate.FormShow(Sender: TObject);
102begin
103 cboSurrogate.InitLongList(Surrogate.Name);
104 cboSurrogate.SelectByIEN(Surrogate.IEN);
105 LabelInfo;
106end;
107
108procedure TfrmOptionsSurrogate.btnSurrogateDateRangeClick(Sender: TObject);
109var
110 TempFMDate: TFMDateTime;
111 ok : boolean;
112begin
113 ok := false;
114 with dlgSurrogateDateRange do
115 while not ok do
116 begin
117 FMDateStart := TempSurrogate.Start;
118 FMDateStop := TempSurrogate.Stop;
119 if Execute then
120 begin
121 If (FMDateStop <> 0) and (FMDateStart > FMDateStop) then
122 begin
123 TempFMDate := FMDateStart;
124 FMDateStart := FMDateStop;
125 FMDateStop := TempFMDate;
126 end;
127 with TempSurrogate do
128 begin
129 Start := FMDateStart;
130 Stop := FMDateStop;
131 LabelInfo;
132 if (Stop <> 0) and (Stop < DateTimeToFMDateTime(Now)) then
133 begin
134 beep;
135 InfoBox('Stop Date must be in the future.', 'Warning', MB_OK or MB_ICONWARNING);
136 Stop := 0;
137 end
138 else
139 ok := true;
140 end;
141 end
142 else
143 ok := true;
144 end;
145end;
146
147procedure TfrmOptionsSurrogate.cboSurrogateNeedData(
148 Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer);
149begin
150 cboSurrogate.ForDataUse(SubSetOfPersons(StartFrom, Direction));
151end;
152
153procedure TfrmOptionsSurrogate.btnOKClick(Sender: TObject);
154var
155 info, msg: string;
156 ok: boolean;
157begin
158 rpcCheckSurrogate(TempSurrogate.IEN, ok, msg);
159 if not ok then
160 begin
161 beep;
162 InfoBox(msg, 'Warning', MB_OK or MB_ICONWARNING);
163 ModalResult := mrNone;
164 end
165 else
166 begin
167 ModalResult := mrOK;
168 with Surrogate do
169 begin
170 IEN := TempSurrogate.IEN;
171 Name := TempSurrogate.Name;
172 Start := TempSurrogate.Start;
173 Stop := TempSurrogate.Stop;
174 end;
175 info := '';
176 info := info + IntToStr(Surrogate.IEN) + '^';
177 info := info + FloatToStr(Surrogate.Start) + '^';
178 info := info + FloatToStr(Surrogate.Stop) + '^';
179 rpcSetSurrogateInfo(info);
180 end;
181end;
182
183procedure TfrmOptionsSurrogate.btnRemoveClick(Sender: TObject);
184begin
185 cboSurrogate.ItemIndex := -1;
186 cboSurrogate.Text := '';
187 with TempSurrogate do
188 begin
189 IEN := -1;
190 Name := '';
191 Start := 0;
192 Stop := 0;
193 end;
194 LabelInfo;
195end;
196
197procedure TfrmOptionsSurrogate.LabelInfo;
198begin
199 with TempSurrogate do
200 begin
201 btnRemove.Enabled := length(Name) > 0;
202 btnSurrogateDateRange.Enabled := length(Name) > 0;
203 if length(Name) > 0 then
204 lblSurrogateText.Caption := Name
205 else
206 begin
207 lblSurrogateText.Caption := '<no surrogate designated>';
208 Start := 0;
209 Stop := 0;
210 end;
211 if Start > 0 then
212 lblStart.Caption := 'from: ' + FormatFMDateTime('mmm d,yyyy@hh:nn', Start)
213 else
214 lblStart.Caption := 'from: <now>';
215 if Stop > 0 then
216 lblStop.Caption := 'until: ' + FormatFMDateTime('mmm d,yyyy@hh:nn', Stop)
217 else
218 lblStop.Caption := 'until: <changed>';
219 end;
220end;
221
222procedure TfrmOptionsSurrogate.cboSurrogateChange(Sender: TObject);
223begin
224 with cboSurrogate do
225 if (ItemIndex = -1) or (Text = '') then
226 begin
227 TempSurrogate.IEN := -1;
228 TempSurrogate.Name := '';
229 ItemIndex := -1;
230 Text := '';
231 end
232 else
233 begin
234 TempSurrogate.IEN := ItemIEN;
235 TempSurrogate.Name := DisplayText[cboSurrogate.ItemIndex];
236 end;
237 LabelInfo;
238end;
239
240procedure TfrmOptionsSurrogate.cboSurrogateKeyDown(Sender: TObject;
241 var Key: Word; Shift: TShiftState);
242begin
243 if cboSurrogate.ItemIndex = -1 then // allow typing to do change event
244 Application.ProcessMessages;
245end;
246
247end.
Note: See TracBrowser for help on using the repository browser.