Module

fReminderTree

Path

C:\CPRS\CPRS30\fReminderTree.pas

Last Modified

7/15/2014 3:26:38 PM

Units Used in Interface

Name Comments
fBase508Form -

Units Used in Implementation

Name Comments
dShared -
fNotes -
fRemCoverSheet -
fReminderDialog -
rMisc -
rReminders -
uConst -
uReminders -

Classes

Name Comments
TfrmReminderTree -
TtvRem508Manager -

Procedures

Name Owner Declaration Scope Comments
EnableActions TfrmReminderTree procedure EnableActions; Public -
FormClose TfrmReminderTree procedure FormClose(Sender: TObject; var Action: TCloseAction); Public/Published -
FormCreate TfrmReminderTree procedure FormCreate(Sender: TObject); Public/Published -
FormDestroy TfrmReminderTree procedure FormDestroy(Sender: TObject); Public/Published -
hcRemSectionClick TfrmReminderTree procedure hcRemSectionClick(HeaderControl: THeaderControl; Section: THeaderSection); Public/Published -
lbRemChange TfrmReminderTree procedure lbRemChange(Sender: TObject); Public/Published -
lbRemClick TfrmReminderTree procedure lbRemClick(Sender: TObject); Public/Published -
lbRemDrawItem TfrmReminderTree procedure lbRemDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); Public/Published -
LinkTopControls TfrmReminderTree procedure LinkTopControls(FromTree: boolean); Protected -
memActionClick TfrmReminderTree procedure memActionClick(Sender: TObject); Public/Published -
memEvalAllClick TfrmReminderTree procedure memEvalAllClick(Sender: TObject); Public/Published -
memEvalCatClick TfrmReminderTree procedure memEvalCatClick(Sender: TObject); Public/Published -
memEvalClick TfrmReminderTree procedure memEvalClick(Sender: TObject); Public/Published
Procedure TfrmReminderTree.PositionToReminder(Sender: TObject);
begin
  if(assigned(Sender)) then
  begin
    if(Sender is TReminder) then
    begin
      tvRem.Selected := tvRem.FindPieceNode(RemCode + (Sender as TReminder).IEN, 1);
      if(assigned(tvRem.Selected)) then
        TORTreeNode(tvRem.Selected).EnsureVisible;
    end;
  end
  else
    tvRem.Selected := nil;
end;
memRefreshClick TfrmReminderTree procedure memRefreshClick(Sender: TObject); Public/Published -
mnuCoverSheetClick TfrmReminderTree procedure mnuCoverSheetClick(Sender: TObject); Public/Published -
mnuExitClick TfrmReminderTree procedure mnuExitClick(Sender: TObject); Public/Published -
pnlTopResize TfrmReminderTree procedure pnlTopResize(Sender: TObject); Public/Published -
ProcessedRemindersChanged TfrmReminderTree procedure ProcessedRemindersChanged(Sender: TObject); Protected Procedure PositionToReminder(Sender: TObject);
RemindersChanged TfrmReminderTree procedure RemindersChanged(Sender: TObject); Protected -
ResetlbItems TfrmReminderTree procedure ResetlbItems(RootNode: TTreeNode); Protected -
Resync TfrmReminderTree procedure Resync(FromTree: boolean); Protected -
SetFontSize TfrmReminderTree procedure SetFontSize( NewFontSize: integer); Public -
SetRemHeaderSectionWidth TfrmReminderTree procedure SetRemHeaderSectionWidth( SectionIndex: integer; NewWidth: integer); Private -
SortNode TfrmReminderTree procedure SortNode(const Node: TTreeNode); Protected -
SyncTopControls TfrmReminderTree procedure SyncTopControls(FromTree: boolean); Protected -
tvRemChange TfrmReminderTree procedure tvRemChange(Sender: TObject; Node: TTreeNode); Public/Published -
tvRemClick TfrmReminderTree procedure tvRemClick(Sender: TObject); Public/Published -
tvRemCollapsed TfrmReminderTree procedure tvRemCollapsed(Sender: TObject; Node: TTreeNode); Public/Published -
tvRemEnter TfrmReminderTree procedure tvRemEnter(Sender: TObject); Public/Published -
tvRemExit TfrmReminderTree procedure tvRemExit(Sender: TObject); Public/Published -
tvRemExpanded TfrmReminderTree procedure tvRemExpanded(Sender: TObject; Node: TTreeNode); Public/Published -
tvRemKeyDown TfrmReminderTree procedure tvRemKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
tvRemMouseDown TfrmReminderTree procedure tvRemMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
tvRemNodeCaptioning TfrmReminderTree procedure tvRemNodeCaptioning(Sender: TObject; var Caption: String); Public/Published -
ViewReminderTree - procedure ViewReminderTree; Interfaced -

