VistA-cprs/CPRS-Chart/fReminderTree.pas

722 lines
20 KiB
Plaintext

unit fReminderTree;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ImgList, ORFn, Menus;
type
TfrmReminderTree = class(TForm)
pnlTop: TPanel;
tvRem: TORTreeView;
hcRem: THeaderControl;
pnlTopRight: TPanel;
bvlGap: TBevel;
lbRem: TORListBox;
mmMain: TMainMenu;
memAction: TMenuItem;
memEvalAll: TMenuItem;
memEval: TMenuItem;
N2: TMenuItem;
memRefresh: TMenuItem;
memEvalCat: TMenuItem;
mnuCoverSheet: TMenuItem;
mnuExit: TMenuItem;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure tvRemExpanded(Sender: TObject; Node: TTreeNode);
procedure tvRemCollapsed(Sender: TObject; Node: TTreeNode);
procedure pnlTopResize(Sender: TObject);
procedure lbRemDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure lbRemChange(Sender: TObject);
procedure lbRemClick(Sender: TObject);
procedure tvRemEnter(Sender: TObject);
procedure tvRemExit(Sender: TObject);
procedure hcRemSectionClick(HeaderControl: THeaderControl;
Section: THeaderSection);
procedure tvRemClick(Sender: TObject);
procedure tvRemChange(Sender: TObject; Node: TTreeNode);
procedure tvRemMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure memEvalClick(Sender: TObject);
procedure memEvalAllClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure memRefreshClick(Sender: TObject);
procedure memActionClick(Sender: TObject);
procedure memEvalCatClick(Sender: TObject);
procedure mnuCoverSheetClick(Sender: TObject);
procedure tvRemNodeCaptioning(Sender: TObject; var Caption: String);
procedure tvRemAddition(Sender: TObject; Node: TTreeNode);
procedure tvRemDeletion(Sender: TObject; Node: TTreeNode);
procedure mnuExitClick(Sender: TObject);
private
FLinking: boolean;
FSortOrder: integer;
FSortAssending: boolean;
FSorting: boolean;
FUpdating: boolean;
memView: TORMenuItem;
DateColWidth: integer;
LastDateColWidth: integer;
PriorityColWidth: integer;
procedure SetRemHeaderSectionWidth( SectionIndex: integer; NewWidth: integer);
protected
procedure Resync(FromTree: boolean);
procedure RemindersChanged(Sender: TObject);
procedure ResetlbItems(RootNode: TTreeNode);
procedure LinkTopControls(FromTree: boolean);
procedure SyncTopControls(FromTree: boolean);
procedure SortNode(const Node: TTreeNode);
function SortData(Node: TORTreeNode): string;
// procedure PositionToReminder(Sender: TObject);
procedure ProcessedRemindersChanged(Sender: TObject);
public
procedure EnableActions;
procedure SetFontSize( NewFontSize: integer);
end;
procedure ViewReminderTree;
var
frmReminderTree: TfrmReminderTree = nil;
RemTreeDlgLeft: integer = 0;
RemTreeDlgTop: integer = 0;
RemTreeDlgWidth: integer = 0;
RemTreeDlgHeight: integer = 0;
const
ReminderTreeName = 'frmReminderTree';
implementation
uses uReminders, dShared, uConst, fReminderDialog, fNotes, rMisc,
rReminders, fRemCoverSheet, uAccessibleTreeView, uAccessibleTreeNode;
{$R *.DFM}
const
UnscaledDateColWidth = 70;
UnscaledLastDateColWidth = 89;
UnscaledPriorityColWidth = 43;
procedure ViewReminderTree;
begin
if(not InitialRemindersLoaded) then
StartupReminders;
if(not assigned(frmReminderTree)) then
frmReminderTree := TfrmReminderTree.Create(Application);
frmReminderTree.Show;
end;
procedure TfrmReminderTree.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Action := caFree;
end;
procedure TfrmReminderTree.FormCreate(Sender: TObject);
begin
memView := TORMenuItem.Create(mmMain);
memView.Caption := '&View';
memView.Add(TORMenuItem.Create(memView));
mmMain.Items.Insert(0, memView);
bvlGap.Height := GetSystemMetrics(SM_CYHSCROLL);
FSortOrder := -1;
FSortAssending := TRUE;
SetReminderMenuSelectRoutine(memView);
NotifyWhenRemindersChange(RemindersChanged);
// NotifyWhenProcessingReminderChanges(PositionToReminder);
ProcessedReminders.Notifier.NotifyWhenChanged(ProcessedRemindersChanged);
SetFontSize(MainFontSize);
SetReminderFormBounds(Self, 0, 0, Self.Width, Self.Height,
RemTreeDlgLeft, RemTreeDlgTop, RemTreeDlgWidth, RemTreeDlgHeight);
TAccessibleTreeView.WrapControl(tvRem);
end;
procedure TfrmReminderTree.LinkTopControls(FromTree: boolean);
var
idx: integer;
begin
if(not FLinking) then
begin
FLinking := TRUE;
try
if(FromTree) then
begin
if(assigned(tvRem.Selected)) then
begin
idx := lbRem.Items.IndexOfObject(tvRem.Selected);
lbRem.ItemIndex := idx;
end
else
lbRem.ItemIndex := -1;
end
else
begin
if(lbRem.ItemIndex < 0) then
tvRem.Selected := nil
else
tvRem.Selected := TTreeNode(lbRem.Items.Objects[lbRem.ItemIndex]);
end;
finally
FLinking := FALSE;
end;
end;
end;
procedure TfrmReminderTree.RemindersChanged(Sender: TObject);
const
ARTxt = 'Available Reminders';
var
OldUpdating: boolean;
begin
EnableActions;
if(GetReminderStatus = rsNone) then
begin
tvRem.Selected := nil;
Close;
exit;
end;
OldUpdating := FUpdating;
try
FUpdating := TRUE;
lbRem.Items.BeginUpdate;
try
try
BuildReminderTree(tvRem);
lbRem.Clear;
ResetlbItems(nil);
LinkTopControls(TRUE);
SyncTopControls(TRUE);
pnlTopResize(Self);
finally
FUpdating := FALSE;
tvRem.Invalidate;
lbRem.Invalidate;
end;
if(RemindersEvaluatingInBackground) then
hcRem.Sections[0].Text := ARTxt + ' (Evaluating Reminders...)'
else
hcRem.Sections[0].Text := ARTxt;
finally
lbRem.Items.EndUpdate;
end;
finally
FUpdating := OldUpdating;
end;
end;
procedure TfrmReminderTree.ResetlbItems(RootNode: TTreeNode);
var
Firsti, i: integer;
First, Node: TTreeNode;
sl: TStringList;
lvl: integer;
Add2LB: boolean;
Tmp, Data: string;
function IsVis(Node: TTreeNode): boolean; // IsVisible doesn't work when updating
begin
Result := TRUE;
Node := Node.Parent;
while(Result and (assigned(Node))) do
begin
Result := Node.Expanded;
Node := Node.Parent;
end;
end;
begin
if(not FSorting) then
begin
if(assigned(RootNode)) then
begin
Node := RootNode.GetFirstChild;
lvl := RootNode.Level;
Add2LB := RootNode.Expanded;
Firsti := lbRem.Items.IndexOfObject(RootNode)+1;
end
else
begin
Node := tvRem.Items.GetFirstNode;
lvl := -1;
Add2LB := TRUE;
Firsti := 0;
end;
First := Node;
if(assigned(Node)) then
begin
sl := TStringList.Create;
try
sl.Assign(lbRem.Items);
while(assigned(Node) and (Node.Level > lvl)) do
begin
i := sl.IndexOfObject(Node);
if(i >= 0) then
sl.Delete(i);
Node := Node.GetNext;
end;
if(Add2LB) then
begin
i := Firsti;
Node := First;
while(assigned(Node) and (Node.Level > lvl)) do
begin
if(IsVis(Node)) then
begin
Tmp := TORTreeNode(Node).StringData;
Data := Piece(Tmp,U,RemTreeDateIdx) + U + Piece(Tmp,U,RemTreeDateIdx+1) + U +
RemPriorityText[StrToIntDef(Piece(Tmp, U, 5), 2)];
sl.InsertObject(i, Data, Node);
inc(i);
end;
Node := Node.GetNext;
end;
end;
lbRem.Items.Assign(sl);
finally
sl.Free;
end;
end;
end;
end;
procedure TfrmReminderTree.SyncTopControls(FromTree: boolean);
begin
if(lbRem.Items.Count > 0) and (tvRem.TopItem <> lbRem.Items.Objects[lbRem.TopIndex]) then
begin
if(FromTree) then
lbRem.TopIndex := lbRem.Items.IndexOfObject(tvRem.TopItem)
else
tvRem.TopItem := TTreeNode(lbRem.Items.Objects[lbRem.TopIndex]);
end;
end;
procedure TfrmReminderTree.tvRemExpanded(Sender: TObject; Node: TTreeNode);
begin
if(FUpdating) then exit;
FUpdating := TRUE;
try
ResetlbItems(Node);
pnlTopResize(Self);
finally
FUpdating := FALSE;
end;
end;
procedure TfrmReminderTree.tvRemCollapsed(Sender: TObject;
Node: TTreeNode);
begin
if(FUpdating) then exit;
FUpdating := TRUE;
try
ResetlbItems(Node);
pnlTopResize(Self);
finally
FUpdating := FALSE;
end;
end;
procedure TfrmReminderTree.pnlTopResize(Sender: TObject);
var
Tmp,Adj: integer;
begin
Tmp := DateColWidth + LastDateColWidth + PriorityColWidth + 4;
if(lbRem.Width <> (lbRem.ClientWidth + 4)) then
Adj := ScrollBarWidth
else
Adj := 0;
pnlTopRight.Width := Tmp + Adj;
Tmp := pnlTop.Width - DateColWidth - LastDateColWidth - PriorityColWidth - 2 - Adj;
SetRemHeaderSectionWidth( 0, Tmp);
tvRem.Items.BeginUpdate;
try
tvRem.Height := pnlTop.Height - hcRem.Height;
if(tvRem.Width <> (tvRem.ClientWidth+4)) then
inc(Tmp, ScrollBarWidth);
tvRem.Width := Tmp;
finally
tvRem.Items.EndUpdate;
end;
bvlGap.Visible := (tvRem.Height <> (tvRem.ClientHeight+4));
end;
procedure TfrmReminderTree.lbRemDrawItem(Control: TWinControl;
Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
Tmp: string;
Flags: Longint;
begin
SyncTopControls(FALSE);
if (odSelected in State) then
begin
if((ActiveControl = lbRem) or (ActiveControl = tvRem)) then
begin
lbRem.Canvas.Brush.Color := clHighlight;
lbRem.Canvas.Font.Color := clHighlightText
end
else
begin
lbRem.Canvas.Brush.Color := clInactiveBorder;
lbRem.Canvas.Font.Color := clWindowText;
end;
end;
Flags := lbRem.DrawTextBiDiModeFlags(DT_SINGLELINE or DT_VCENTER);
Tmp := piece(lbRem.Items[Index],U,1);
lbRem.Canvas.FillRect(Rect);
Inc(Rect.Left, 6);
DrawText(lbRem.Canvas.Handle, PChar(Tmp), Length(Tmp), Rect, Flags);
inc(Rect.Left, DateColWidth);
Tmp := piece(lbRem.Items[Index],U,2);
DrawText(lbRem.Canvas.Handle, PChar(Tmp), Length(Tmp), Rect, Flags);
inc(Rect.Left, LastDateColWidth);
Tmp := piece(lbRem.Items[Index],U,3);
DrawText(lbRem.Canvas.Handle, PChar(Tmp), Length(Tmp), Rect, Flags);
end;
procedure TfrmReminderTree.lbRemChange(Sender: TObject);
begin
Resync(FALSE);
tvRem.SetFocus;
end;
procedure TfrmReminderTree.lbRemClick(Sender: TObject);
begin
tvRem.SetFocus;
end;
procedure TfrmReminderTree.tvRemEnter(Sender: TObject);
begin
if(FUpdating) then exit;
if(ActiveControl = lbRem) or (ActiveControl = tvRem) then
lbRem.Invalidate;
end;
procedure TfrmReminderTree.tvRemExit(Sender: TObject);
begin
if(FUpdating) then exit;
if(ActiveControl <> lbRem) and (ActiveControl <> tvRem) then
lbRem.Invalidate;
end;
procedure TfrmReminderTree.hcRemSectionClick(HeaderControl: THeaderControl;
Section: THeaderSection);
var
i, SortIdx: integer;
exp: boolean;
Sel, Node: TTreeNode;
begin
SortIdx := -1;
for i := 0 to 3 do
begin
if(Section = hcRem.Sections[i]) then
begin
SortIdx := i;
break;
end;
end;
if(SortIdx >= 0) then
begin
Sel := tvRem.Selected;
if(FSortOrder = SortIdx) then
FSortAssending := not FSortAssending
else
FSortOrder := SortIdx;
FSorting := TRUE;
tvRem.Items.BeginUpdate;
try
Node := tvRem.Items.GetFirstNode;
while(assigned(Node)) do
begin
exp := Node.Expanded;
SortNode(Node);
if(Node.Expanded <> exp) then
Node.Expanded := exp;
Node := Node.GetNextSibling;
end;
finally
tvRem.Items.EndUpdate;
FSorting := FALSE;
end;
ResetlbItems(nil);
tvRem.Selected := Sel;
end;
end;
procedure TfrmReminderTree.SortNode(const Node: TTreeNode);
var
i: integer;
sl: TStringList;
Tmp, TmpLast: TTreeNode;
exp: boolean;
begin
if(Node.HasChildren) then
begin
sl := TStringList.Create;
try
Tmp := Node.GetFirstChild;
while assigned(Tmp) do
begin
sl.AddObject(SortData(TORTreeNode(Tmp)), Tmp);
Tmp := Tmp.GetNextSibling;
end;
sl.sort;
TmpLast := Node;
for i := 0 to sl.Count-1 do
begin
if(FSortAssending) then
Tmp := TTreeNode(sl.Objects[i])
else
Tmp := TTreeNode(sl.Objects[sl.Count-1-i]);
exp := Tmp.Expanded;
if(i = 0) then
Tmp.MoveTo(TmpLast, naAddChildFirst)
else
Tmp.MoveTo(TmpLast, naInsert);
TmpLast := Tmp;
SortNode(Tmp);
Tmp.Expanded := exp;
end;
finally
sl.Free;
end;
end;
end;
function TfrmReminderTree.SortData(Node: TORTreeNode): string;
function ZForm(str: string; Num: integer): string;
begin
Result := copy(StringOfChar('0', Num)+str,1+length(str),Num);
end;
begin
Result := ZForm(piece(Node.StringData, U, RemTreeDateIdx+2),5);
case FSortOrder of
1: Result := ZForm(Piece(Node.StringData, U, 3), 15)+'.'+Result;
2: Result := ZForm(Piece(Node.StringData, U, 4), 15)+'.'+Result;
3: Result := Piece(Node.StringData, U, 5)+'.'+Result;
end;
end;
procedure TfrmReminderTree.tvRemClick(Sender: TObject);
begin
Resync(TRUE);
end;
procedure TfrmReminderTree.tvRemChange(Sender: TObject; Node: TTreeNode);
var
p1: string;
begin
memView.Data := '';
if(assigned(Node)) then
begin
p1 := Piece((Node as TORTreeNode).StringData, U, 1);
if(Copy(p1,1,1) = RemCode) then
begin
memView.Data := (Node as TORTreeNode).StringData;
end;
end;
EnableActions;
Resync(TRUE);
end;
procedure TfrmReminderTree.tvRemMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Resync(TRUE);
end;
procedure TfrmReminderTree.Resync(FromTree: boolean);
begin
if(FUpdating) then exit;
FUpdating := TRUE;
try
LinkTopControls(FromTree);
SyncTopControls(FromTree);
finally
FUpdating := FALSE;
end;
end;
{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;}
procedure TfrmReminderTree.memEvalClick(Sender: TObject);
var
Node: TORTreeNode;
p1: string;
begin
Node := TORTreeNode(tvRem.Selected);
if(assigned(Node)) then
begin
p1 := Piece(Node.StringData, U, 1);
if(Copy(p1,1,1) = RemCode) then
EvalReminder(StrToIntDef(Copy(p1,2,MaxInt),0));
end;
end;
procedure TfrmReminderTree.EnableActions;
var
OK: boolean;
Node: TORTreeNode;
p1: string;
begin
Node := TORTreeNode(tvRem.Selected);
if(assigned(Node)) then
p1 := Piece(Node.StringData, U, 1)
else
p1 := '';
if(assigned(Node)) then
OK := (Copy(p1,1,1) = RemCode)
else
OK := FALSE;
memEval.Enabled := OK;
memEvalAll.Enabled := (ProcessedReminders.Count > 0);
memRefresh.Enabled := (not ReminderDialogActive);
mnuCoverSheet.Enabled := (NewRemCoverSheetListActive or CanEditAllRemCoverSheetLists);
memAction.Enabled := (OK or memEvalAll.Enabled or memRefresh.Enabled or mnuCoverSheet.Enabled);
if(assigned(Node)) then
OK := ((Copy(p1,1,1) = CatCode) and (p1 <> OtherCatID) and (Node.HasChildren))
else
OK := FALSE;
memEvalCat.Enabled := OK;
memEvalCat.Tag := integer(Node);
end;
procedure TfrmReminderTree.ProcessedRemindersChanged(Sender: TObject);
begin
EnableActions;
end;
procedure TfrmReminderTree.memEvalAllClick(Sender: TObject);
begin
EvalProcessed;
end;
procedure TfrmReminderTree.FormDestroy(Sender: TObject);
begin
TAccessibleTreeView.UnwrapControl(tvRem);
frmReminderTree := nil;
ProcessedReminders.Notifier.RemoveNotify(ProcessedRemindersChanged);
// RemoveNotifyWhenProcessingReminderChanges(PositionToReminder);
RemoveNotifyRemindersChange(RemindersChanged);
RemTreeDlgLeft := Self.Left;
RemTreeDlgTop := Self.Top;
RemTreeDlgWidth := Self.Width;
RemTreeDlgHeight := Self.Height;
end;
procedure TfrmReminderTree.memRefreshClick(Sender: TObject);
begin
KillObj(@ReminderDialogInfo, TRUE);
UpdateReminderDialogStatus;
EnableActions;
end;
procedure TfrmReminderTree.memActionClick(Sender: TObject);
begin
EnableActions;
end;
procedure TfrmReminderTree.memEvalCatClick(Sender: TObject);
begin
EvaluateCategoryClicked(nil, Sender);
end;
procedure TfrmReminderTree.mnuCoverSheetClick(Sender: TObject);
begin
EditCoverSheetReminderList(not CanEditAllRemCoverSheetLists);
end;
procedure TfrmReminderTree.SetFontSize(NewFontSize: integer);
var
TotalWidth: integer;
begin
DateColWidth := ResizeWidth(Font, MainFont, UnscaledDateColWidth);
LastDateColWidth := ResizeWidth(Font, MainFont, UnscaledLastDateColWidth);
PriorityColWidth := ResizeWidth(Font, MainFont, UnscaledPriorityColWidth);
ResizeAnchoredFormToFont(self);
TotalWidth := hcRem.Width;
SetRemHeaderSectionWidth( 0, TotalWidth - DateColWidth - LastDateColWidth - PriorityColWidth);
SetRemHeaderSectionWidth( 1, DateColWidth);
SetRemHeaderSectionWidth( 2, LastDateColWidth);
SetRemHeaderSectionWidth( 3, PriorityColWidth);
lbRem.ItemHeight := ((Abs(Font.Height)+ 6) div 2)*2; //tvRem.ItemHeight;
//This is called "best guess calibration"
if Font.Size > 12 then lbRem.ItemHeight := lbRem.ItemHeight + 2;
//I am reluctant to use an alignment on the tvRem as there si lots of resizing
//tricks going on with the scroll bar at the bottom.
tvRem.Top := hcRem.Top+hcRem.Height;
pnlTopResize(self);
end;
procedure TfrmReminderTree.SetRemHeaderSectionWidth( SectionIndex: integer; NewWidth: integer);
begin
hcRem.Sections[SectionIndex].MinWidth := 0;
hcRem.Sections[SectionIndex].MaxWidth := NewWidth;
hcRem.Sections[SectionIndex].MinWidth := NewWidth;
hcRem.Sections[SectionIndex].Width := NewWidth;
end;
procedure TfrmReminderTree.tvRemNodeCaptioning(Sender: TObject;
var Caption: String);
var
StringData: string;
begin
StringData := (Sender as TORTreeNode).StringData;
if (Length(StringData) > 0) and (StringData[1] = 'R') then //Only tag reminder statuses
case StrToIntDef(Piece(StringData,'^',6 {Due}),-1) of
0: Caption := Caption + ' -- Applicable';
1: Caption := Caption + ' -- DUE';
2: Caption := Caption + ' -- Not Applicable';
else Caption := Caption + ' -- Not Evaluated';
end;
end;
procedure TfrmReminderTree.tvRemAddition(Sender: TObject; Node: TTreeNode);
begin
TAccessibleTreeNode.WrapControl(Node as TORTreeNode);
end;
procedure TfrmReminderTree.tvRemDeletion(Sender: TObject; Node: TTreeNode);
begin
TAccessibleTreeNode.UnwrapControl(Node as TORTreeNode);
end;
procedure TfrmReminderTree.mnuExitClick(Sender: TObject);
begin
Close;
end;
end.