1 | //kt -- Modified with SourceScanner on 8/8/2007
|
---|
2 | unit fOptionsSurrogate;
|
---|
3 |
|
---|
4 | interface
|
---|
5 |
|
---|
6 | uses
|
---|
7 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
---|
8 | StdCtrls, ORCtrls, ORDtTmRng, ORFn, ExtCtrls, DKLang;
|
---|
9 |
|
---|
10 | type
|
---|
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 |
|
---|
41 | var
|
---|
42 | frmOptionsSurrogate: TfrmOptionsSurrogate;
|
---|
43 |
|
---|
44 | procedure DialogOptionsSurrogate(topvalue, leftvalue, fontsize: integer; var info: string);
|
---|
45 |
|
---|
46 | implementation
|
---|
47 |
|
---|
48 | uses rOptions, uOptions, rCore;
|
---|
49 |
|
---|
50 | var
|
---|
51 | Surrogate, TempSurrogate: TSurrogate;
|
---|
52 |
|
---|
53 | {$R *.DFM}
|
---|
54 |
|
---|
55 | procedure DialogOptionsSurrogate(topvalue, leftvalue, fontsize: integer; var info: string);
|
---|
56 | // create the form and make it modal
|
---|
57 | var
|
---|
58 | frmOptionsSurrogate: TfrmOptionsSurrogate;
|
---|
59 | begin
|
---|
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;
|
---|
101 | end;
|
---|
102 |
|
---|
103 | procedure TfrmOptionsSurrogate.FormShow(Sender: TObject);
|
---|
104 | begin
|
---|
105 | cboSurrogate.InitLongList(Surrogate.Name);
|
---|
106 | cboSurrogate.SelectByIEN(Surrogate.IEN);
|
---|
107 | LabelInfo;
|
---|
108 | end;
|
---|
109 |
|
---|
110 | procedure TfrmOptionsSurrogate.btnSurrogateDateRangeClick(Sender: TObject);
|
---|
111 | var
|
---|
112 | TempFMDate: TFMDateTime;
|
---|
113 | ok : boolean;
|
---|
114 | begin
|
---|
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;
|
---|
148 | end;
|
---|
149 |
|
---|
150 | procedure TfrmOptionsSurrogate.cboSurrogateNeedData(
|
---|
151 | Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer);
|
---|
152 | begin
|
---|
153 | cboSurrogate.ForDataUse(SubSetOfPersons(StartFrom, Direction));
|
---|
154 | end;
|
---|
155 |
|
---|
156 | procedure TfrmOptionsSurrogate.btnOKClick(Sender: TObject);
|
---|
157 | var
|
---|
158 | info, msg: string;
|
---|
159 | ok: boolean;
|
---|
160 | begin
|
---|
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;
|
---|
185 | end;
|
---|
186 |
|
---|
187 | procedure TfrmOptionsSurrogate.btnRemoveClick(Sender: TObject);
|
---|
188 | begin
|
---|
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;
|
---|
199 | end;
|
---|
200 |
|
---|
201 | procedure TfrmOptionsSurrogate.LabelInfo;
|
---|
202 | begin
|
---|
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;
|
---|
229 | end;
|
---|
230 |
|
---|
231 | procedure TfrmOptionsSurrogate.cboSurrogateChange(Sender: TObject);
|
---|
232 | begin
|
---|
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;
|
---|
247 | end;
|
---|
248 |
|
---|
249 | procedure TfrmOptionsSurrogate.cboSurrogateKeyDown(Sender: TObject;
|
---|
250 | var Key: Word; Shift: TShiftState);
|
---|
251 | begin
|
---|
252 | if cboSurrogate.ItemIndex = -1 then // allow typing to do change event
|
---|
253 | Application.ProcessMessages;
|
---|
254 | end;
|
---|
255 |
|
---|
256 | end.
|
---|