source: cprs/trunk/CPRS-Chart/fReminderTree.pas@ 1800

Last change on this file since 1800 was 1679, checked in by healthsevak, 10 years ago

Updating the working copy to CPRS version 28
File size: 21.9 KB
RevLine 
[456]1unit fReminderTree;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
[830]7 StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ImgList, ORFn, Menus, fBase508Form,
8 VA508AccessibilityManager, VA508ImageListLabeler;
[456]9
10type
[830]11 TtvRem508Manager = class(TVA508ComponentManager)
12 private
13 function getDueDate(sData : String): String;
14 function getLastOcc(sData : String): String;
15 function getPriority(sData : String): String;
16 function getName(sData : String): String;
17 function getImgText(Node : TORTreeNode): String;
18 public
19 constructor Create; override;
20 function GetValue(Component: TWinControl): string; override;
21 function GetItem(Component: TWinControl): TObject; override;
22 end;
23
24 TfrmReminderTree = class(TfrmBase508Form)
[456]25 pnlTop: TPanel;
26 tvRem: TORTreeView;
27 hcRem: THeaderControl;
28 pnlTopRight: TPanel;
29 bvlGap: TBevel;
30 lbRem: TORListBox;
31 mmMain: TMainMenu;
32 memAction: TMenuItem;
33 memEvalAll: TMenuItem;
34 memEval: TMenuItem;
35 N2: TMenuItem;
36 memRefresh: TMenuItem;
37 memEvalCat: TMenuItem;
38 mnuCoverSheet: TMenuItem;
39 mnuExit: TMenuItem;
[830]40 imgLblReminders: TVA508ImageListLabeler;
[456]41 procedure FormClose(Sender: TObject; var Action: TCloseAction);
42 procedure FormCreate(Sender: TObject);
43 procedure tvRemExpanded(Sender: TObject; Node: TTreeNode);
44 procedure tvRemCollapsed(Sender: TObject; Node: TTreeNode);
45 procedure pnlTopResize(Sender: TObject);
46 procedure lbRemDrawItem(Control: TWinControl; Index: Integer;
47 Rect: TRect; State: TOwnerDrawState);
48 procedure lbRemChange(Sender: TObject);
49 procedure lbRemClick(Sender: TObject);
50 procedure tvRemEnter(Sender: TObject);
51 procedure tvRemExit(Sender: TObject);
52 procedure hcRemSectionClick(HeaderControl: THeaderControl;
53 Section: THeaderSection);
54 procedure tvRemClick(Sender: TObject);
55 procedure tvRemChange(Sender: TObject; Node: TTreeNode);
56 procedure tvRemMouseDown(Sender: TObject; Button: TMouseButton;
57 Shift: TShiftState; X, Y: Integer);
58 procedure memEvalClick(Sender: TObject);
59 procedure memEvalAllClick(Sender: TObject);
60 procedure FormDestroy(Sender: TObject);
61 procedure memRefreshClick(Sender: TObject);
62 procedure memActionClick(Sender: TObject);
63 procedure memEvalCatClick(Sender: TObject);
64 procedure mnuCoverSheetClick(Sender: TObject);
65 procedure tvRemNodeCaptioning(Sender: TObject; var Caption: String);
66 procedure mnuExitClick(Sender: TObject);
[1679]67 procedure tvRemKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
[456]68 private
[830]69 tvRem508Manager : TtvRem508Manager;
[456]70 FLinking: boolean;
71 FSortOrder: integer;
72 FSortAssending: boolean;
73 FSorting: boolean;
74 FUpdating: boolean;
75 memView: TORMenuItem;
76 DateColWidth: integer;
77 LastDateColWidth: integer;
78 PriorityColWidth: integer;
79 procedure SetRemHeaderSectionWidth( SectionIndex: integer; NewWidth: integer);
80 protected
81 procedure Resync(FromTree: boolean);
82 procedure RemindersChanged(Sender: TObject);
83 procedure ResetlbItems(RootNode: TTreeNode);
84 procedure LinkTopControls(FromTree: boolean);
85 procedure SyncTopControls(FromTree: boolean);
86 procedure SortNode(const Node: TTreeNode);
87 function SortData(Node: TORTreeNode): string;
88// procedure PositionToReminder(Sender: TObject);
89 procedure ProcessedRemindersChanged(Sender: TObject);
90 public
91 procedure EnableActions;
92 procedure SetFontSize( NewFontSize: integer);
93 end;
94
95procedure ViewReminderTree;
96
97var
98 frmReminderTree: TfrmReminderTree = nil;
99 RemTreeDlgLeft: integer = 0;
100 RemTreeDlgTop: integer = 0;
101 RemTreeDlgWidth: integer = 0;
102 RemTreeDlgHeight: integer = 0;
103
104const
105 ReminderTreeName = 'frmReminderTree';
106
107implementation
108
109uses uReminders, dShared, uConst, fReminderDialog, fNotes, rMisc,
[830]110 rReminders, fRemCoverSheet, VA2006Utils;
[456]111
112{$R *.DFM}
113
114const
115 UnscaledDateColWidth = 70;
116 UnscaledLastDateColWidth = 89;
117 UnscaledPriorityColWidth = 43;
118
119procedure ViewReminderTree;
120
121begin
122 if(not InitialRemindersLoaded) then
123 StartupReminders;
124 if(not assigned(frmReminderTree)) then
125 frmReminderTree := TfrmReminderTree.Create(Application);
126 frmReminderTree.Show;
127end;
128
129procedure TfrmReminderTree.FormClose(Sender: TObject;
130 var Action: TCloseAction);
131begin
132 Action := caFree;
133end;
134
135procedure TfrmReminderTree.FormCreate(Sender: TObject);
136begin
[830]137 FixHeaderControlDelphi2006Bug(hcRem);
[456]138 memView := TORMenuItem.Create(mmMain);
139 memView.Caption := '&View';
140 memView.Add(TORMenuItem.Create(memView));
141 mmMain.Items.Insert(0, memView);
142
143 bvlGap.Height := GetSystemMetrics(SM_CYHSCROLL);
144 FSortOrder := -1;
145 FSortAssending := TRUE;
146 SetReminderMenuSelectRoutine(memView);
147 NotifyWhenRemindersChange(RemindersChanged);
148// NotifyWhenProcessingReminderChanges(PositionToReminder);
149 ProcessedReminders.Notifier.NotifyWhenChanged(ProcessedRemindersChanged);
150 SetFontSize(MainFontSize);
151 SetReminderFormBounds(Self, 0, 0, Self.Width, Self.Height,
152 RemTreeDlgLeft, RemTreeDlgTop, RemTreeDlgWidth, RemTreeDlgHeight);
[830]153 tvRem508Manager := TtvRem508Manager.Create;
154 amgrMain.ComponentManager[tvRem] := tvRem508Manager;
[456]155end;
156
157procedure TfrmReminderTree.LinkTopControls(FromTree: boolean);
158var
159 idx: integer;
160
161begin
162 if(not FLinking) then
163 begin
164 FLinking := TRUE;
165 try
166 if(FromTree) then
167 begin
168 if(assigned(tvRem.Selected)) then
169 begin
170 idx := lbRem.Items.IndexOfObject(tvRem.Selected);
171 lbRem.ItemIndex := idx;
[1679]172 tvRem.Selected := TTreeNode(lbRem.Items.Objects[lbRem.ItemIndex]);
173 tvRem.SetFocus;
[456]174 end
175 else
176 lbRem.ItemIndex := -1;
177 end
178 else
179 begin
180 if(lbRem.ItemIndex < 0) then
181 tvRem.Selected := nil
182 else
[1679]183 begin
184 tvRem.Selected := TTreeNode(lbRem.Items.Objects[lbRem.ItemIndex]);
185 tvRem.SetFocus;
186 end;
[456]187 end;
188 finally
189 FLinking := FALSE;
190 end;
191 end;
192end;
193
194procedure TfrmReminderTree.RemindersChanged(Sender: TObject);
195const
196 ARTxt = 'Available Reminders';
197
198var
199 OldUpdating: boolean;
200
201begin
202 EnableActions;
203 if(GetReminderStatus = rsNone) then
204 begin
205 tvRem.Selected := nil;
206 Close;
207 exit;
208 end;
209 OldUpdating := FUpdating;
210 try
211 FUpdating := TRUE;
212 lbRem.Items.BeginUpdate;
213 try
214 try
215 BuildReminderTree(tvRem);
216 lbRem.Clear;
217 ResetlbItems(nil);
218 LinkTopControls(TRUE);
219 SyncTopControls(TRUE);
220 pnlTopResize(Self);
221 finally
222 FUpdating := FALSE;
223 tvRem.Invalidate;
224 lbRem.Invalidate;
225 end;
226 if(RemindersEvaluatingInBackground) then
227 hcRem.Sections[0].Text := ARTxt + ' (Evaluating Reminders...)'
228 else
229 hcRem.Sections[0].Text := ARTxt;
230 finally
231 lbRem.Items.EndUpdate;
232 end;
233 finally
234 FUpdating := OldUpdating;
235 end;
236end;
237
238procedure TfrmReminderTree.ResetlbItems(RootNode: TTreeNode);
239var
240 Firsti, i: integer;
241 First, Node: TTreeNode;
242 sl: TStringList;
243 lvl: integer;
244 Add2LB: boolean;
245 Tmp, Data: string;
246
247 function IsVis(Node: TTreeNode): boolean; // IsVisible doesn't work when updating
248 begin
249 Result := TRUE;
250 Node := Node.Parent;
251 while(Result and (assigned(Node))) do
252 begin
253 Result := Node.Expanded;
254 Node := Node.Parent;
255 end;
256 end;
257
258begin
259 if(not FSorting) then
260 begin
261 if(assigned(RootNode)) then
262 begin
263 Node := RootNode.GetFirstChild;
264 lvl := RootNode.Level;
265 Add2LB := RootNode.Expanded;
266 Firsti := lbRem.Items.IndexOfObject(RootNode)+1;
267 end
268 else
269 begin
270 Node := tvRem.Items.GetFirstNode;
271 lvl := -1;
272 Add2LB := TRUE;
273 Firsti := 0;
274 end;
275 First := Node;
276 if(assigned(Node)) then
277 begin
278 sl := TStringList.Create;
279 try
[830]280 sl.Assign(lbRem.Items); // Must use regualr assign, FastAssign doesn't copy objects.
[456]281 while(assigned(Node) and (Node.Level > lvl)) do
282 begin
283 i := sl.IndexOfObject(Node);
284 if(i >= 0) then
285 sl.Delete(i);
286 Node := Node.GetNext;
287 end;
288 if(Add2LB) then
289 begin
290 i := Firsti;
291 Node := First;
292 while(assigned(Node) and (Node.Level > lvl)) do
293 begin
294 if(IsVis(Node)) then
295 begin
296 Tmp := TORTreeNode(Node).StringData;
297 Data := Piece(Tmp,U,RemTreeDateIdx) + U + Piece(Tmp,U,RemTreeDateIdx+1) + U +
298 RemPriorityText[StrToIntDef(Piece(Tmp, U, 5), 2)];
299 sl.InsertObject(i, Data, Node);
300 inc(i);
301 end;
302 Node := Node.GetNext;
303 end;
304 end;
305 lbRem.Items.Assign(sl);
306 finally
307 sl.Free;
308 end;
309 end;
310 end;
311end;
312
313procedure TfrmReminderTree.SyncTopControls(FromTree: boolean);
314begin
315 if(lbRem.Items.Count > 0) and (tvRem.TopItem <> lbRem.Items.Objects[lbRem.TopIndex]) then
316 begin
317 if(FromTree) then
318 lbRem.TopIndex := lbRem.Items.IndexOfObject(tvRem.TopItem)
319 else
320 tvRem.TopItem := TTreeNode(lbRem.Items.Objects[lbRem.TopIndex]);
321 end;
322end;
323
324procedure TfrmReminderTree.tvRemExpanded(Sender: TObject; Node: TTreeNode);
325begin
326 if(FUpdating) then exit;
327 FUpdating := TRUE;
328 try
[1679]329 tvRem.Selected := Node;
[456]330 ResetlbItems(Node);
331 pnlTopResize(Self);
332 finally
333 FUpdating := FALSE;
334 end;
335end;
336
[1679]337procedure TfrmReminderTree.tvRemKeyDown(Sender: TObject; var Key: Word;
338 Shift: TShiftState);
339begin
340 inherited;
341 if (Key = VK_LEFT) or (Key = VK_RIGHT) then tvRemClick(Sender);
342end;
343
[456]344procedure TfrmReminderTree.tvRemCollapsed(Sender: TObject;
345 Node: TTreeNode);
346begin
347 if(FUpdating) then exit;
348 FUpdating := TRUE;
349 try
[1679]350 tvRem.Selected := Node;
[456]351 ResetlbItems(Node);
352 pnlTopResize(Self);
353 finally
354 FUpdating := FALSE;
355 end;
356end;
357
358procedure TfrmReminderTree.pnlTopResize(Sender: TObject);
359var
360 Tmp,Adj: integer;
361
362begin
363 Tmp := DateColWidth + LastDateColWidth + PriorityColWidth + 4;
364 if(lbRem.Width <> (lbRem.ClientWidth + 4)) then
365 Adj := ScrollBarWidth
366 else
367 Adj := 0;
368 pnlTopRight.Width := Tmp + Adj;
369 Tmp := pnlTop.Width - DateColWidth - LastDateColWidth - PriorityColWidth - 2 - Adj;
370 SetRemHeaderSectionWidth( 0, Tmp);
371 tvRem.Items.BeginUpdate;
372 try
373 tvRem.Height := pnlTop.Height - hcRem.Height;
374 if(tvRem.Width <> (tvRem.ClientWidth+4)) then
375 inc(Tmp, ScrollBarWidth);
376 tvRem.Width := Tmp;
377 finally
378 tvRem.Items.EndUpdate;
379 end;
380 bvlGap.Visible := (tvRem.Height <> (tvRem.ClientHeight+4));
381end;
382
383procedure TfrmReminderTree.lbRemDrawItem(Control: TWinControl;
384 Index: Integer; Rect: TRect; State: TOwnerDrawState);
385var
386 Tmp: string;
387 Flags: Longint;
388
389begin
390 SyncTopControls(FALSE);
391 if (odSelected in State) then
392 begin
393 if((ActiveControl = lbRem) or (ActiveControl = tvRem)) then
394 begin
395 lbRem.Canvas.Brush.Color := clHighlight;
396 lbRem.Canvas.Font.Color := clHighlightText
397 end
398 else
399 begin
400 lbRem.Canvas.Brush.Color := clInactiveBorder;
401 lbRem.Canvas.Font.Color := clWindowText;
402 end;
403 end;
404 Flags := lbRem.DrawTextBiDiModeFlags(DT_SINGLELINE or DT_VCENTER);
405 Tmp := piece(lbRem.Items[Index],U,1);
406 lbRem.Canvas.FillRect(Rect);
407 Inc(Rect.Left, 6);
408 DrawText(lbRem.Canvas.Handle, PChar(Tmp), Length(Tmp), Rect, Flags);
409 inc(Rect.Left, DateColWidth);
410 Tmp := piece(lbRem.Items[Index],U,2);
411 DrawText(lbRem.Canvas.Handle, PChar(Tmp), Length(Tmp), Rect, Flags);
412 inc(Rect.Left, LastDateColWidth);
413 Tmp := piece(lbRem.Items[Index],U,3);
414 DrawText(lbRem.Canvas.Handle, PChar(Tmp), Length(Tmp), Rect, Flags);
415end;
416
417procedure TfrmReminderTree.lbRemChange(Sender: TObject);
418begin
419 Resync(FALSE);
420 tvRem.SetFocus;
421end;
422
423procedure TfrmReminderTree.lbRemClick(Sender: TObject);
424begin
425 tvRem.SetFocus;
426end;
427
428procedure TfrmReminderTree.tvRemEnter(Sender: TObject);
429begin
430 if(FUpdating) then exit;
431 if(ActiveControl = lbRem) or (ActiveControl = tvRem) then
432 lbRem.Invalidate;
433end;
434
435procedure TfrmReminderTree.tvRemExit(Sender: TObject);
436begin
437 if(FUpdating) then exit;
438 if(ActiveControl <> lbRem) and (ActiveControl <> tvRem) then
439 lbRem.Invalidate;
440end;
441
442procedure TfrmReminderTree.hcRemSectionClick(HeaderControl: THeaderControl;
443 Section: THeaderSection);
444var
445 i, SortIdx: integer;
446 exp: boolean;
447 Sel, Node: TTreeNode;
448
449begin
450 SortIdx := -1;
451 for i := 0 to 3 do
452 begin
453 if(Section = hcRem.Sections[i]) then
454 begin
455 SortIdx := i;
456 break;
457 end;
458 end;
459 if(SortIdx >= 0) then
460 begin
461 Sel := tvRem.Selected;
462 if(FSortOrder = SortIdx) then
463 FSortAssending := not FSortAssending
464 else
465 FSortOrder := SortIdx;
466
467 FSorting := TRUE;
468 tvRem.Items.BeginUpdate;
469 try
470 Node := tvRem.Items.GetFirstNode;
471 while(assigned(Node)) do
472 begin
473 exp := Node.Expanded;
474 SortNode(Node);
475 if(Node.Expanded <> exp) then
476 Node.Expanded := exp;
477 Node := Node.GetNextSibling;
478 end;
479 finally
480 tvRem.Items.EndUpdate;
481 FSorting := FALSE;
482 end;
483 ResetlbItems(nil);
484 tvRem.Selected := Sel;
485 end;
486end;
487
488procedure TfrmReminderTree.SortNode(const Node: TTreeNode);
489var
490 i: integer;
491 sl: TStringList;
492 Tmp, TmpLast: TTreeNode;
493 exp: boolean;
494
495begin
496 if(Node.HasChildren) then
497 begin
498 sl := TStringList.Create;
499 try
500 Tmp := Node.GetFirstChild;
501 while assigned(Tmp) do
502 begin
503 sl.AddObject(SortData(TORTreeNode(Tmp)), Tmp);
504 Tmp := Tmp.GetNextSibling;
505 end;
506 sl.sort;
507 TmpLast := Node;
508 for i := 0 to sl.Count-1 do
509 begin
510 if(FSortAssending) then
511 Tmp := TTreeNode(sl.Objects[i])
512 else
513 Tmp := TTreeNode(sl.Objects[sl.Count-1-i]);
514 exp := Tmp.Expanded;
515 if(i = 0) then
516 Tmp.MoveTo(TmpLast, naAddChildFirst)
517 else
518 Tmp.MoveTo(TmpLast, naInsert);
519 TmpLast := Tmp;
520 SortNode(Tmp);
521 Tmp.Expanded := exp;
522 end;
523 finally
524 sl.Free;
525 end;
526 end;
527end;
528
529function TfrmReminderTree.SortData(Node: TORTreeNode): string;
530
531 function ZForm(str: string; Num: integer): string;
532 begin
533 Result := copy(StringOfChar('0', Num)+str,1+length(str),Num);
534 end;
535
536begin
537 Result := ZForm(piece(Node.StringData, U, RemTreeDateIdx+2),5);
538 case FSortOrder of
539 1: Result := ZForm(Piece(Node.StringData, U, 3), 15)+'.'+Result;
540 2: Result := ZForm(Piece(Node.StringData, U, 4), 15)+'.'+Result;
541 3: Result := Piece(Node.StringData, U, 5)+'.'+Result;
542 end;
543end;
544
545procedure TfrmReminderTree.tvRemClick(Sender: TObject);
546begin
547 Resync(TRUE);
548end;
549
550procedure TfrmReminderTree.tvRemChange(Sender: TObject; Node: TTreeNode);
551var
552 p1: string;
553
554begin
555 memView.Data := '';
556 if(assigned(Node)) then
557 begin
558 p1 := Piece((Node as TORTreeNode).StringData, U, 1);
559 if(Copy(p1,1,1) = RemCode) then
560 begin
561 memView.Data := (Node as TORTreeNode).StringData;
562 end;
563 end;
564 EnableActions;
565
566 Resync(TRUE);
567end;
568
569procedure TfrmReminderTree.tvRemMouseDown(Sender: TObject;
570 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
571begin
[1679]572 //Resync(TRUE);
[456]573end;
574
575procedure TfrmReminderTree.Resync(FromTree: boolean);
576begin
577 if(FUpdating) then exit;
578 FUpdating := TRUE;
579 try
580 LinkTopControls(FromTree);
581 SyncTopControls(FromTree);
582 finally
583 FUpdating := FALSE;
584 end;
585end;
586
587{procedure TfrmReminderTree.PositionToReminder(Sender: TObject);
588begin
589 if(assigned(Sender)) then
590 begin
591 if(Sender is TReminder) then
592 begin
593 tvRem.Selected := tvRem.FindPieceNode(RemCode + (Sender as TReminder).IEN, 1);
594 if(assigned(tvRem.Selected)) then
595 TORTreeNode(tvRem.Selected).EnsureVisible;
596 end;
597 end
598 else
599 tvRem.Selected := nil;
600end;}
601
602procedure TfrmReminderTree.memEvalClick(Sender: TObject);
603var
604 Node: TORTreeNode;
605 p1: string;
606
607begin
608 Node := TORTreeNode(tvRem.Selected);
609 if(assigned(Node)) then
610 begin
611 p1 := Piece(Node.StringData, U, 1);
612 if(Copy(p1,1,1) = RemCode) then
613 EvalReminder(StrToIntDef(Copy(p1,2,MaxInt),0));
614 end;
615end;
616
617procedure TfrmReminderTree.EnableActions;
618var
619 OK: boolean;
620 Node: TORTreeNode;
621 p1: string;
622
623begin
624 Node := TORTreeNode(tvRem.Selected);
625 if(assigned(Node)) then
626 p1 := Piece(Node.StringData, U, 1)
627 else
628 p1 := '';
629 if(assigned(Node)) then
630 OK := (Copy(p1,1,1) = RemCode)
631 else
632 OK := FALSE;
633 memEval.Enabled := OK;
634 memEvalAll.Enabled := (ProcessedReminders.Count > 0);
635 memRefresh.Enabled := (not ReminderDialogActive);
636 mnuCoverSheet.Enabled := (NewRemCoverSheetListActive or CanEditAllRemCoverSheetLists);
637 memAction.Enabled := (OK or memEvalAll.Enabled or memRefresh.Enabled or mnuCoverSheet.Enabled);
638 if(assigned(Node)) then
639 OK := ((Copy(p1,1,1) = CatCode) and (p1 <> OtherCatID) and (Node.HasChildren))
640 else
641 OK := FALSE;
642 memEvalCat.Enabled := OK;
643 memEvalCat.Tag := integer(Node);
644end;
645
646procedure TfrmReminderTree.ProcessedRemindersChanged(Sender: TObject);
647begin
648 EnableActions;
649end;
650
651procedure TfrmReminderTree.memEvalAllClick(Sender: TObject);
652begin
653 EvalProcessed;
654end;
655
656procedure TfrmReminderTree.FormDestroy(Sender: TObject);
657begin
658 frmReminderTree := nil;
659 ProcessedReminders.Notifier.RemoveNotify(ProcessedRemindersChanged);
660// RemoveNotifyWhenProcessingReminderChanges(PositionToReminder);
661 RemoveNotifyRemindersChange(RemindersChanged);
662 RemTreeDlgLeft := Self.Left;
663 RemTreeDlgTop := Self.Top;
664 RemTreeDlgWidth := Self.Width;
665 RemTreeDlgHeight := Self.Height;
666end;
667
668procedure TfrmReminderTree.memRefreshClick(Sender: TObject);
669begin
670 KillObj(@ReminderDialogInfo, TRUE);
671 UpdateReminderDialogStatus;
672 EnableActions;
673end;
674
675procedure TfrmReminderTree.memActionClick(Sender: TObject);
676begin
677 EnableActions;
678end;
679
680procedure TfrmReminderTree.memEvalCatClick(Sender: TObject);
681begin
682 EvaluateCategoryClicked(nil, Sender);
683end;
684
685procedure TfrmReminderTree.mnuCoverSheetClick(Sender: TObject);
686begin
687 EditCoverSheetReminderList(not CanEditAllRemCoverSheetLists);
688end;
689
690procedure TfrmReminderTree.SetFontSize(NewFontSize: integer);
691var
692 TotalWidth: integer;
693begin
694 DateColWidth := ResizeWidth(Font, MainFont, UnscaledDateColWidth);
695 LastDateColWidth := ResizeWidth(Font, MainFont, UnscaledLastDateColWidth);
696 PriorityColWidth := ResizeWidth(Font, MainFont, UnscaledPriorityColWidth);
697 ResizeAnchoredFormToFont(self);
698 TotalWidth := hcRem.Width;
699 SetRemHeaderSectionWidth( 0, TotalWidth - DateColWidth - LastDateColWidth - PriorityColWidth);
700 SetRemHeaderSectionWidth( 1, DateColWidth);
701 SetRemHeaderSectionWidth( 2, LastDateColWidth);
702 SetRemHeaderSectionWidth( 3, PriorityColWidth);
703
704 lbRem.ItemHeight := ((Abs(Font.Height)+ 6) div 2)*2; //tvRem.ItemHeight;
705 //This is called "best guess calibration"
706 if Font.Size > 12 then lbRem.ItemHeight := lbRem.ItemHeight + 2;
707 //I am reluctant to use an alignment on the tvRem as there si lots of resizing
708 //tricks going on with the scroll bar at the bottom.
709 tvRem.Top := hcRem.Top+hcRem.Height;
710 pnlTopResize(self);
711end;
712
713procedure TfrmReminderTree.SetRemHeaderSectionWidth( SectionIndex: integer; NewWidth: integer);
714begin
715 hcRem.Sections[SectionIndex].MinWidth := 0;
716 hcRem.Sections[SectionIndex].MaxWidth := NewWidth;
717 hcRem.Sections[SectionIndex].MinWidth := NewWidth;
718 hcRem.Sections[SectionIndex].Width := NewWidth;
719end;
720
721procedure TfrmReminderTree.tvRemNodeCaptioning(Sender: TObject;
722 var Caption: String);
723var
724 StringData: string;
725begin
726 StringData := (Sender as TORTreeNode).StringData;
727 if (Length(StringData) > 0) and (StringData[1] = 'R') then //Only tag reminder statuses
728 case StrToIntDef(Piece(StringData,'^',6 {Due}),-1) of
729 0: Caption := Caption + ' -- Applicable';
730 1: Caption := Caption + ' -- DUE';
731 2: Caption := Caption + ' -- Not Applicable';
732 else Caption := Caption + ' -- Not Evaluated';
733 end;
734end;
735
[830]736procedure TfrmReminderTree.mnuExitClick(Sender: TObject);
[456]737begin
[830]738 Close;
[456]739end;
740
[830]741{ TGrdLab508Manager }
742
743constructor TtvRem508Manager.Create;
[456]744begin
[830]745 inherited Create([mtValue, mtItemChange]);
[456]746end;
747
[830]748function TtvRem508Manager.getDueDate(sData: String): String;
[456]749begin
[830]750 Result := Piece(sData,U,3);
751 if Result <> '' then
752 Result := ' Due Date: ' + FormatFMDateTimeStr('mm/dd/yyyy',Result);
[456]753end;
754
[830]755function TtvRem508Manager.getImgText(Node: TORTreeNode): String;
756begin
757 Result := '';
758 if Node.ImageIndex > -1 then
759 Result := frmReminderTree.imgLblReminders.RemoteLabeler.Labels.Items[Node.ImageIndex].Caption + ' ';
760end;
761
762function TtvRem508Manager.GetItem(Component: TWinControl): TObject;
763var
764 tv : TORTreeView;
765begin
766 tv := TORTreeView(Component);
767 Result := tv.Selected;
768end;
769
770function TtvRem508Manager.getLastOcc(sData: String): String;
771begin
772 Result := Piece(sData,U,4);
773 if Result <> '' then
774 Result := ' Last Occurrence: ' + FormatFMDateTimeStr('mm/dd/yyyy',Result);
775end;
776
777function TtvRem508Manager.getName(sData: String): String;
778begin
779 Result := Piece(sData,U,2);
780end;
781
782function TtvRem508Manager.getPriority(sData: String): String;
783begin
784 Result := Piece(sData,U,5);
785 if Result = '2' then
786 Result := '';
787 if Result <> '' then
788 Result := ' Priority: ' + Result;
789end;
790
791function TtvRem508Manager.GetValue(Component: TWinControl): string;
792var
793 Node: TORTreeNode;
794begin
795 Node := TORTreeNode(TORTreeView(Component).Selected);
796 Result := getImgText(Node) + getName(Node.StringData) + getDueDate(Node.StringData) +
797 getLastOcc(Node.StringData) + getPriority(Node.StringData);
798end;
799
800
[456]801end.
Note: See TracBrowser for help on using the repository browser.