Functions

Name Owner Declaration Scope Comments
getDueDate TtvRem508Manager function getDueDate(sData : String): String; Private -
getImgText TtvRem508Manager function getImgText(Node : TORTreeNode): String; Private -
GetItem TtvRem508Manager function GetItem(Component: TWinControl): TObject; override; Public -
getLastOcc TtvRem508Manager function getLastOcc(sData : String): String; Private -
getName TtvRem508Manager function getName(sData : String): String; Private -
getPriority TtvRem508Manager function getPriority(sData : String): String; Private -
GetValue TtvRem508Manager function GetValue(Component: TWinControl): string; override; Public -
IsVis - function IsVis(Node: TTreeNode): boolean; Local IsVisible doesn't work when updating
SortData TfrmReminderTree function SortData(Node: TORTreeNode): string; Protected -
ZForm - function ZForm(str: string; Num: integer): string; Local -

Global Variables

Name Type Declaration Comments
frmReminderTree TfrmReminderTree frmReminderTree: TfrmReminderTree = nil; -
RemTreeDlgHeight Integer RemTreeDlgHeight: integer = 0; -
RemTreeDlgLeft Integer RemTreeDlgLeft: integer = 0; -
RemTreeDlgTop Integer RemTreeDlgTop: integer = 0; -
RemTreeDlgWidth Integer RemTreeDlgWidth: integer = 0; -

Constants

Name Declaration Scope Comments
ReminderTreeName 'frmReminderTree' Interfaced -
UnscaledDateColWidth 70 Global -
UnscaledLastDateColWidth 89 Global -
UnscaledPriorityColWidth 43 Global -


Module Source

