source: cprs/trunk/CPRS-Chart/Options/fOptionsSurrogate.pas@ 1742

Last change on this file since 1742 was 829, checked in by Kevin Toppenberg, 14 years ago

Upgrade to version 27

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