source: cprs/trunk/CPRS-Chart/fRemCoverSheet.pas@ 583

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

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