source: cprs/branches/tmg-cprs/CPRS-Chart/fRemCoverSheet.pas@ 1680

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

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