source: cprs/branches/tmg-cprs/CPRS-Chart/Orders/fOtherSchedule.pas@ 799

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

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