source: cprs/branches/foia-cprs/CPRS-Chart/Orders/fOtherSchedule.pas@ 459

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

Adding foia-cprs branch
File size: 13.8 KB
Line 
1unit fOtherSchedule;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, ComCtrls, StdCtrls, ExtCtrls, Buttons, fAutoSz, rMisc;
8
9const
10 NSS_TXT = 'This order will not become active until a valid schedule is used.';
11
12type
13 TfrmOtherSchedule = class(TfrmAutoSz)
14 Panel1: TPanel;
15 Image1: TImage;
16 Panel3: TPanel;
17 GroupBox1: TGroupBox;
18 cbo7: TCheckBox;
19 cbo1: TCheckBox;
20 cbo2: TCheckBox;
21 cbo3: TCheckBox;
22 cbo4: TCheckBox;
23 cbo5: TCheckBox;
24 cbo6: TCheckBox;
25 GroupBox2: TGroupBox;
26 lstHour: TListBox;
27 lstMinute: TListBox;
28 Panel4: TPanel;
29 btn0k1: TButton;
30 btnCancel: TButton;
31 txtSchedule: TEdit;
32 Label1: TLabel;
33 btnReset: TButton;
34 btnRemove: TButton;
35 memMessage: TMemo;
36 Splitter1: TSplitter;
37 procedure FormCreate(Sender: TObject);
38 procedure btnCancelClick(Sender: TObject);
39 procedure btn0k1Click(Sender: TObject);
40 procedure cbo7Click(Sender: TObject);
41 procedure cbo1Click(Sender: TObject);
42 procedure cbo2Click(Sender: TObject);
43 procedure cbo3Click(Sender: TObject);
44 procedure cbo4Click(Sender: TObject);
45 procedure cbo5Click(Sender: TObject);
46 procedure cbo6Click(Sender: TObject);
47 procedure btnAddClick(Sender: TObject);
48 procedure btnResetClick(Sender: TObject);
49 procedure btnRemoveClick(Sender: TObject);
50 procedure FormClose(Sender: TObject; var Action: TCloseAction);
51 procedure lstHourClick(Sender: TObject);
52 procedure txtScheduleChange(Sender: TObject);
53 procedure lstMinuteMouseUp(Sender: TObject; Button: TMouseButton;
54 Shift: TShiftState; X, Y: Integer);
55 procedure lstMinuteKeyDown(Sender: TObject; var Key: Word;
56 Shift: TShiftState);
57 private
58 FDaySchedule: array [1..7] of string;
59 FTimeSchedule: TStringList;
60 FOtherSchedule: String;
61 FFromCheckBox: boolean;
62 FFromEditBox: boolean;
63 function GetSiteMessage: string;
64 procedure SetDaySchedule(Sender: TObject);
65 procedure SetTimeSchedule;
66 procedure UpdateOnFreeTextInput;
67 function CheckDay(ADayStr: string): string;
68 public
69 end;
70
71function ShowOtherSchedule(var ASchedule: string): boolean;
72
73implementation
74
75uses ORFn, ORNet, rOrders;
76{$R *.dfm}
77
78function ShowOtherSchedule(var ASchedule: string): boolean;
79var
80 frmOtherSchedule: TfrmOtherSchedule;
81begin
82 Result := False;
83 try
84 frmOtherSchedule := TfrmOtherSchedule.Create(Application);
85 ResizeFormToFont(TForm(frmOtherSchedule));
86 SetFormPosition(frmOtherSchedule);
87 if frmOtherSchedule.ShowModal = mrOK then
88 begin
89 ASchedule := frmOtherSchedule.FOtherSchedule;
90 Result := True;
91 end;
92 except
93 ShowMessage('Error happen when building other schedule');
94 end;
95end;
96
97
98procedure TfrmOtherSchedule.FormCreate(Sender: TObject);
99var
100 i: integer;
101 nssMsg: string;
102begin
103 FFromCheckBox := False;
104 FFromEditBox := False;
105 image1.Picture.Icon.Handle := LoadIcon(0, IDI_WARNING);
106 for i := 1 to 7 do
107 FDaySchedule[i] := '';
108 FTimeSchedule := TStringlist.Create;
109 FOtherSchedule := '';
110 nssMsg := GetSiteMessage;
111 if Length(nssMsg)< 1 then
112 nssMsg := NSS_TXT;
113 memMessage.Lines.Add(nssMsg);
114end;
115
116procedure TfrmOtherSchedule.btnCancelClick(Sender: TObject);
117begin
118 modalResult := mrCancel;
119end;
120
121procedure TfrmOtherSchedule.btn0k1Click(Sender: TObject);
122begin
123 if not IsValidSchStr(FOtherSchedule) then
124 begin
125 ShowMessage('The schedule you entered is invalid!');
126 Exit;
127 end;
128 modalResult := mrOK;
129end;
130
131procedure TfrmOtherSchedule.SetDaySchedule(Sender: TObject);
132var
133 i : integer;
134 TimePart, DayPart: string;
135begin
136 with (Sender as TCheckBox) do
137 begin
138 try
139 if TCheckBox(Sender).Checked then
140 FDaySchedule[TCheckBox(Sender).Tag] := Copy(TCheckBox(Sender).Caption,0,2)
141 else
142 FDaySchedule[TCheckBox(Sender).Tag] := '';
143 except
144 ShowMessage('Error happened when building day schedule.');
145 Exit;
146 end;
147 end;
148
149 TimePart := '';
150 DayPart := '';
151 for i := 0 to FTimeSchedule.Count - 1 do
152 begin
153 if i = 0 then TimePart := TimePart + FTimeSchedule[i]
154 else TimePart := TimePart + '-' + FTimeSchedule[i];
155 end;
156 for i := Low(FDaySchedule) to High(FDaySchedule) do
157 begin
158 if Length(FDaySchedule[i])>0 then
159 begin
160 if DayPart = '' then DayPart := FDaySchedule[i]
161 else DayPart := DayPart + '-' + FDaySchedule[i];
162 end;
163 end;
164 if Length(TimePart) > 0 then
165 begin
166 if Length(DayPart) > 0 then
167 FOtherSchedule := DayPart + '@' + TimePart
168 else if Length(DayPart) = 0 then
169 FOtherSchedule := TimePart;
170 end
171 else FOtherSchedule := DayPart;
172 txtSchedule.Text := FOtherSchedule;
173end;
174
175procedure TfrmOtherSchedule.SetTimeSchedule;
176var
177 i : integer;
178 TimePart, DayPart: string;
179begin
180 TimePart := '';
181 DayPart := '';
182 for i := 0 to FTimeSchedule.Count - 1 do
183 begin
184 if i = 0 then TimePart := TimePart + FTimeSchedule[i]
185 else TimePart := TimePart + '-' + FTimeSchedule[i];
186 end;
187 for i := Low(FDaySchedule) to High(FDaySchedule) do
188 begin
189 if Length(FDaySchedule[i])>0 then
190 begin
191 if DayPart = '' then DayPart := FDaySchedule[i]
192 else DayPart := DayPart + '-' + FDaySchedule[i];
193 end;
194 end;
195 if Length(DayPart) > 0 then
196 begin
197 if Length(TimePart) > 0 then
198 FOtherSchedule := DayPart + '@' + TimePart
199 else
200 FOtherSchedule := DayPart;
201 end
202 else FOtherSchedule := TimePart;
203 txtSchedule.Text := FOtherSchedule;
204end;
205
206procedure TfrmOtherSchedule.cbo7Click(Sender: TObject);
207begin
208 FFromCheckBox := True;
209 if not FFromEditBox then
210 SetDaySchedule(Sender);
211 FFromCheckBox := False;
212end;
213
214procedure TfrmOtherSchedule.cbo1Click(Sender: TObject);
215begin
216 FFromCheckBox := True;
217 if not FFromEditBox then
218 SetDaySchedule(Sender);
219 FFromCheckBox := False;
220end;
221
222procedure TfrmOtherSchedule.cbo2Click(Sender: TObject);
223begin
224 FFromCheckBox := True;
225 if not FFromEditBox then
226 SetDaySchedule(Sender);
227 FFromCheckBox := False;
228end;
229
230procedure TfrmOtherSchedule.cbo3Click(Sender: TObject);
231begin
232 FFromCheckBox := True;
233 if not FFromEditBox then
234 SetDaySchedule(Sender);
235 FFromCheckBox := False;
236end;
237
238procedure TfrmOtherSchedule.cbo4Click(Sender: TObject);
239begin
240 FFromCheckBox := True;
241 if not FFromEditBox then
242 SetDaySchedule(Sender);
243 FFromCheckBox := False;
244end;
245
246procedure TfrmOtherSchedule.cbo5Click(Sender: TObject);
247begin
248 FFromCheckBox := True;
249 if not FFromEditBox then
250 SetDaySchedule(Sender);
251 FFromCheckBox := False;
252end;
253
254procedure TfrmOtherSchedule.cbo6Click(Sender: TObject);
255begin
256 FFromCheckBox := True;
257 if not FFromEditBox then
258 SetDaySchedule(Sender);
259 FFromCheckBox := False;
260end;
261
262procedure TfrmOtherSchedule.btnAddClick(Sender: TObject);
263var
264 hour, min: string;
265begin
266 if lstHour.ItemIndex < 0 then exit;
267 hour := lstHour.Items[lstHour.ItemIndex];
268 hour := Trim(Copy(hour,1,3));
269 if length(Trim(hour)) = 1 then
270 hour := '0' + Trim(hour);
271 if lstMinute.ItemIndex >= 0 then
272 begin
273 min := lstMinute.Items[lstMinute.itemIndex];
274 min := Copy(min,2,2);
275 end;
276 if min = '' then min := '00';
277 if (hour='00') and (min='00') then hour := '24';
278 if FTimeSchedule.IndexOf(hour)>=0 then
279 begin
280 FTimeSchedule[FTimeSchedule.IndexOf(hour)] := hour + min;
281 end;
282 if FTimeSchedule.IndexOf(hour+min) < 0 then
283 FTimeSchedule.Add(hour+min);
284 FTimeSchedule.Sort;
285 SetTimeSchedule;
286end;
287
288procedure TfrmOtherSchedule.btnResetClick(Sender: TObject);
289var
290 i : integer;
291begin
292 cbo1.Checked := false;
293 cbo2.Checked := false;
294 cbo3.Checked:= false;
295 cbo4.Checked := false;
296 cbo5.Checked := false;
297 cbo6.Checked := false;
298 cbo7.Checked := false;
299 lstHour.ItemIndex := -1;
300 lstMinute.ItemIndex := -1;
301 for i := low(FDaySchedule) to high(FDaySchedule) do
302 FDaySchedule[i] := '';
303 FTimeSchedule.Clear;
304 FOtherSchedule := '';
305 txtSchedule.Text := '';
306end;
307
308procedure TfrmOtherSchedule.btnRemoveClick(Sender: TObject);
309var
310 hour, min: string;
311 idx : integer;
312begin
313 FFromCheckBox := True;
314 if lstHour.ItemIndex >= 0 then
315 begin
316 hour := lstHour.Items[lstHour.ItemIndex];
317 hour := Trim(Copy(hour,1,3));
318 if length(hour) = 1 then
319 hour := '0' + Trim(hour);
320 end;
321 if lstMinute.ItemIndex >= 0 then
322 begin
323 min := lstMinute.Items[lstMinute.itemIndex];
324 min := Copy(min,2,2);
325 end;
326 if min = '' then min := '00';
327 if (hour='00') and (min='00') then hour := '24';
328 idx := FTimeSchedule.IndexOf(hour+min);
329 if idx > -1 then
330 FTimeSchedule.Delete(idx);
331 FTimeSchedule.Sort;
332 SetTimeSchedule;
333 FFromCheckBox := False;
334end;
335
336function TfrmOtherSchedule.GetSiteMessage: string;
337var
338 i: integer;
339 rstStr: string;
340begin
341 rstStr := '';
342 CallV('ORWNSS NSSMSG',[nil]);
343 for i := 0 to RPCBrokerV.Results.Count - 1 do
344 rstStr := rstStr + RPCBrokerV.Results[i];
345 Result := rstStr;
346end;
347
348procedure TfrmOtherSchedule.FormClose(Sender: TObject;
349 var Action: TCloseAction);
350begin
351 try
352 inherited;
353 SaveUserBounds(Self);
354 Action := caFree;
355 except
356 Action := caFree;
357 end;
358end;
359
360procedure TfrmOtherSchedule.UpdateOnFreeTextInput;
361var
362 dayStr,timeStr: string;
363 dayList: TStringList;
364 i,Code,cnt : integer;
365 OrigSch: string;
366
367 procedure updateCheckbox(aDList: TStringList);
368 var
369 idx: integer;
370 begin
371 for idx := aDList.Count - 1 downto 0 do
372 begin
373 if ((CheckDay(aDList[idx]) = 'SUN') or (CheckDay(aDList[idx]) = 'SU')) then
374 begin
375 cbo7.Checked := true;
376 aDList[idx] := 'SU';
377 FDaySchedule[cbo7.tag] := 'SU';
378 end
379 else if ((CheckDay(aDList[idx]) = 'MON') or (CheckDay(aDList[idx]) = 'MO')) then
380 begin
381 cbo1.Checked := true;
382 aDList[idx] := 'MO';
383 FDaySchedule[cbo1.tag] := 'MO';
384 end
385 else if ((CheckDay(aDList[idx]) = 'TUE') or (CheckDay(aDList[idx]) = 'TU')) then
386 begin
387 cbo2.Checked := true;
388 aDList[idx] := 'TU';
389 FDaySchedule[cbo2.tag] := 'TU';
390 end
391 else if ((CheckDay(aDList[idx]) = 'WED') or (CheckDay(aDList[idx]) = 'WE')) then
392 begin
393 cbo3.Checked := true;
394 aDList[idx] := 'WE';
395 FDaySchedule[cbo3.tag] := 'WE';
396 end
397 else if ((CheckDay(aDList[idx]) = 'THU') or (CheckDay(aDList[idx]) = 'TH')) then
398 begin
399 cbo4.Checked := true;
400 aDList[idx] := 'TH';
401 FDaySchedule[cbo4.tag] := 'TH';
402 end
403 else if ((CheckDay(aDList[idx]) = 'FRI') or (CheckDay(aDList[idx]) = 'FR')) then
404 begin
405 cbo5.Checked := true;
406 aDList[idx] := 'FR';
407 FDaySchedule[cbo5.tag] := 'FR';
408 end
409 else if ((CheckDay(aDList[idx]) = 'SAT') or (CheckDay(aDList[idx]) = 'SA')) then
410 begin
411 cbo6.Checked := true;
412 aDList[idx] := 'SA';
413 FDaySchedule[cbo6.tag] := 'SA';
414 end
415 else aDList.Delete(idx);
416 end;
417 end;
418
419begin
420 inherited;
421 i := 0;
422 dayStr := '';
423 timeStr := '';
424 if Length (txtSchedule.Text) = 0 then
425 begin
426 FOtherSchedule := '';
427 btnReset.Click;
428 Exit;
429 end;
430 OrigSch := txtSchedule.Text;
431 dayList := TStringList.Create;
432 if Pos('@',txtSchedule.Text)>0 then
433 begin
434 dayStr := Trim(Piece(txtSchedule.Text,'@',1));
435 timeStr := Trim(Piece(txtSchedule.Text,'@',2));
436 end else
437 begin
438 Val(Piece(txtSchedule.Text,'-',1), i, Code);
439 if Code <> 0 then dayStr := Trim(txtSchedule.Text)
440 else timeStr := Trim(txtSchedule.Text);
441 end;
442 FTimeSchedule.Clear;
443 for cnt := Low(FDaySchedule) to High(FDaySchedule) do
444 FDaySchedule[cnt] := '';
445 PiecesToList(timeStr, '-', FTimeSchedule);
446 if Length(dayStr)>0 then
447 begin
448 PiecesToList(dayStr, '-', dayList);
449 cbo7.Checked := False;
450 cbo1.Checked := False;
451 cbo2.Checked := False;
452 cbo3.Checked := False;
453 cbo4.Checked := False;
454 cbo5.Checked := False;
455 cbo6.Checked := False;
456 updateCheckbox(dayList);
457 end;
458
459 FOtherSchedule := txtSchedule.Text;
460end;
461
462procedure TfrmOtherSchedule.lstHourClick(Sender: TObject);
463begin
464 inherited;
465 lstMinute.ItemIndex := -1;
466end;
467
468procedure TfrmOtherSchedule.txtScheduleChange(Sender: TObject);
469begin
470 inherited;
471 FFromEditBox := True;
472 if not FFromCheckBox then
473 UpdateOnFreeTextInput;
474 FFromEditBox := False;
475end;
476
477function TfrmOtherSchedule.CheckDay(ADayStr: string): string;
478var
479 lng: integer;
480begin
481 lng := Length(ADayStr);
482 if lng <2 then
483 begin
484 result := '';
485 Exit;
486 end;
487 if (lng < 7) and ( UpperCase(aDayStr)= Copy('SUNDAY',1,lng)) then
488 result := 'SU'
489 else if (lng < 7) and (UpperCase(aDayStr)= Copy('MONDAY',1,lng)) then
490 result := 'MO'
491 else if (lng < 8) and (UpperCase(aDayStr)= Copy('TUESDAY',1,lng)) then
492 result := 'TU'
493 else if (lng < 10) and (UpperCase(aDayStr)= Copy('WEDNESDAY',1,lng)) then
494 result := 'WE'
495 else if (lng < 9) and (UpperCase(aDayStr)= Copy('THURSDAY',1,lng)) then
496 result := 'TH'
497 else if (lng < 7) and (UpperCase(aDayStr)= Copy('FRIDAY',1,lng)) then
498 result := 'FR'
499 else if (lng < 9) and (UpperCase(aDayStr)= Copy('SATURDAY',1,lng)) then
500 result := 'SA'
501 else
502 result := '';
503end;
504
505procedure TfrmOtherSchedule.lstMinuteMouseUp(Sender: TObject;
506 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
507begin
508 inherited;
509 FFromCheckBox := True;
510 if lstHour.ItemIndex < 0 then Exit;
511 btnAddClick(Self);
512 FFromCheckBox := False;
513end;
514
515procedure TfrmOtherSchedule.lstMinuteKeyDown(Sender: TObject;
516 var Key: Word; Shift: TShiftState);
517begin
518 inherited;
519 if (Key=VK_RETURN) then
520 begin
521 FFromCheckBox := True;
522 if lstHour.ItemIndex < 0 then Exit;
523 btnAddClick(Self);
524 FFromCheckBox := False;
525 end;
526end;
527
528end.
529
Note: See TracBrowser for help on using the repository browser.