1     unit fReminderTree;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ImgList, ORFn, Menus, fBase508Form,
8       VA508AccessibilityManager, VA508ImageListLabeler;
9     
10    type
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)
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;
40        imgLblReminders: TVA508ImageListLabeler;
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);
67        procedure tvRemKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
68      private
69        tvRem508Manager : TtvRem508Manager;
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    
95    procedure ViewReminderTree;
96    
97    var
98      frmReminderTree: TfrmReminderTree = nil;
99      RemTreeDlgLeft: integer = 0;
100     RemTreeDlgTop: integer = 0;
101     RemTreeDlgWidth: integer = 0;
102     RemTreeDlgHeight: integer = 0;
103   
104   const
105     ReminderTreeName = 'frmReminderTree';
106     
107   implementation
108   
109   uses uReminders, dShared, uConst, fReminderDialog, fNotes, rMisc,
110        rReminders, fRemCoverSheet, VA2006Utils;
111   
112   {$R *.DFM}
113   
114   const
115     UnscaledDateColWidth = 70;
116     UnscaledLastDateColWidth = 89;
117     UnscaledPriorityColWidth = 43;
118   
119   procedure ViewReminderTree;
120   
121   begin
122     if(not InitialRemindersLoaded) then
123       StartupReminders;
124     if(not assigned(frmReminderTree)) then
125       frmReminderTree := TfrmReminderTree.Create(Application);
126     frmReminderTree.Show;
127   end;
128   
129   procedure TfrmReminderTree.FormClose(Sender: TObject;
130     var Action: TCloseAction);
131   begin
132     Action := caFree;
133   end;
134                                                                 
135   procedure TfrmReminderTree.FormCreate(Sender: TObject);
136   begin
137     FixHeaderControlDelphi2006Bug(hcRem);
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);
153     tvRem508Manager := TtvRem508Manager.Create;
154     amgrMain.ComponentManager[tvRem] := tvRem508Manager;
155   end;
156   
157   procedure TfrmReminderTree.LinkTopControls(FromTree: boolean);
158   var
159     idx: integer;
160   
161   begin
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;
172             tvRem.Selected := TTreeNode(lbRem.Items.Objects[lbRem.ItemIndex]);
173             tvRem.SetFocus;
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
183             begin
184               tvRem.Selected := TTreeNode(lbRem.Items.Objects[lbRem.ItemIndex]);
185               tvRem.SetFocus;
186             end;
187         end;
188       finally
189         FLinking := FALSE;
190       end;
191     end;
192   end;
193   
194   procedure TfrmReminderTree.RemindersChanged(Sender: TObject);
195   const
196     ARTxt = 'Available Reminders';
197   
198   var
199     OldUpdating: boolean;
200   
201   begin
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;
236   end;
237   
238   procedure TfrmReminderTree.ResetlbItems(RootNode: TTreeNode);
239   var
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   
258   begin
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
280           sl.Assign(lbRem.Items); // Must use regualr assign, FastAssign doesn't copy objects.
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;
311   end;
312   
313   procedure TfrmReminderTree.SyncTopControls(FromTree: boolean);
314   begin
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;
322   end;
323   
324   procedure TfrmReminderTree.tvRemExpanded(Sender: TObject; Node: TTreeNode);
325   begin
326     if(FUpdating) then exit;
327     FUpdating := TRUE;
328     try
329       tvRem.Selected := Node;
330       ResetlbItems(Node);
331       pnlTopResize(Self);
332     finally
333       FUpdating := FALSE;
334     end;
335   end;
336   
337   procedure TfrmReminderTree.tvRemKeyDown(Sender: TObject; var Key: Word;
338     Shift: TShiftState);
339   begin
340     inherited;
341     if (Key = VK_LEFT) or (Key = VK_RIGHT) then  tvRemClick(Sender);    
342   end;
343   
344   procedure TfrmReminderTree.tvRemCollapsed(Sender: TObject;
345     Node: TTreeNode);
346   begin
347     if(FUpdating) then exit;
348     FUpdating := TRUE;
349     try
350       tvRem.Selected := Node;
351       ResetlbItems(Node);
352       pnlTopResize(Self);
353     finally
354       FUpdating := FALSE;
355     end;
356   end;
357   
358   procedure TfrmReminderTree.pnlTopResize(Sender: TObject);
359   var
360     Tmp,Adj: integer;
361   
362   begin
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));
381   end;
382   
383   procedure TfrmReminderTree.lbRemDrawItem(Control: TWinControl;
384     Index: Integer; Rect: TRect; State: TOwnerDrawState);
385   var
386     Tmp: string;
387     Flags: Longint;
388   
389   begin
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);
415   end;
416   
417   procedure TfrmReminderTree.lbRemChange(Sender: TObject);
418   begin
419     Resync(FALSE);
420     tvRem.SetFocus;
421   end;
422   
423   procedure TfrmReminderTree.lbRemClick(Sender: TObject);
424   begin
425     tvRem.SetFocus;
426   end;
427   
428   procedure TfrmReminderTree.tvRemEnter(Sender: TObject);
429   begin
430     if(FUpdating) then exit;
431     if(ActiveControl = lbRem) or (ActiveControl = tvRem) then
432       lbRem.Invalidate;
433   end;
434   
435   procedure TfrmReminderTree.tvRemExit(Sender: TObject);
436   begin
437     if(FUpdating) then exit;
438     if(ActiveControl <> lbRem) and (ActiveControl <> tvRem) then
439       lbRem.Invalidate;
440   end;
441   
442   procedure TfrmReminderTree.hcRemSectionClick(HeaderControl: THeaderControl;
443     Section: THeaderSection);
444   var
445     i, SortIdx: integer;
446     exp: boolean;
447     Sel, Node: TTreeNode;
448   
449   begin
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;
486   end;
487   
488   procedure TfrmReminderTree.SortNode(const Node: TTreeNode);
489   var
490     i: integer;
491     sl: TStringList;
492     Tmp, TmpLast: TTreeNode;
493     exp: boolean;
494   
495   begin
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;
527   end;
528   
529   function 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   
536   begin
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;
543   end;
544   
545   procedure TfrmReminderTree.tvRemClick(Sender: TObject);
546   begin
547     Resync(TRUE);
548   end;
549   
550   procedure TfrmReminderTree.tvRemChange(Sender: TObject; Node: TTreeNode);
551   var
552     p1: string;
553   
554   begin
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);
567   end;
568   
569   procedure TfrmReminderTree.tvRemMouseDown(Sender: TObject;
570     Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
571   begin
572       //Resync(TRUE);
573   end;
574   
575   procedure TfrmReminderTree.Resync(FromTree: boolean);
576   begin
577     if(FUpdating) then exit;
578     FUpdating := TRUE;
579     try
580       LinkTopControls(FromTree);
581       SyncTopControls(FromTree);
582     finally
583       FUpdating := FALSE;
584     end;
585   end;
586   
587   {procedure TfrmReminderTree.PositionToReminder(Sender: TObject);
588   begin
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;
600   end;}
601   
602   procedure TfrmReminderTree.memEvalClick(Sender: TObject);
603   var
604     Node: TORTreeNode;
605     p1: string;
606   
607   begin
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;
615   end;
616   
617   procedure TfrmReminderTree.EnableActions;
618   var
619     OK: boolean;
620     Node: TORTreeNode;
621     p1: string;
622   
623   begin
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);
644   end;
645   
646   procedure TfrmReminderTree.ProcessedRemindersChanged(Sender: TObject);
647   begin
648     EnableActions;
649   end;
650   
651   procedure TfrmReminderTree.memEvalAllClick(Sender: TObject);
652   begin
653     EvalProcessed;
654   end;
655   
656   procedure TfrmReminderTree.FormDestroy(Sender: TObject);
657   begin
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;
666   end;
667   
668   procedure TfrmReminderTree.memRefreshClick(Sender: TObject);
669   begin
670     KillObj(@ReminderDialogInfo, TRUE);
671     UpdateReminderDialogStatus;
672     EnableActions;
673   end;
674   
675   procedure TfrmReminderTree.memActionClick(Sender: TObject);
676   begin
677     EnableActions;
678   end;
679   
680   procedure TfrmReminderTree.memEvalCatClick(Sender: TObject);
681   begin
682     EvaluateCategoryClicked(nil, Sender);
683   end;
684   
685   procedure TfrmReminderTree.mnuCoverSheetClick(Sender: TObject);
686   begin
687     EditCoverSheetReminderList(not CanEditAllRemCoverSheetLists);
688   end;
689   
690   procedure TfrmReminderTree.SetFontSize(NewFontSize: integer);
691   var
692     TotalWidth: integer;
693   begin
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);
711   end;
712   
713   procedure TfrmReminderTree.SetRemHeaderSectionWidth( SectionIndex: integer; NewWidth: integer);
714   begin
715     hcRem.Sections[SectionIndex].MinWidth := 0;
716     hcRem.Sections[SectionIndex].MaxWidth := NewWidth;
717     hcRem.Sections[SectionIndex].MinWidth := NewWidth;
718     hcRem.Sections[SectionIndex].Width := NewWidth;
719   end;
720   
721   procedure TfrmReminderTree.tvRemNodeCaptioning(Sender: TObject;
722     var Caption: String);
723   var
724     StringData: string;
725   begin
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;
734   end;
735   
736   procedure TfrmReminderTree.mnuExitClick(Sender: TObject);
737   begin
738     Close;
739   end;
740   
741   { TGrdLab508Manager }
742   
743   constructor TtvRem508Manager.Create;
744   begin
745     inherited Create([mtValue, mtItemChange]);
746   end;
747   
748   function TtvRem508Manager.getDueDate(sData: String): String;
749   begin
750     Result := Piece(sData,U,3);
751     if Result <> '' then
752       Result := ' Due Date: ' + FormatFMDateTimeStr('mm/dd/yyyy',Result);
753   end;
754   
755   function TtvRem508Manager.getImgText(Node: TORTreeNode): String;
756   begin
757     Result := '';
758     if Node.ImageIndex > -1 then
759       Result := frmReminderTree.imgLblReminders.RemoteLabeler.Labels.Items[Node.ImageIndex].Caption + ' ';
760   end;
761   
762   function TtvRem508Manager.GetItem(Component: TWinControl): TObject;
763   var
764     tv : TORTreeView;
765   begin
766     tv := TORTreeView(Component);
767     Result :=  tv.Selected;
768   end;
769   
770   function TtvRem508Manager.getLastOcc(sData: String): String;
771   begin
772     Result := Piece(sData,U,4);
773     if Result <> '' then
774       Result := ' Last Occurrence: ' + FormatFMDateTimeStr('mm/dd/yyyy',Result);
775   end;
776   
777   function TtvRem508Manager.getName(sData: String): String;
778   begin
779     Result := Piece(sData,U,2);
780   end;
781   
782   function TtvRem508Manager.getPriority(sData: String): String;
783   begin
784     Result := Piece(sData,U,5);
785     if Result = '2' then
786       Result := '';
787     if Result <> '' then
788       Result := ' Priority: ' + Result;
789   end;
790   
791   function TtvRem508Manager.GetValue(Component: TWinControl): string;
792   var
793       Node: TORTreeNode;
794   begin
795     Node := TORTreeNode(TORTreeView(Component).Selected);
796     Result := getImgText(Node) + getName(Node.StringData) + getDueDate(Node.StringData) +
797               getLastOcc(Node.StringData) + getPriority(Node.StringData);
798   end;
799   
800   
801   end.

