source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/fRemCoverSheet.pas@ 1679

Last change on this file since 1679 was 830, checked in by Kevin Toppenberg, 14 years ago

Upgrading to version 27
File size: 55.2 KB
Line 
1unit fRemCoverSheet;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 ORCtrls, StdCtrls, ExtCtrls, ComCtrls, ImgList, mImgText, Buttons, ORClasses, fBase508Form,
8 VA508AccessibilityManager, VA508ImageListLabeler;
9
10type
11 TRemCoverDataLevel = (dlPackage, dlSystem, dlDivision, dlService, dlLocation, dlUserClass, dlUser);
12
13 TfrmRemCoverSheet = class(TfrmBase508Form)
14 pnlBottom: TORAutoPanel;
15 pnlUser: TPanel;
16 cbxUserLoc: TORComboBox;
17 lblRemLoc: TLabel;
18 pnlMiddle: TPanel;
19 pnlRight: TPanel;
20 mlgnCat: TfraImgText;
21 mlgnRem: TfraImgText;
22 mlgnAdd: TfraImgText;
23 pnlCAC: TORAutoPanel;
24 mlgnRemove: TfraImgText;
25 mlgnLock: TfraImgText;
26 imgMain: TImageList;
27 sbUp: TBitBtn;
28 sbDown: TBitBtn;
29 btnAdd: TBitBtn;
30 btnRemove: TBitBtn;
31 btnLock: TBitBtn;
32 pnlBtns: TPanel;
33 btnOK: TButton;
34 btnCancel: TButton;
35 edtSeq: TCaptionEdit;
36 udSeq: TUpDown;
37 lblSeq: TLabel;
38 btnApply: TButton;
39 cbSystem: TORCheckBox;
40 cbDivision: TORCheckBox;
41 cbService: TORCheckBox;
42 cbxService: TORComboBox;
43 cbxDivision: TORComboBox;
44 cbLocation: TORCheckBox;
45 cbUserClass: TORCheckBox;
46 cbUser: TORCheckBox;
47 cbxUser: TORComboBox;
48 cbxClass: TORComboBox;
49 cbxLocation: TORComboBox;
50 lblEdit: TLabel;
51 pnlInfo: TPanel;
52 pnlTree: TPanel;
53 tvAll: TORTreeView;
54 lblTree: TLabel;
55 pnlCover: TPanel;
56 lvCover: TCaptionListView;
57 pblMoveBtns: TPanel;
58 sbCopyRight: TBitBtn;
59 sbCopyLeft: TBitBtn;
60 splMain: TSplitter;
61 btnView: TButton;
62 lblLegend: TLabel;
63 imgLblRemCoverSheet: TVA508ImageListLabeler;
64 compAccessCopyRight: TVA508ComponentAccessibility;
65 compAccessCopyLeft: TVA508ComponentAccessibility;
66 pnlTopLeft: TPanel;
67 lvView: TCaptionListView;
68 lblView: TLabel;
69 lblCAC: TVA508StaticText;
70 VA508ImageListLabeler1: TVA508ImageListLabeler;
71 procedure cbxLocationNeedData(Sender: TObject; const StartFrom: String;
72 Direction, InsertAt: Integer);
73 procedure cbxServiceNeedData(Sender: TObject; const StartFrom: String;
74 Direction, InsertAt: Integer);
75 procedure cbxUserNeedData(Sender: TObject; const StartFrom: String;
76 Direction, InsertAt: Integer);
77 procedure cbxClassNeedData(Sender: TObject; const StartFrom: String;
78 Direction, InsertAt: Integer);
79 procedure FormDestroy(Sender: TObject);
80 procedure cbxDivisionChange(Sender: TObject);
81 procedure cbxServiceChange(Sender: TObject);
82 procedure cbxLocationChange(Sender: TObject);
83 procedure cbxClassChange(Sender: TObject);
84 procedure cbxUserChange(Sender: TObject);
85 procedure cbxDropDownClose(Sender: TObject);
86 procedure cbEditLevelClick(Sender: TObject);
87 procedure tvAllExpanding(Sender: TObject; Node: TTreeNode;
88 var AllowExpansion: Boolean);
89 procedure edtSeqChange(Sender: TObject);
90 procedure tvAllExpanded(Sender: TObject; Node: TTreeNode);
91 procedure tvAllChange(Sender: TObject; Node: TTreeNode);
92 procedure lvCoverChange(Sender: TObject; Item: TListItem;
93 Change: TItemChange);
94 procedure btnAddClick(Sender: TObject);
95 procedure btnRemoveClick(Sender: TObject);
96 procedure btnLockClick(Sender: TObject);
97 procedure lvViewColumnClick(Sender: TObject; Column: TListColumn);
98 procedure lvCoverColumnClick(Sender: TObject; Column: TListColumn);
99 procedure lvViewCompare(Sender: TObject; Item1, Item2: TListItem;
100 Data: Integer; var Compare: Integer);
101 procedure lvCoverCompare(Sender: TObject; Item1, Item2: TListItem;
102 Data: Integer; var Compare: Integer);
103 procedure sbUpClick(Sender: TObject);
104 procedure sbDownClick(Sender: TObject);
105 procedure sbCopyRightClick(Sender: TObject);
106 procedure udSeqChangingEx(Sender: TObject; var AllowChange: Boolean;
107 NewValue: Smallint; Direction: TUpDownDirection);
108 procedure sbCopyLeftClick(Sender: TObject);
109 procedure tvAllDblClick(Sender: TObject);
110 procedure btnApplyClick(Sender: TObject);
111 procedure btnOKClick(Sender: TObject);
112 procedure lvCoverDblClick(Sender: TObject);
113 procedure btnViewClick(Sender: TObject);
114 procedure lvCoverKeyDown(Sender: TObject; var Key: Word;
115 Shift: TShiftState);
116 procedure edtSeqKeyPress(Sender: TObject; var Key: Char);
117 procedure cbxDivisionKeyDown(Sender: TObject; var Key: Word;
118 Shift: TShiftState);
119 procedure FormCreate(Sender: TObject);
120 procedure compAccessCopyRightCaptionQuery(Sender: TObject;
121 var Text: string);
122 procedure compAccessCopyLeftCaptionQuery(Sender: TObject; var Text: string);
123 procedure lvViewChange(Sender: TObject; Item: TListItem;
124 Change: TItemChange);
125 procedure lvViewSelectItem(Sender: TObject; Item: TListItem;
126 Selected: Boolean);
127 private
128 FData: TORStringList; // DataCode IEN ^ Modified Flag Object=TStringList
129 FUserInfo: TORStringList; // C^User Class, D^Division
130 FUser: Int64;
131 FUserMode: boolean;
132 FInitialized: boolean;
133 FCurDiv: Integer;
134 FCurSer:Integer;
135 FCurLoc: Integer;
136 FCurClass: Integer;
137 FCurUser: Int64;
138 FDivisions: TORStringList;
139 FServices: TORStringList;
140 FLocations: TORStringList;
141 FClasses: TORStringList;
142 FUsers: TORStringList;
143 FMasterList: TORStringList;
144 FUpdatePending: TORCheckBox;
145 FCatInfo: TORStringList;
146 FEditingLevel: TRemCoverDataLevel;
147 FEditingIEN: Int64;
148 FUpdating: boolean;
149 FTopSortTag: integer;
150 FTopSortUp: boolean;
151 FBottomSortTag: integer;
152 FBottomSortUp: boolean;
153 FDataSaved: boolean;
154 FUpdatingView: boolean;
155 FInternalExpansion: boolean;
156 FSavePause: integer;
157 FSelection: boolean;
158 fOldFocusChanged: TNotifyEvent;
159 procedure ActiveControlChanged(Sender: TObject);
160 procedure SetButtonHints;
161 procedure GetUserInfo(AUser: Int64);
162 function GetCurrent(IEN: Int64; Level: TRemCoverDataLevel; Show: boolean;
163 Add: boolean = FALSE): TORStringList;
164 procedure UpdateView;
165 procedure SetupItem(Item: TListItem; const Data: string); overload;
166 procedure SetupItem(Item: TListItem; const Data: string;
167 Level: TRemCoverDataLevel; IEN: Int64); overload;
168 function GetExternalName(Level: TRemCoverDataLevel; IEN: Int64): string;
169 procedure UpdateMasterListView;
170 procedure UpdateButtons;
171 function GetCatInfo(CatIEN: string): TORStringList;
172 procedure MarkListAsChanged;
173 function GetIndex(List: TORStringList; Item: TListItem): integer;
174 procedure ChangeStatus(Code: string);
175 procedure SetSeq(Item: TListItem; const Value: string);
176 function ListHasData(Seq: string; SubIdx: integer): boolean;
177 procedure SaveData(FromApply: boolean);
178 function RPad(Str: String): String;
179 function GetCoverSheetLvlData(ALevel, AClass: string): TStrings;
180 procedure LockButtonUpdate(data, FNAME, hint: string);
181 public
182 procedure Init(AsUser: boolean);
183 end;
184
185procedure EditCoverSheetReminderList(AsUser: boolean);
186
187implementation
188
189uses rCore, uCore, uPCE, rProbs, rTIU, ORFn, rReminders, uReminders,
190 fRemCoverPreview, VAUtils, VA508AccessibilityRouter;
191
192{$R *.DFM}
193{$R sremcvr}
194
195const
196 DataCode: array[TRemCoverDataLevel] of string[1] =
197 { dlPackage } ('P',
198 { dlSystem } 'S',
199 { dlDivision } 'D',
200 { dlService } 'R',
201 { dlLocation } 'L',
202 { dlUserClass } 'C',
203 { dlUser } 'U');
204
205 DataName: array[TRemCoverDataLevel] of string =
206 { dlPackage } ('Package',
207 { dlSystem } 'System',
208 { dlDivision } 'Division',
209 { dlService } 'Service',
210 { dlLocation } 'Location',
211 { dlUserClass } 'User Class',
212 { dlUser } 'User');
213
214 InternalName: array[TRemCoverDataLevel] of string =
215 { dlPackage } ('PKG',
216 { dlSystem } 'SYS',
217 { dlDivision } 'DIV',
218 { dlService } 'SRV',
219 { dlLocation } 'LOC',
220 { dlUserClass } 'CLASS',
221 { dlUser } 'USR');
222
223
224 UserClassCode = 'C';
225 DivisionCode = 'D';
226 ServiceCode = 'S';
227
228 CVLockCode = 'L';
229 CVAddCode = 'N';
230 CVRemoveCode = 'R';
231 CVCatCode = 'C';
232 CVRemCode = 'R';
233
234 DummyNode = '^@Dummy Node@^';
235 IdxSeq = 0;
236 IdxLvl = 1;
237 IdxType = 2;
238 IdxTIEN = 3;
239 IdxLvl2 = 4;
240 IdxAdd = 5;
241 IdxIEN = 6;
242
243 UnlockHint = 'Unlock a Reminder, reverting it''s status back to Added';
244 LockHint = 'Lock a Reminder to prevent it''s removal from a lower'
245 + CRLF + 'level Coversheet display. For example, if you lock'
246 + CRLF + 'a Reminder at the Service level, then that Reminder'
247 + CRLF + 'can not be removed from the coversheet display at'
248 + CRLF + 'the Location, User Class, or User levels.';
249 AddLockHint = 'Add and Lock a Reminder to prevent it''s removal from a lower'
250 + CRLF + 'level Coversheet display. For example, if you lock'
251 + CRLF + 'a Reminder at the Service level, then that Reminder'
252 + CRLF + 'can not be removed from the coversheet display at'
253 + CRLF + 'the Location, User Class, or User levels.';
254
255procedure EditCoverSheetReminderList(AsUser: boolean);
256var
257 frmRemCoverSheet: TfrmRemCoverSheet;
258
259begin
260 frmRemCoverSheet := TfrmRemCoverSheet.Create(Application);
261 try
262 frmRemCoverSheet.Init(AsUser);
263 frmRemCoverSheet.ShowModal;
264 if frmRemCoverSheet.FDataSaved then
265 ResetReminderLoad;
266 finally
267 frmRemCoverSheet.Free;
268 end;
269end;
270
271{ TfrmRemCoverSheet }
272
273procedure TfrmRemCoverSheet.Init(AsUser: boolean);
274const
275 RemClsCode = ' NVL';
276 RemClsText:array[1..4] of string = ('','National','VISN','Local');
277
278var
279 LocCombo: TORComboBox;
280 i, idx: integer;
281 tmp, tmp2, tmp3: string;
282 Node: TORTreeNode;
283
284begin
285 FTopSortTag := 3;
286 FTopSortUp := TRUE;
287 FBottomSortTag := 2;
288 FBottomSortUp := TRUE;
289 FEditingLevel := dlPackage;
290
291 ResizeAnchoredFormToFont(self);
292 pnlBtns.Top := pnlBottom.Top + pnlBottom.Height;
293
294 FCatInfo := TORStringList.Create;
295 FData := TORStringList.Create;
296 FUserInfo := TORStringList.Create;
297 FDivisions := TORStringList.Create;
298 FServices := TORStringList.Create;
299 FLocations := TORStringList.Create;
300 FClasses := TORStringList.Create;
301 FUsers := TORStringList.Create;
302 FMasterList := TORStringList.Create;
303 //FMasterList.Assign(GetAllRemindersAndCategories);
304 FastAssign(GetAllRemindersAndCategories, FMasterList);
305 for i := 0 to FMasterList.Count-1 do
306 begin
307 tmp := FMasterList[i];
308 tmp2 := piece(tmp,U,4);
309 if tmp2 = piece(tmp,U,3) then
310 tmp2 := '';
311 tmp3 := piece(tmp,U,5);
312 if tmp3 = '' then tmp3 := ' ';
313 idx := pos(tmp3,RemClsCode);
314 if idx > 0 then
315 tmp3 := RemClsText[idx]
316 else
317 tmp3 := '';
318 if tmp3 <> '' then
319 begin
320 if tmp2 <> '' then
321 tmp2 := tmp2 + ' - ';
322 tmp2 := tmp2 + tmp3;
323 end;
324 if tmp2 <> '' then
325 tmp2 := ' (' + tmp2 + ')';
326 tmp := Piece(tmp,U,1) + Pieces(tmp,U,2,3) + tmp2 + U + tmp2;
327 FMasterList[i] := tmp;
328 end;
329
330 FUserMode := AsUser;
331 FCurUser := User.DUZ;
332 GetUserInfo(User.DUZ);
333 FCurLoc := Encounter.Location;
334 idx := FUserInfo.IndexOfPiece(DivisionCode);
335 if idx >= 0 then
336 FCurDiv := StrToIntDef(Piece(FUserInfo[idx],U,2),0)
337 else
338 FCurDiv := 0;
339 idx := FUserInfo.IndexOfPiece(ServiceCode);
340 if idx >= 0 then
341 FCurSer := StrToIntDef(Piece(FUserInfo[idx],U,2),0)
342 else
343 FCurSer := User.Service;
344 cbxUser.InitLongList(User.Name);
345 cbxUser.SelectByIEN(FCurUser);
346 GetPCECodes(FDivisions, TAG_HISTLOC);
347 FDivisions.Delete(0);
348 FCurClass := 0;
349 if AsUser then
350 begin
351 pnlCAC.Visible := FALSE;
352 LocCombo := cbxUserLoc;
353 btnLock.Visible := FALSE;
354 end
355 else
356 begin
357 pnlUser.Visible := FALSE;
358 LocCombo := cbxLocation;
359 //cbxDivision.Items.Assign(FDivisions);
360 FastAssign(Fdivisions, cbxDivision.Items);
361 cbxDivision.SelectByIEN(FCurDiv);
362 cbxService.InitLongList(GetExternalName(dlService, FCurSer));
363 cbxService.SelectByIEN(FCurSer);
364 cbxClass.InitLongList('');
365 if FCurClass <> 0 then
366 cbxClass.SelectByIEN(FCurClass);
367 end;
368 LocCombo.InitLongList(Encounter.LocationName);
369 LocCombo.SelectByIEN(FCurLoc);
370 if AsUser then
371 cbUser.Checked := TRUE;
372
373 tvAll.Items.BeginUpdate;
374 try
375 for i := 0 to FMasterList.Count-1 do
376 begin
377 Node := TORTreeNode(tvAll.Items.Add(nil,''));
378 Node.StringData := FMasterList[i];
379 if copy(FMasterList[i],1,1) = CVCatCode then
380 begin
381 idx := 1;
382 tvAll.Items.AddChild(Node, DummyNode);
383 end
384 else
385 idx := 0;
386 Node.ImageIndex := idx;
387 Node.SelectedIndex := idx;
388 end;
389 finally
390 tvAll.Items.EndUpdate;
391 end;
392
393 FInitialized := TRUE;
394 UpdateView;
395 UpdateButtons;
396end;
397
398procedure TfrmRemCoverSheet.cbxLocationNeedData(Sender: TObject;
399 const StartFrom: String; Direction, InsertAt: Integer);
400begin
401 TORComboBox(Sender).ForDataUse(SubSetOfLocations(StartFrom, Direction));
402end;
403
404procedure TfrmRemCoverSheet.cbxServiceNeedData(Sender: TObject;
405 const StartFrom: String; Direction, InsertAt: Integer);
406begin
407 cbxService.ForDataUse(ServiceSearch(StartFrom, Direction, TRUE));
408end;
409
410procedure TfrmRemCoverSheet.cbxUserNeedData(Sender: TObject;
411 const StartFrom: String; Direction, InsertAt: Integer);
412begin
413 cbxUser.ForDataUse(SubSetOfPersons(StartFrom, Direction));
414end;
415
416procedure TfrmRemCoverSheet.cbxClassNeedData(Sender: TObject;
417 const StartFrom: String; Direction, InsertAt: Integer);
418begin
419 cbxClass.ForDataUse(SubSetOfUserClasses(StartFrom, Direction));
420end;
421
422procedure TfrmRemCoverSheet.FormDestroy(Sender: TObject);
423begin
424 Screen.OnActiveControlChange := fOldFocusChanged;
425 FMasterList.Free;
426 FUsers.Free;
427 FClasses.Free;
428 FLocations.Free;
429 FServices.Free;
430 FDivisions.Free;
431 FUserInfo.Free;
432 FData.KillObjects;
433 FData.Free;
434 FCatInfo.KillObjects;
435 FCatInfo.Free;
436 Application.HintHidePause := FSavePause //Reset Hint pause to original setting
437end;
438
439procedure TfrmRemCoverSheet.GetUserInfo(AUser: Int64);
440begin
441 if FUser <> AUser then
442 begin
443 FUser := AUser;
444 //FUserInfo.Assign(UserDivClassInfo(FUser));
445 FastAssign(UserDivClassInfo(FUser), FUserInfo);
446 end;
447end;
448
449function TfrmRemCoverSheet.GetCurrent(IEN: Int64; Level: TRemCoverDataLevel;
450 Show: boolean; Add: boolean = FALSE): TORStringList;
451var
452 lvl, cls, sIEN: string;
453 tmpSL: TORStringList;
454 i, idx: integer;
455
456begin
457 idx := FData.IndexOfPiece(DataCode[Level] + IntToStr(IEN));
458 if idx < 0 then
459 begin
460 if (IEN = 0) and (not (Level in [dlPackage, dlSystem])) then
461 begin
462 Result := nil;
463 exit;
464 end;
465 cls := '';
466 sIEN := IntToStr(IEN);
467 lvl := InternalName[Level];
468 case Level of
469 dlDivision, dlService, dlLocation, dlUser:
470 lvl := lvl + '.`' + sIEN;
471 dlUserClass:
472 cls := sIEN;
473 end;
474 if (lvl <> '') then
475 begin
476 tmpSL := TORStringList.Create;
477 try
478 //tmpSL.Assign(GetCoverSheetLvlData(lvl, cls));
479 FastAssign(GetCoverSheetLvlData(lvl, cls), tmpSL);
480 if (not Add) and (tmpSL.Count = 0) then
481 FreeAndNil(tmpSL);
482 idx := FData.AddObject(DataCode[Level] + IntToStr(IEN), tmpSL);
483 except
484 tmpSL.Free;
485 raise;
486 end;
487 end;
488 end;
489 if idx >= 0 then
490 begin
491 tmpSL := TORStringList(FData.Objects[idx]);
492 if Add and (not assigned(tmpSL)) then
493 begin
494 tmpSL := TORStringList.Create;
495 FData.Objects[idx] := tmpSL;
496 end;
497 end
498 else
499 tmpSL := nil;
500 if Show and assigned(tmpSL) then
501 begin
502 for i := 0 to tmpSL.Count-1 do
503 SetupItem(lvView.Items.Add, tmpSL[i], Level, IEN);
504 end;
505 Result := tmpSL;
506end;
507
508procedure TfrmRemCoverSheet.UpdateView;
509var
510 idx: integer;
511
512begin
513 if FInitialized and (not FUpdatingView) then
514 begin
515 lvView.Items.BeginUpdate;
516 try
517 lvView.Items.Clear;
518 GetCurrent(0, dlPackage, TRUE);
519 GetCurrent(0, dlSystem, TRUE);
520 GetCurrent(FCurDiv, dlDivision, TRUE);
521 GetCurrent(FCurSer, dlService, TRUE);
522 GetCurrent(FCurLoc, dlLocation, TRUE);
523 if FCurClass > 0 then
524 GetCurrent(FCurClass, dlUserClass, TRUE)
525 else
526 begin
527 idx := -1;
528 repeat
529 idx := FUserInfo.IndexOfPiece(UserClassCode,U,1,idx);
530 if idx >= 0 then
531 GetCurrent(StrToIntDef(Piece(FUserInfo[idx],U,2),0), dlUserClass, TRUE)
532 until(idx < 0);
533 end;
534 GetCurrent(FCurUser, dlUser, TRUE);
535 finally
536 lvView.Items.EndUpdate;
537 end;
538 end;
539end;
540
541procedure TfrmRemCoverSheet.compAccessCopyLeftCaptionQuery(Sender: TObject;
542 var Text: string);
543begin
544 Text := 'Remove Reminder from ' + DataName[FEditingLevel] + ' Level Reminders List';
545end;
546
547procedure TfrmRemCoverSheet.compAccessCopyRightCaptionQuery(
548 Sender: TObject; var Text: string);
549begin
550 Text := 'Copy Reminder into ' + DataName[FEditingLevel] + ' Level Reminders List';
551end;
552
553procedure TfrmRemCoverSheet.SetupItem(Item: TListItem; const Data: string);
554var
555 AddCode, RemCode, rIEN, Seq: string;
556
557begin
558 Seq := Piece(Data,U,1);
559 rIEN := Piece(Data,U,2);
560 Item.Caption := Piece(Data,U,3);
561 AddCode := copy(rIEN,1,1);
562 RemCode := copy(rIEN,2,1);
563 delete(rIEN,1,1);
564 if AddCode = CVLockCode then
565 Item.StateIndex := 5
566 else
567 if AddCode = CVRemoveCode then
568 Item.StateIndex := 4
569 else
570 if AddCode = CVAddCode then
571 Item.StateIndex := 3;
572 if RemCode = CVCatCode then
573 Item.ImageIndex := 1
574 else
575 if RemCode = CVRemCode then
576 Item.ImageIndex := 0
577 else
578 Item.ImageIndex := -1;
579 Item.SubItems.Clear;
580 Item.SubItems.Add(Seq); // IdxSeq = 0
581 Item.SubItems.Add(''); // IdxLvl = 1
582 Item.SubItems.Add(''); // IdxType = 2
583 Item.SubItems.Add(''); // IdxTIEN = 3
584 Item.SubItems.Add(''); // IdxLvl2 = 4
585 Item.SubItems.Add(AddCode); // IdxAdd = 5
586 Item.SubItems.Add(rIEN); // IdxIEN = 6
587end;
588
589procedure TfrmRemCoverSheet.SetupItem(Item: TListItem; const Data: string;
590 Level: TRemCoverDataLevel; IEN: Int64);
591begin
592 SetupItem(Item, Data);
593 Item.SubItems[IdxLvl] := DataName[Level];
594 Item.SubItems[IdxType] := GetExternalName(Level, IEN);
595 Item.SubItems[IdxTIEN] := IntToStr(IEN);
596 Item.SubItems[IdxLvl2] := IntToStr(ord(Level));
597end;
598
599function TfrmRemCoverSheet.GetExternalName(Level: TRemCoverDataLevel; IEN: Int64): string;
600
601 function GetNameFromList(List: TORStringList; IEN: Int64; FileNum: Double): string;
602 var
603 idx: integer;
604
605 begin
606 idx := List.IndexOfPiece(IntToStr(IEN));
607 if idx < 0 then
608 idx := List.Add(IntToStr(IEN) + U + ExternalName(IEN, FileNum));
609 Result := piece(List[idx],U,2);
610 end;
611
612begin
613 case Level of
614 dlDivision: Result := GetNameFromList(FDivisions, IEN, 4);
615 dlService: Result := GetNameFromList(FServices, IEN, 49);
616 dlLocation: Result := GetNameFromList(FLocations, IEN, 44);
617 dlUserClass: Result := GetNameFromList(FClasses, IEN, 8930);
618 dlUser: Result := GetNameFromList(FUsers, IEN, 200);
619 else Result := '';
620 end;
621end;
622
623procedure TfrmRemCoverSheet.cbxDivisionChange(Sender: TObject);
624begin
625 FCurDiv := cbxDivision.ItemIEN;
626 If FCurDiv < 1 then //No value in Division combobox
627 begin
628 sbCopyLeft.Enabled := false;
629 sbCopyRight.Enabled := false;
630 FSelection := false;
631 end
632 else
633 FSelection := true;
634 FUpdatePending := cbDivision;
635 if not cbxDivision.DroppedDown then
636 cbxDropDownClose(nil);
637end;
638
639procedure TfrmRemCoverSheet.cbxServiceChange(Sender: TObject);
640begin
641 FCurSer := cbxService.ItemIEN;
642 If FCurSer < 1 then //No value in Service combobox
643 begin
644 sbCopyLeft.Enabled := false;
645 sbCopyRight.Enabled := false;
646 FSelection := false;
647 end
648 else
649 FSelection := true;
650 FUpdatePending := cbService;
651 if not cbxService.DroppedDown then
652 cbxDropDownClose(nil);
653end;
654
655procedure TfrmRemCoverSheet.cbxLocationChange(Sender: TObject);
656begin
657 FCurLoc := TORComboBox(Sender).ItemIEN;
658 If FCurLoc < 1 then //No value in Location combobox
659 begin
660 sbCopyLeft.Enabled := false;
661 sbCopyRight.Enabled := false;
662 FSelection := false;
663 end
664 else
665 FSelection := true;
666 FUpdatePending := cbLocation;
667 if not TORComboBox(Sender).DroppedDown then
668 cbxDropDownClose(nil);
669end;
670
671procedure TfrmRemCoverSheet.cbxClassChange(Sender: TObject);
672begin
673 FCurClass := cbxClass.ItemIEN;
674 If FCurClass < 1 then //No value in User Class combobox
675 begin
676 sbCopyLeft.Enabled := false;
677 sbCopyRight.Enabled := false;
678 FSelection := false;
679 end
680 else
681 FSelection := true;
682 FUpdatePending := cbUserClass;
683 if not cbxClass.DroppedDown then
684 cbxDropDownClose(nil);
685end;
686
687procedure TfrmRemCoverSheet.cbxUserChange(Sender: TObject);
688var
689 NewVal, idx: integer;
690
691begin
692 FCurUser := cbxUser.ItemIEN;
693 If FCurUser < 1 then //No value in User combobox
694 begin
695 sbCopyLeft.Enabled := false;
696 sbCopyRight.Enabled := false;
697 FSelection := false;
698 end
699 else
700 FSelection := true;
701 GetUserInfo(FCurUser);
702 idx := FUserInfo.IndexOfPiece(DivisionCode);
703 if idx >= 0 then
704 begin
705 NewVal := StrToIntDef(Piece(FUserInfo[idx],U,2),0);
706 if NewVal <> FCurDiv then
707 begin
708 FCurDiv := NewVal;
709 cbxDivision.InitLongList(GetExternalName(dlDivision, NewVal));
710 cbxDivision.SelectByIEN(NewVal);
711 end;
712 end;
713 idx := FUserInfo.IndexOfPiece(ServiceCode);
714 if idx >= 0 then
715 begin
716 NewVal := StrToIntDef(Piece(FUserInfo[idx],U,2),0);
717 if NewVal <> FCurSer then
718 begin
719 FCurSer := NewVal;
720 cbxService.InitLongList(GetExternalName(dlService, NewVal));
721 cbxService.SelectByIEN(NewVal);
722 end;
723 end;
724 FCurClass := 0;
725 cbxClass.ItemIndex := -1;
726 FUpdatePending := cbUser;
727 if not cbxUser.DroppedDown then
728 cbxDropDownClose(nil);
729end;
730
731procedure TfrmRemCoverSheet.cbxDropDownClose(Sender: TObject);
732begin
733 if assigned(FUpdatePending) then
734 begin
735 UpdateView;
736 if FInitialized and (not FUserMode) then
737 begin
738 if FUpdatePending.Checked then
739 cbEditLevelClick(FUpdatePending)
740 else
741 FUpdatePending.Checked := TRUE;
742 end;
743 FUpdatePending := nil;
744 end;
745end;
746
747procedure TfrmRemCoverSheet.cbEditLevelClick(Sender: TObject);
748var
749 cb: TORCheckBox;
750 tmp: string;
751
752begin
753 cb := TORCheckBox(Sender);
754 if cb.Checked then
755 begin
756 FEditingLevel := TRemCoverDataLevel(cb.Tag);
757 if FEditingLevel <> dlUserClass then
758 begin
759 FCurClass := 0;
760 cbxClass.ItemIndex := -1;
761 end;
762 case FEditingLevel of
763 dlDivision: FEditingIEN := FCurDiv;
764 dlService: FEditingIEN := FCurSer;
765 dlLocation: FEditingIEN := FCurLoc;
766 dlUserClass: FEditingIEN := FCurClass;
767 dlUser: FEditingIEN := FCurUser;
768 else FEditingIEN := 0;
769 end;
770 if FEditingIEN = 0 then
771 begin
772 tmp := ' ';
773 IF FEditingLevel = dlSystem then
774 FSelection := true
775 else
776 begin
777 sbCopyLeft.Enabled := false;
778 sbCopyRight.Enabled := false;
779 FSelection := false;
780 end;
781 end
782 else
783 begin
784 tmp := ': ';
785 FSelection := true;
786 end;
787 lblEdit.Caption := ' Editing Cover Sheet Reminders for ' + DataName[FEditingLevel] +
788 tmp + GetExternalName(FEditingLevel, FEditingIEN);
789 lvCover.Columns[0].Caption := DataName[FEditingLevel] + ' Level Reminders';
790
791 SetButtonHints; {Setup hints for Lock, Add, Remove buttons based on
792 Parameter Level}
793 UpdateView;
794 UpdateMasterListView;
795 end
796 else
797 begin
798 FSelection := false;
799 sbCopyLeft.Enabled := false;
800 sbCopyRight.Enabled := false;
801 FEditingLevel := dlPackage;
802 FEditingIEN := 0;
803 lblEdit.Caption := '';
804 lvCover.Items.BeginUpdate;
805 try
806 lvCover.Items.Clear;
807 finally
808 lvCover.Items.EndUpdate;
809 end;
810 end;
811
812end;
813
814procedure TfrmRemCoverSheet.UpdateMasterListView;
815var
816 i: integer;
817 tmpSL: TStringList;
818 itm: TListItem;
819
820begin
821 lvCover.Items.BeginUpdate;
822 try
823 lvCover.Items.Clear;
824 if FEditingLevel <> dlPackage then
825 begin
826 tmpSL := GetCurrent(FEditingIEN, FEditingLevel, FALSE);
827 if assigned(tmpSL) then
828 begin
829 for i := 0 to tmpSL.Count-1 do
830 begin
831 itm := lvCover.Items.Add;
832 SetupItem(itm, tmpSL[i]);
833 end;
834 end;
835 end;
836 finally
837 lvCover.Items.EndUpdate;
838 end;
839 UpdateButtons;
840end;
841
842procedure TfrmRemCoverSheet.UpdateButtons;
843var
844 FocusOK, ok: boolean;
845 i, idx: integer;
846 Current, Lowest, Highest: integer;
847 tmp: string;
848 tmpSL: TORstringlist;
849 doDownButton, doUpButton: boolean;
850
851begin
852 lvCover.Enabled := (FEditingLevel <> dlPackage);
853 ok := assigned(tvAll.Selected) and (FEditingLevel <> dlPackage) and (FSelection);
854 sbCopyRight.Enabled := ok;
855
856 ok := assigned(lvCover.Selected) and (FEditingLevel <> dlPackage) and (FSelection);
857 sbCopyLeft.Enabled := ok;
858
859 ok := assigned(lvCover.Selected);
860 lblSeq.Enabled := ok;
861 edtSeq.Enabled := ok;
862
863 FUpdating := TRUE;
864 try
865 udSeq.Enabled := ok;
866 if ok then
867 udSeq.Position := StrToIntDef(lvCover.Selected.SubItems[IdxSeq],1)
868 else
869 udSeq.Position := 1;
870 finally
871 FUpdating := FALSE;
872 end;
873
874 FocusOK := lvCover.Focused or sbUp.Focused or sbDown.Focused or edtSeq.Focused or
875 udSeq.Focused or btnAdd.Focused or btnRemove.Focused or btnLock.Focused or
876 btnOK.Focused; // add btnOK so you can shift-tab backwards into list
877 btnAdd.Enabled := ok and FocusOK;
878 btnRemove.Enabled := ok and (FEditingLevel <> dlSystem) and FocusOK;
879 btnLock.Enabled := ok and (FEditingLevel <> dlUser) and FocusOK;
880 if ok then
881 begin
882 tmpSL := GetCurrent(FEditingIEN, FEditingLevel, FALSE);
883 if assigned(tmpSL) then
884 begin
885 Idx := GetIndex(tmpSL, lvCover.Selected);
886 if Idx >= 0 then
887 begin
888 tmp := tmpSL[idx];
889 tmp := piece(tmp,u,2);
890 tmp := copy(tmp,1,1);
891 if tmp = 'L' then
892 begin
893 LockButtonUpdate('Unlock', 'BMP_UNLOCK', UnlockHint);
894 end;
895 if tmp = 'N' then
896 begin
897 LockButtonUpdate('Lock', 'BMP_LOCK', LockHint);
898 end;
899 if tmp = 'R' then
900 begin
901 LockButtonUpdate('Add && Lock', 'BMP_LOCK', AddLockHint);
902 end;
903 end;
904 end;
905 ok :=(lvCover.Items.Count > 1);
906 end;
907 Lowest := 99999;
908 Highest := -1;
909 if ok then
910 begin
911 for i := 0 to lvCover.Items.Count-1 do
912 begin
913 Current := StrToIntDef(lvCover.Items[i].SubItems[IdxSeq], 0);
914 if Lowest > Current then
915 Lowest := Current;
916 if Highest < Current then
917 Highest := Current;
918 end;
919 Current := StrToIntDef(lvCover.Selected.SubItems[IdxSeq], 0);
920 end
921 else
922 Current := 0;
923 doDownButton := (sbUp.Focused and (Current = Lowest));
924 doUpButton := (sbDown.Focused and (Current = Highest));
925 sbUp.Enabled := ok and (Current > Lowest);
926 sbDown.Enabled := ok and (Current < Highest);
927 if doDownButton and sbDown.enabled then sbDown.SetFocus;
928 if doUpButton and sbUp.enabled then sbUp.SetFocus;
929end;
930
931procedure TfrmRemCoverSheet.tvAllExpanding(Sender: TObject;
932 Node: TTreeNode; var AllowExpansion: Boolean);
933var
934 List: TORStringList;
935 i, idx: integer;
936 CNode: TORTreeNode;
937
938begin
939 if Node.GetFirstChild.Text = DummyNode then
940 begin
941 Node.DeleteChildren;
942 List := GetCatInfo(copy(piece(TORTreeNode(Node).StringData,U,1),2,99));
943 if assigned(List) then
944 begin
945 for i := 0 to List.Count-1 do
946 begin
947 CNode := TORTreeNode(tvAll.Items.AddChild(Node,''));
948 CNode.StringData := List[i];
949 if copy(List[i],1,1) = CVCatCode then
950 begin
951 idx := 1;
952 tvAll.Items.AddChild(CNode, DummyNode);
953 end
954 else
955 idx := 0;
956 CNode.ImageIndex := idx;
957 CNode.SelectedIndex := idx;
958 end;
959 end;
960 end;
961 if FInternalExpansion then
962 AllowExpansion := FALSE
963 else
964 AllowExpansion := Node.HasChildren;
965end;
966
967function TfrmRemCoverSheet.GetCatInfo(CatIEN: string): TORStringList;
968var
969 i, j, idx: integer;
970 tmp: string;
971 tmpSL: TStrings;
972
973begin
974 idx := FCatInfo.IndexOf(CatIEN);
975 if idx < 0 then
976 begin
977 Result := TORStringList.Create;
978 try
979 tmpSL := GetCategoryItems(StrToIntDef(CatIEN,0));
980 for i := 0 to tmpSL.Count-1 do
981 begin
982 tmp := copy(tmpSL[i],1,1);
983 if tmp = CVCatCode then
984 idx := 3
985 else
986 idx := 4;
987 tmp := tmp + Piece(tmpSL[i],U,2) + U + Piece(tmpSL[i],U,idx);
988 j := FMasterList.IndexOfPiece(piece(tmp,U,1));
989 if j >= 0 then
990 tmp := tmp + piece(FMasterList[j],U,3);
991 Result.Add(tmp);
992 end;
993 FCatInfo.AddObject(CatIEN, Result);
994 except
995 Result.Free;
996 raise;
997 end;
998 end
999 else
1000 Result := TORStringList(FCatInfo.Objects[idx]);
1001end;
1002
1003procedure TfrmRemCoverSheet.MarkListAsChanged;
1004var
1005 tmp: string;
1006 idx: integer;
1007
1008begin
1009 idx := FData.IndexOfPiece(DataCode[FEditingLevel] + IntToStr(FEditingIEN));
1010 if idx >= 0 then
1011 begin
1012 tmp := FData[idx];
1013 SetPiece(Tmp,U,2,BoolChar[TRUE]);
1014 FData[idx] := tmp;
1015 btnApply.Enabled := TRUE;
1016 UpdateView;
1017 end;
1018end;
1019
1020procedure TfrmRemCoverSheet.edtSeqChange(Sender: TObject);
1021begin
1022 if FUpdating or (not FInitialized) then exit;
1023 if FBottomSortTag <> 2 then
1024 begin
1025 FBottomSortTag := 2;
1026 lvCover.CustomSort(nil, 0);
1027 end;
1028 SetSeq(lvCover.Selected, IntToStr(udSeq.Position));
1029 lvCover.CustomSort(nil, 0);
1030 UpdateButtons;
1031end;
1032
1033procedure TfrmRemCoverSheet.tvAllExpanded(Sender: TObject;
1034 Node: TTreeNode);
1035var
1036 idx: integer;
1037
1038begin
1039 if Node.Expanded then
1040 idx := 2
1041 else
1042 idx := 1;
1043 Node.ImageIndex := idx;
1044 Node.SelectedIndex := idx;
1045end;
1046
1047procedure TfrmRemCoverSheet.tvAllChange(Sender: TObject; Node: TTreeNode);
1048begin
1049 UpdateButtons;
1050end;
1051
1052procedure TfrmRemCoverSheet.lvCoverChange(Sender: TObject; Item: TListItem;
1053 Change: TItemChange);
1054begin
1055 UpdateButtons;
1056end;
1057
1058function TfrmRemCoverSheet.GetIndex(List: TORStringList;
1059 Item: TListItem): integer;
1060var
1061 IEN: string;
1062
1063begin
1064 if assigned(Item) and assigned(List) then
1065 begin
1066 IEN := Item.SubItems[IdxAdd] + Item.SubItems[IdxIEN];
1067 Result := List.IndexOfPiece(IEN,U,2);
1068 end
1069 else
1070 Result := -1;
1071end;
1072
1073procedure TfrmRemCoverSheet.ChangeStatus(Code: string);
1074var
1075 tmpSL: TORStringList;
1076 Idx: integer;
1077 tmp,p: string;
1078
1079begin
1080 tmpSL := GetCurrent(FEditingIEN, FEditingLevel, FALSE);
1081 if assigned(tmpSL) then
1082 begin
1083 Idx := GetIndex(tmpSL, lvCover.Selected);
1084 if Idx >= 0 then
1085 begin
1086 tmp := tmpSL[idx];
1087 p := Piece(tmp,U,2);
1088 SetPiece(tmp,U,2,Code + copy(p,2,MaxInt));
1089 tmpSL[idx] := tmp;
1090 MarkListAsChanged;
1091 SetupItem(lvCover.Selected, tmp);
1092 tmp := piece(tmp,u,2);
1093 tmp := copy(tmp,1,1);
1094 if tmp = 'L' then
1095 begin
1096 LockButtonUpdate('Unlock', 'BMP_UNLOCK', UnlockHint);
1097 end;
1098 if tmp = 'N' then
1099 begin
1100 LockButtonUpdate('Lock', 'BMP_LOCK', LockHint);
1101 end;
1102 if tmp = 'R' then
1103 begin
1104 LockButtonUpdate('Add && Lock', 'BMP_LOCK', AddLockHint);
1105 end;
1106 end;
1107 end;
1108end;
1109
1110procedure TfrmRemCoverSheet.btnAddClick(Sender: TObject);
1111begin
1112 ChangeStatus(CVAddCode);
1113end;
1114
1115procedure TfrmRemCoverSheet.btnRemoveClick(Sender: TObject);
1116begin
1117 ChangeStatus(CVRemoveCode);
1118end;
1119
1120procedure TfrmRemCoverSheet.btnLockClick(Sender: TObject);
1121begin
1122 ChangeStatus(CVLockCode);
1123end;
1124
1125procedure TfrmRemCoverSheet.lvViewColumnClick(Sender: TObject;
1126 Column: TListColumn);
1127begin
1128 if FTopSortTag = Column.Tag then
1129 FTopSortUp := not FTopSortUp
1130 else
1131 FTopSortTag := Column.Tag;
1132 lvView.CustomSort(nil, 0);
1133end;
1134
1135type
1136 TSortData = (sdRem, sdSeq, sdLvl, sdOther);
1137
1138procedure TfrmRemCoverSheet.lvCoverColumnClick(Sender: TObject;
1139 Column: TListColumn);
1140begin
1141 if FBottomSortTag = Column.Tag then
1142 FBottomSortUp := not FBottomSortUp
1143 else
1144 FBottomSortTag := Column.Tag;
1145 lvCover.CustomSort(nil, 0);
1146end;
1147
1148procedure TfrmRemCoverSheet.lvViewCompare(Sender: TObject; Item1,
1149 Item2: TListItem; Data: Integer; var Compare: Integer);
1150var
1151 i: integer;
1152 odr: array[1..4] of TSortData;
1153 s1, s2: string;
1154
1155begin
1156 odr[1] := TSortData(FTopSortTag-1);
1157 case FTopSortTag of
1158 1: begin
1159 odr[2] := sdSeq;
1160 odr[3] := sdLvl;
1161 odr[4] := sdOther;
1162 end;
1163
1164 2: begin
1165 odr[2] := sdLvl;
1166 odr[3] := sdOther;
1167 odr[4] := sdRem;
1168 end;
1169
1170 3: begin
1171 odr[2] := sdOther;
1172 odr[3] := sdSeq;
1173 odr[4] := sdRem;
1174 end;
1175
1176 4: begin
1177 odr[2] := sdLvl;
1178 odr[3] := sdSeq;
1179 odr[4] := sdRem;
1180 end;
1181 end;
1182 Compare := 0;
1183 for i := 1 to 4 do
1184 begin
1185 case odr[i] of
1186 sdRem: begin
1187 s1 := Item1.Caption;
1188 s2 := Item2.Caption;
1189 end;
1190
1191 sdSeq: begin
1192 s1 := RPad(Item1.SubItems[IdxSeq]);
1193 s2 := RPad(Item2.SubItems[IdxSeq]);
1194 end;
1195
1196 sdLvl: begin
1197 s1 := Item1.SubItems[IdxLvl2];
1198 s2 := Item2.SubItems[IdxLvl2];
1199 end;
1200
1201 sdOther: begin
1202 s1 := Item1.SubItems[IdxType];
1203 s2 := Item2.SubItems[IdxType];
1204 end;
1205
1206 end;
1207 Compare := CompareText(s1, s2);
1208 if Compare <> 0 then break;
1209 end;
1210 if not FTopSortUp then
1211 Compare := -Compare;
1212end;
1213
1214procedure TfrmRemCoverSheet.lvCoverCompare(Sender: TObject; Item1,
1215 Item2: TListItem; Data: Integer; var Compare: Integer);
1216var
1217 i: integer;
1218 odr: array[1..2] of TSortData;
1219 s1, s2: string;
1220
1221begin
1222 case FBottomSortTag of
1223 1: begin
1224 odr[1] := sdRem;
1225 odr[2] := sdSeq;
1226 end;
1227
1228 2: begin
1229 odr[1] := sdSeq;
1230 odr[2] := sdRem;
1231 end;
1232 end;
1233 Compare := 0;
1234 for i := 1 to 2 do
1235 begin
1236 case odr[i] of
1237 sdRem: begin
1238 s1 := Item1.Caption;
1239 s2 := Item2.Caption;
1240 end;
1241
1242 sdSeq: begin
1243 s1 := RPad(Item1.SubItems[IdxSeq]);
1244 s2 := RPad(Item2.SubItems[IdxSeq]);
1245 end;
1246 end;
1247 Compare := CompareText(s1, s2);
1248 if Compare <> 0 then break;
1249 end;
1250 if not FBottomSortUp then
1251 Compare := -Compare;
1252end;
1253
1254procedure TfrmRemCoverSheet.sbUpClick(Sender: TObject);
1255var
1256 NextItem: TListItem;
1257 Seq1, Seq2: string;
1258
1259begin
1260 if assigned(lvCover.Selected) then
1261 begin
1262 if FBottomSortTag <> 2 then
1263 begin
1264 FBottomSortTag := 2;
1265 lvCover.CustomSort(nil, 0);
1266 end;
1267 if lvCover.Selected.Index > 0 then
1268 begin
1269 NextItem := lvCover.Items[lvCover.Selected.Index - 1];
1270 Seq1 := NextItem.SubItems[IdxSeq];
1271 Seq2 := lvCover.Selected.SubItems[IdxSeq];
1272 SetSeq(NextItem, Seq2);
1273 SetSeq(lvCover.Selected, Seq1);
1274 lvCover.CustomSort(nil, 0);
1275 If ScreenReaderSystemActive then
1276 GetScreenReader.Speak('Reminder Moved up in Sequence');
1277 UpdateButtons;
1278 end;
1279 end;
1280end;
1281
1282procedure TfrmRemCoverSheet.sbDownClick(Sender: TObject);
1283var
1284 NextItem: TListItem;
1285 Seq1, Seq2: string;
1286
1287begin
1288 if assigned(lvCover.Selected) then
1289 begin
1290 if FBottomSortTag <> 2 then
1291 begin
1292 FBottomSortTag := 2;
1293 lvCover.CustomSort(nil, 0);
1294 end;
1295 if lvCover.Selected.Index < (lvCover.Items.Count-1) then
1296 begin
1297 NextItem := lvCover.Items[lvCover.Selected.Index + 1];
1298 Seq1 := NextItem.SubItems[IdxSeq];
1299 Seq2 := lvCover.Selected.SubItems[IdxSeq];
1300 SetSeq(NextItem, Seq2);
1301 SetSeq(lvCover.Selected, Seq1);
1302 lvCover.CustomSort(nil, 0);
1303 If ScreenReaderSystemActive then
1304 GetScreenReader.Speak('Reminder Moved down in Sequence');
1305 UpdateButtons;
1306 end;
1307 end;
1308end;
1309
1310procedure TfrmRemCoverSheet.SetSeq(Item: TListItem; const Value: string);
1311var
1312 tmpSL: TORStringList;
1313 Idx: integer;
1314 tmp: string;
1315
1316begin
1317 tmpSL := GetCurrent(FEditingIEN, FEditingLevel, FALSE);
1318 if assigned(tmpSL) then
1319 begin
1320 Idx := GetIndex(tmpSL, Item);
1321 if Idx >= 0 then
1322 begin
1323 tmp := tmpSL[idx];
1324 if(Piece(Tmp,U,1) <> Value) then
1325 begin
1326 SetPiece(tmp,U,1,Value);
1327 tmpSL[idx] := tmp;
1328 MarkListAsChanged;
1329 SetupItem(Item, tmp);
1330 end;
1331 end;
1332 end;
1333end;
1334
1335procedure TfrmRemCoverSheet.sbCopyRightClick(Sender: TObject);
1336var
1337 i: integer;
1338 Seq, Cur, Idx: integer;
1339 tmpSL: TORStringList;
1340 IEN: string;
1341
1342begin
1343 if assigned(tvAll.Selected) then
1344 begin
1345 IEN := Piece(TORTreeNode(tvAll.Selected).StringData, U, 1);
1346 if ListHasData(IEN, IdxIEN) then
1347 begin
1348 ShowMsg('List already contains this Reminder');
1349 exit;
1350 end;
1351 if lvCover.Items.Count = 0 then
1352 Seq := 10
1353 else
1354 begin
1355 Seq := 0;
1356 for i := 0 to lvCover.Items.Count-1 do
1357 begin
1358 Cur := StrToIntDef(lvCover.Items[i].SubItems[IdxSeq], 0);
1359 if Seq < Cur then
1360 Seq := Cur;
1361 end;
1362 inc(Seq,10);
1363 if Seq > 999 then
1364 begin
1365 Seq := 999;
1366 while (Seq > 0) and ListHasData(IntToStr(Seq), IdxSeq) do dec(Seq);
1367 end;
1368 end;
1369 if Seq > 0 then
1370 begin
1371 tmpSL := GetCurrent(FEditingIEN, FEditingLevel, FALSE, TRUE);
1372 Idx := tmpSL.IndexOfPiece(IEN,U,2);
1373 if Idx < 0 then
1374 begin
1375 tmpSL.Add(IntToStr(Seq) + U + CVAddCode + TORTreeNode(tvAll.Selected).StringData);
1376 MarkListAsChanged;
1377 UpdateMasterListView;
1378 for i := 0 to lvCover.Items.Count-1 do
1379 if IEN = lvCover.Items[i].SubItems[IdxIEN] then
1380 begin
1381 lvCover.Selected := lvCover.Items[i];
1382 break;
1383 end;
1384 end;
1385 if ScreenReaderSystemActive then
1386 GetScreenReader.Speak('Reminder Added to ' + DataName[FEditingLevel] + ' Level Reminders List');
1387 end;
1388 end;
1389end;
1390
1391function TfrmRemCoverSheet.ListHasData(Seq: string; SubIdx: integer): boolean;
1392var
1393 i: integer;
1394
1395begin
1396 Result := FALSE;
1397 for i := 0 to lvCover.Items.Count-1 do
1398 if Seq = lvCover.Items[i].SubItems[SubIdx] then
1399 begin
1400 Result := TRUE;
1401 break;
1402 end;
1403end;
1404
1405procedure TfrmRemCoverSheet.udSeqChangingEx(Sender: TObject;
1406 var AllowChange: Boolean; NewValue: Smallint;
1407 Direction: TUpDownDirection);
1408begin
1409 if FUpdating or (not FInitialized) then exit;
1410 if ListHasData(IntToStr(NewValue), IdxSeq) then
1411 begin
1412 AllowChange := FALSE;
1413 case Direction of
1414 updUp: udSeq.Position := NewValue + 1;
1415 updDown: udSeq.Position := NewValue - 1;
1416 end;
1417 end;
1418end;
1419
1420procedure TfrmRemCoverSheet.sbCopyLeftClick(Sender: TObject);
1421var
1422 idx, Index, i: integer;
1423 tmpSL: TORStringList;
1424
1425begin
1426 if assigned(lvCover.Selected) then
1427 begin
1428 tmpSL := GetCurrent(FEditingIEN, FEditingLevel, FALSE);
1429 if assigned(tmpSL) then
1430 begin
1431 Idx := GetIndex(tmpSL, lvCover.Selected);
1432 Index := lvCover.Selected.Index;
1433 if Idx >= 0 then
1434 begin
1435 tmpSL.Delete(Idx);
1436 MarkListAsChanged;
1437 UpdateMasterListView;
1438 if lvCover.Items.Count > 0 then
1439 begin
1440 if Index > 0 then
1441 dec(Index);
1442 for i := 0 to lvCover.Items.Count-1 do
1443 if lvCover.Items[i].Index = Index then
1444 begin
1445 lvCover.Selected := lvCover.Items[i];
1446 break;
1447 end;
1448 end;
1449 if ScreenReaderSystemActive then
1450 GetScreenReader.Speak('Reminder Removed from ' + DataName[FEditingLevel] + ' Level Reminders List');
1451 end;
1452 end;
1453 if sbCopyLeft.Enabled and (not sbCopyLeft.Focused) then
1454 sbCopyLeft.SetFocus;
1455 end;
1456end;
1457
1458procedure TfrmRemCoverSheet.tvAllDblClick(Sender: TObject);
1459begin
1460 if sbCopyRight.Enabled then
1461 sbCopyRight.Click;
1462end;
1463
1464procedure TfrmRemCoverSheet.btnApplyClick(Sender: TObject);
1465begin
1466 SaveData(TRUE);
1467 btnApply.Enabled := FALSE;
1468end;
1469
1470procedure TfrmRemCoverSheet.btnOKClick(Sender: TObject);
1471begin
1472 SaveData(FALSE);
1473end;
1474
1475procedure TfrmRemCoverSheet.SaveData(FromApply: boolean);
1476var
1477 i, j: integer;
1478 tmpSL: TORStringList;
1479 DeleteIt, DoRefresh: boolean;
1480 Level, lvl: TRemCoverDataLevel;
1481 ALevel, AClass, Code, IEN: string;
1482
1483begin
1484 DoRefresh := FALSE;
1485 i := 0;
1486 while (i < FData.Count) do
1487 begin
1488 DeleteIt := FALSE;
1489 if(Piece(FData[i],U,2) = BoolChar[TRUE]) then
1490 begin
1491 tmpSL := TORStringList(FData.Objects[i]);
1492 if assigned(tmpSL) then
1493 begin
1494 Level := dlPackage;
1495 Code := copy(FData[i],1,1);
1496 for lvl := low(TRemCoverDataLevel) to high(TRemCoverDataLevel) do
1497 begin
1498 if DataCode[lvl] = Code then
1499 begin
1500 Level := lvl;
1501 break;
1502 end;
1503 end;
1504 if Level <> dlPackage then
1505 begin
1506 IEN := copy(Piece(FData[i],U,1),2,MaxInt);
1507 ALevel := InternalName[Level];
1508 ACLass := '';
1509 case Level of
1510 dlDivision, dlService, dlLocation, dlUser:
1511 ALevel := ALevel + '.`' + IEN;
1512 dlUserClass:
1513 AClass := IEN;
1514 end;
1515 for j := 0 to tmpSL.Count-1 do
1516 tmpSL[j] := pieces(tmpSL[j],U,1,2);
1517 SetCoverSheetLevelData(ALevel, AClass, tmpSL);
1518 tmpSL.Free;
1519 DeleteIt := TRUE;
1520 FDataSaved := TRUE;
1521 DoRefresh := TRUE;
1522 end;
1523 end;
1524 end;
1525 if DeleteIt then
1526 FData.Delete(i)
1527 else
1528 inc(i);
1529 end;
1530 if FromApply and DoRefresh then
1531 UpdateMasterListView;
1532end;
1533
1534procedure TfrmRemCoverSheet.lvCoverDblClick(Sender: TObject);
1535begin
1536 if sbCopyLeft.Enabled then
1537 sbCopyLeft.Click;
1538end;
1539
1540procedure TfrmRemCoverSheet.lvViewChange(Sender: TObject; Item: TListItem;
1541 Change: TItemChange);
1542begin
1543 lvViewSelectItem(Sender, Item, FALSE);
1544end;
1545
1546procedure TfrmRemCoverSheet.lvViewSelectItem(Sender: TObject; Item: TListItem;
1547 Selected: Boolean);
1548var
1549 lvl: TRemCoverDataLevel;
1550 i: integer;
1551 ClsName, TIEN, IEN, lvlName: string;
1552 ok: boolean;
1553
1554begin
1555 if assigned(lvView.Selected) and (not FUpdatingView) then
1556 begin
1557 FUpdatingView := TRUE;
1558 try
1559 lvl := TRemCoverDataLevel(StrToIntDef(lvView.Selected.SubItems[IdxLvl2],ord(dlUser)));
1560 IEN := lvView.Selected.SubItems[IdxIEN];
1561 lvlName := lvView.Selected.SubItems[IdxLvl];
1562 TIEN := lvView.Selected.SubItems[IdxTIEN];
1563 ClsName := lvView.Selected.SubItems[IdxType];
1564 ok := (lvl <> FEditingLevel);
1565 if(not ok) and (lvl = dlUserClass) then
1566 ok := (FEditingIEN <> StrToIntDef(TIEN,0));
1567 if (not FUserMode) and ok and (lvl <> dlPackage) then
1568 begin
1569 case lvl of
1570 dlSystem: FUpdatePending := cbSystem;
1571 dlDivision: FUpdatePending := cbDivision;
1572 dlService: FUpdatePending := cbService;
1573 dlLocation: FUpdatePending := cbLocation;
1574 dlUserClass: FUpdatePending := cbUserClass;
1575 dlUser: FUpdatePending := cbUser;
1576 end;
1577 if lvl = dlUserClass then
1578 begin
1579 cbxClass.InitLongList(ClsName);
1580 cbxClass.SelectByID(TIEN);
1581 FCurClass := cbxClass.ItemIEN;
1582 end;
1583 cbxDropDownClose(nil);
1584 end;
1585 if (lvl = FEditingLevel) then
1586 begin
1587 for i := 0 to lvCover.Items.Count-1 do
1588 if IEN = lvCover.Items[i].SubItems[IdxIEN] then
1589 begin
1590 lvCover.Selected := lvCover.Items[i];
1591 break;
1592 end;
1593 end;
1594 for i := 0 to lvView.Items.Count-1 do
1595 begin
1596 if (IEN = lvView.Items[i].SubItems[IdxIEN]) and
1597 (lvlName = lvView.Items[i].SubItems[IdxLvl]) then
1598 begin
1599 lvView.Selected := lvView.Items[i];
1600 break;
1601 end;
1602 end;
1603 finally
1604 FUpdatingView := FALSE;
1605 end;
1606 end;
1607end;
1608
1609function TfrmRemCoverSheet.RPad(Str: String): String;
1610begin
1611 Result := StringOfChar('0',7-length(Str)) + Str;
1612end;
1613
1614procedure TfrmRemCoverSheet.btnViewClick(Sender: TObject);
1615var
1616 frmRemCoverPreview: TfrmRemCoverPreview;
1617 CurSortOrder: integer;
1618 CurSortDir: boolean;
1619 i, idx, SeqCnt: integer;
1620 Lvl, LastLvl, tmp, AddCode, IEN, Seq, SortID: string;
1621 RemList, LvlList: TORStringList; // IEN^Name^Seq^SortID^Locked
1622 ANode: TTreeNode;
1623
1624 procedure GetAllChildren(PNode: TTreeNode; const ASeq, ASortID: string);
1625 var
1626 Node: TTreeNode;
1627
1628 begin
1629 PNode.Expand(FALSE);
1630 Node := PNode.GetFirstChild;
1631 while assigned(Node) do
1632 begin
1633 tmp := TORTreeNode(Node).StringData;
1634 if copy(tmp,1,1) = CVCatCode then
1635 GetAllChildren(Node, ASeq, ASortID)
1636 else
1637 begin
1638 if RemList.IndexOfPiece(Piece(tmp,u,1)) < 0 then
1639 begin
1640 SetPiece(tmp,u,3,ASeq);
1641 inc(SeqCnt);
1642 SortID := copy(ASortID,1,7) + RPad(IntToStr(SeqCnt)) + copy(ASortID,15,MaxInt);
1643 SetPiece(tmp,u,4,SortID);
1644 RemList.Add(tmp);
1645 end;
1646 end;
1647 Node := Node.GetNextSibling;
1648 end;
1649 end;
1650
1651begin
1652 Screen.OnActiveControlChange := fOldFocusChanged;
1653 try
1654 frmRemCoverPreview := TfrmRemCoverPreview.Create(Application);
1655 try
1656 CurSortOrder := FTopSortTag;
1657 CurSortDir := FTopSortUp;
1658 lvView.Items.BeginUpdate;
1659 try
1660 FTopSortTag := 3;
1661 FTopSortUp := TRUE;
1662 lvView.CustomSort(nil, 0);
1663 RemList := TORStringList.Create;
1664 try
1665 LvlList := TORStringList.Create;
1666 try
1667 LastLvl := '';
1668 for i := 0 to lvView.Items.Count-1 do
1669 begin
1670 Lvl := lvView.Items[i].SubItems[IdxLvl2];
1671 if LvL <> LastLvl then
1672 begin
1673 RemList.AddStrings(LvlList);
1674 LvlList.Clear;
1675 LastLvl := Lvl;
1676 end;
1677 IEN := lvView.Items[i].SubItems[IdxIEN];
1678 AddCode := lvView.Items[i].SubItems[IdxAdd];
1679 idx := RemList.IndexOfPiece(IEN);
1680 if AddCode = CVRemoveCode then
1681 begin
1682 if(idx >= 0) and (piece(RemList[idx],U,5) <> '1') then
1683 RemList.Delete(idx);
1684 end
1685 else
1686 begin
1687 if idx < 0 then
1688 begin
1689 Seq := lvView.Items[i].SubItems[IdxSeq];
1690 SortID := RPad(Seq) + '0000000' + lvl + copy(lvView.Items[i].SubItems[IdxTIEN] + '0000000000',1,10);
1691 tmp := IEN + U + lvView.Items[i].Caption + U + Seq + U + SortID;
1692 if AddCode = CVLockCode then
1693 tmp := tmp + U + '1';
1694 RemList.Add(tmp);
1695 end
1696 else
1697 if (AddCode = CVLockCode) and (piece(RemList[idx],U,5) <> '1') then
1698 begin
1699 tmp := RemList[idx];
1700 SetPiece(tmp,U,5,'1');
1701 RemList[idx] := tmp;
1702 end;
1703 end;
1704 end;
1705 RemList.AddStrings(LvlList);
1706 FTopSortTag := CurSortOrder;
1707 FTopSortUp := CurSortDir;
1708 lvView.CustomSort(nil, 0);
1709
1710 LvlList.Clear;
1711 //LvlList.Assign(RemList);
1712 FastAssign(RemList, LvlList);
1713 RemList.Clear;
1714 FInternalExpansion := TRUE;
1715 try
1716 for i := 0 to LvlList.Count-1 do
1717 begin
1718 IEN := piece(LvlList[i],U,1);
1719 if (copy(LvlList[i],1,1) = CVCatCode) then
1720 begin
1721 ANode := tvAll.Items.GetFirstNode;
1722 while assigned(ANode) do
1723 begin
1724 if IEN = piece(TORTreeNode(ANode).StringData,U,1) then
1725 begin
1726 SeqCnt := 0;
1727 GetAllChildren(ANode, Piece(LvlList[i], U, 3), Piece(LvlList[i], U, 4));
1728 ANode := nil;
1729 end
1730 else
1731 ANode := ANode.GetNextSibling;
1732 end;
1733 end
1734 else
1735 if RemList.IndexOfPiece(IEN) < 0 then
1736 RemList.Add(LvlList[i]);
1737 end;
1738 finally
1739 FInternalExpansion := FALSE;
1740 end;
1741 finally
1742 LvlList.Free;
1743 end;
1744
1745 RemList.SortByPiece(4);
1746 for i := 0 to RemList.Count-1 do
1747 begin
1748 with frmRemCoverPreview.lvMain.Items.Add do
1749 begin
1750 tmp := RemList[i];
1751 Caption := Piece(tmp, U, 2);
1752 SubItems.Add(Piece(tmp, U, 3));
1753 SubItems.Add(Piece(tmp, U, 4));
1754 end;
1755 end;
1756 finally
1757 RemList.Free;
1758 end;
1759 finally
1760 lvView.Items.EndUpdate;
1761 end;
1762 frmRemCoverPreview.ShowModal;
1763 finally
1764 frmRemCoverPreview.Free;
1765 end;
1766 finally
1767 Screen.OnActiveControlChange := ActiveControlChanged;
1768 end;
1769end;
1770
1771procedure TfrmRemCoverSheet.lvCoverKeyDown(Sender: TObject; var Key: Word;
1772 Shift: TShiftState);
1773begin
1774 if (Key = VK_DELETE) and sbCopyLeft.Enabled then
1775 sbCopyLeft.Click;
1776end;
1777
1778procedure TfrmRemCoverSheet.edtSeqKeyPress(Sender: TObject; var Key: Char);
1779begin
1780 if (Key < '0') or (Key > '9') then
1781 Key := #0;
1782end;
1783
1784procedure TfrmRemCoverSheet.cbxDivisionKeyDown(Sender: TObject;
1785 var Key: Word; Shift: TShiftState);
1786begin
1787 if (Key = VK_RETURN) and TORComboBox(Sender).DroppedDown then
1788 TORComboBox(Sender).DroppedDown := FALSE;
1789end;
1790
1791function TfrmRemCoverSheet.GetCoverSheetLvlData(ALevel,
1792 AClass: string): TStrings;
1793var
1794 IEN: string;
1795 i, j: integer;
1796
1797begin
1798 Result := GetCoverSheetLevelData(ALevel, AClass);
1799 for i := 0 to Result.Count-1 do
1800 begin
1801 IEN := copy(piece(Result[i],U,2),2,MaxInt);
1802 j := FMasterList.IndexOfPiece(IEN);
1803 if j >= 0 then
1804 Result[i] := Result[i] + piece(FMasterList[j],U,3);
1805 end;
1806end;
1807
1808procedure TfrmRemCoverSheet.SetButtonHints;
1809{This procedure sets the Lock, Add, and Remove button hints based on the
1810 selected parameter level}
1811begin
1812 if FEditingLevel = dlDivision then
1813 begin
1814 btnLock.hint := 'Adds Reminder to the Coversheet display and Locks the Reminder'
1815 + CRLF + 'so it can not be removed from the Coversheet display at any'
1816 + CRLF + 'of the lower levels (Service, Location, User Class, User).';
1817 btnRemove.hint := 'Removes Reminders from the Coversheet display. Will not'
1818 + CRLF + 'remove Reminders which are locked at the System level.';
1819 btnAdd.hint := 'Adds Reminders to the Coversheet at the Division level and'
1820 + CRLF + 'below. It also removes the lock from a Reminder locked at'
1821 + CRLF + 'the Division level while leaving the Reminder on the Coversheet.';
1822 end
1823 else if FEditingLevel = dlService then
1824 begin
1825 btnLock.hint := 'Adds Reminder to the Coversheet display and Locks the Reminder'
1826 + CRLF + 'so it can not be removed from the Coversheet display at any of'
1827 + CRLF + 'the lower levels (Location, User Class, User).';
1828 btnRemove.hint := 'Removes Reminders from the Coversheet display. Will not'
1829 + CRLF + 'remove Reminders which are locked at the Division level or higher.';
1830 btnAdd.hint := 'Adds Reminders to the Coversheet at the Service level and'
1831 + CRLF + 'below. It also removes the lock from a Reminder locked at the'
1832 + CRLF + 'Service level while leaving the Reminder on the Coversheet.';
1833 end
1834 else if FEditingLevel = dlLocation then
1835 begin
1836 btnLock.hint := 'Adds Reminder to the Coversheet display and Locks the Reminder'
1837 + CRLF + 'so it can not be removed from the Coversheet display at any of'
1838 + CRLF + 'the lower levels (User Class, User).';
1839 btnRemove.hint := 'Removes Reminders from the Coversheet display. Will not'
1840 + CRLF + 'remove Reminders which are locked at the Service level or higher.';
1841 btnAdd.hint := 'Adds Reminders to the Coversheet at the Location level and'
1842 + CRLF + 'below. It also removes the lock from a Reminder locked at the'
1843 + CRLF + 'Location level while leaving the Reminder on the Coversheet.';
1844 end
1845 else if FEditingLevel = dlUserClass then
1846 begin
1847 btnLock.hint := 'Adds Reminder to the Coversheet display and Locks the Reminder so'
1848 + CRLF + 'it can not be removed from the Coversheet display at the User level.';
1849 btnRemove.hint := 'Removes Reminders from the Coversheet display. Will not remove'
1850 + CRLF + 'Reminders which are locked at the Location level or higher.';
1851 btnAdd.hint := 'Adds Reminders to the Coversheet at the User Class level and'
1852 + CRLF + 'below. It also removes the lock from a Reminder locked at the'
1853 + CRLF + 'User Class level while leaving the Reminder on the Coversheet.';
1854 end
1855 else if FEditingLevel = dlUser then
1856 begin
1857 btnRemove.hint := 'Removes Reminders from the Coversheet display. Will not'
1858 + CRLF + 'remove Reminders which are locked at the User Class level'
1859 + CRLF + 'or higher.';
1860 btnAdd.hint := 'Adds Reminders to the Coversheet at the User level.';
1861 end
1862 else
1863 begin
1864 btnLock.hint := 'Adds Reminder to the Coversheet display and Locks the Reminder'
1865 + CRLF + 'so it can not be removed from the Coversheet display at any of'
1866 + CRLF + 'the lower levels (Division, Service, Location, User Class, User).';
1867 btnRemove.hint := 'Removes Reminders from the Coversheet display.';
1868 btnAdd.hint := 'Adds Reminders to the Coversheet at the System level and'
1869 + CRLF + 'below. It also removes the lock from a Reminder locked at the'
1870 + CRLF + 'System level while leaving the Reminder on the Coversheet.';
1871 end;
1872end;
1873
1874procedure TfrmRemCoverSheet.FormCreate(Sender: TObject);
1875begin
1876 FSavePause := Application.HintHidePause; //Save Hint Pause setting
1877 Application.HintHidePause := 20000; //Reset Hint Pause to 20 seconds
1878 mlgnLock.hint := 'Lock a Reminder to prevent it''s removal from a lower'
1879 + CRLF + 'level Coversheet display. For example, if you lock'
1880 + CRLF + 'a Reminder at the Service level, then that Reminder'
1881 + CRLF + 'can not be removed from the coversheet display at'
1882 + CRLF + 'the Location, User Class, or User levels.';
1883 fOldFocusChanged := Screen.OnActiveControlChange;
1884 Screen.OnActiveControlChange := ActiveControlChanged;
1885end;
1886
1887procedure TfrmRemCoverSheet.ActiveControlChanged(Sender: TObject);
1888begin
1889 if assigned(fOldFocusChanged) then fOldFocusChanged(Sender);
1890 UpdateButtons;
1891end;
1892
1893procedure TfrmRemCoverSheet.LockButtonUpdate(Data, FNAME, Hint: string);
1894begin
1895 btnLock.Caption := Data;
1896 btnLock.Glyph.LoadFromResourceName(hinstance, FNAME);
1897 if btnLock.Hint <> Hint then btnLock.Hint := Hint;
1898 if FNAME = 'BMP_LOCK' then btnLock.OnClick := btnLockClick
1899 else
1900 btnLock.OnClick := btnAddClick;
1901end;
1902
1903end.
Note: See TracBrowser for help on using the repository browser.