source: cprs/branches/tmg-cprs/CPRS-Chart/Options/fOptionsSurrogate.pas@ 489

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

Initial upload of TMG-CPRS 1.0.26.69

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