Module Calls (2 levels)


fReminderTree
 ├fBase508Form
 │ ├uConst
 │ └uHelpManager
 ├uReminders
 │ ├uPCE
 │ ├uVitals
 │ ├fDrawers
 │ ├fDeviceSelect
 │ ├rCore
 │ ├uCore
 │ ├rReminders
 │ ├fRptBox
 │ ├uConst
 │ ├fReminderDialog
 │ ├fMHTest
 │ ├rPCE
 │ ├rTemplates
 │ ├dShared
 │ ├uTemplateFields
 │ ├fIconLegend
 │ ├fReminderTree...
 │ ├uInit
 │ ├uDlgComponents
 │ └fBase508Form...
 ├uConst
 ├fReminderDialog...
 ├rReminders...
 └fRemCoverSheet
   ├fBase508Form...
   ├rCore...
   ├uCore...
   ├uPCE...
   ├rProbs
   ├rTIU
   ├rReminders...
   ├uReminders...
   └fRemCoverPreview

Module Called-By (2 levels)


              fReminderTree
                   fFrame┤ 
              CPRSChart┤ │ 
                  fPage┤ │ 
                uOrders┤ │ 
                fODBase┤ │ 
                UBACore┤ │ 
                fOrders┤ │ 
                   uPCE┤ │ 
      fBALocalDiagnoses┤ │ 
             fEncVitals┤ │ 
                fVitals┤ │ 
                 fCover┤ │ 
                 rCover┤ │ 
              fPtSelMsg┤ │ 
                 fPtSel┤ │ 
            fOrdersSign┤ │ 
         fPrintLocation┤ │ 
                  fMeds┤ │ 
                fRptBox┤ │ 
                 fNotes┤ │ 
               fReports┤ │ 
                 fEncnt┤ │ 
                 fProbs┤ │ 
          fReportsPrint┤ │ 
                fGraphs┤ │ 
              fConsults┤ │ 
                fDCSumm┤ │ 
        fReminderDialog┤ │ 
                  fLabs┤ │ 
              fLabPrint┤ │ 
                fReview┤ │ 
            fIconLegend┤ │ 
           fOrdersPrint┤ │ 
               fSurgery┤ │ 
uVA508CPRSCompatibility┤ │ 
           fOrdersRenew┤ │ 
             fODConsult┤ │ 
                fODProc┤ │ 
                 fODRad┤ │ 
                 fODLab┤ │ 
                fODMeds┤ │ 
               fODMedIV┤ │ 
              fODVitals┤ │ 
                fODAuto┤ │ 
                 fOMSet┤ │ 
         fOrdersRelease┤ │ 
              fODMedNVA┤ │ 
         fOrdersOnChart┤ │ 
             fOCSession┤ │ 
              fODActive┤ │ 
               fPCEEdit┘ │ 
               uReminders┤ 
              fFrame...┤ │ 
               fDrawers┤ │ 
              fCover...┤ │ 
              rCover...┤ │ 
              fNotes...┤ │ 
           fConsults...┤ │ 
        fTemplateEditor┤ │ 
     fReminderDialog...┤ │ 
       fReminderTree...┤ │ 
             rReminders┤ │ 
            fSurgery...┤ │ 
         fRemCoverSheet┘ │ 
                fNotes...┤ 
             fConsults...┤ 
       fReminderDialog...┤ 
              fSurgery...┘