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

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

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