VistA-cprs/CPRS-Chart/fDrawers.pas

1569 lines
43 KiB
Plaintext

unit fDrawers;
{
bugs noticed:
if delete only note (currently editing) then drawers and encounter button still enabled
}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, Buttons, ORCtrls, ComCtrls, ImgList, uTemplates,
Menus, ORClasses, ORFn, fBase508Form, VA508AccessibilityManager,
VA508ImageListLabeler;
type
TDrawer = (odNone, odTemplates, odEncounter, odReminders, odOrders);
TDrawers = set of TDrawer;
TfrmDrawers = class(TfrmBase508Form)
lbOrders: TORListBox;
sbOrders: TORAlignSpeedButton;
sbReminders: TORAlignSpeedButton;
sbEncounter: TORAlignSpeedButton;
sbTemplates: TORAlignSpeedButton;
pnlOrdersButton: TKeyClickPanel;
pnlRemindersButton: TKeyClickPanel;
pnlEncounterButton: TKeyClickPanel;
pnlTemplatesButton: TKeyClickPanel;
lbEncounter: TORListBox;
popTemplates: TPopupMenu;
mnuPreviewTemplate: TMenuItem;
pnlTemplates: TPanel;
tvTemplates: TORTreeView;
N1: TMenuItem;
mnuCollapseTree: TMenuItem;
N2: TMenuItem;
mnuEditTemplates: TMenuItem;
pnlTemplateSearch: TPanel;
btnFind: TORAlignButton;
edtSearch: TCaptionEdit;
mnuFindTemplates: TMenuItem;
mnuNewTemplate: TMenuItem;
cbMatchCase: TCheckBox;
cbWholeWords: TCheckBox;
mnuInsertTemplate: TMenuItem;
tvReminders: TORTreeView;
mnuDefault: TMenuItem;
N3: TMenuItem;
mnuGotoDefault: TMenuItem;
N4: TMenuItem;
mnuViewNotes: TMenuItem;
mnuCopyTemplate: TMenuItem;
N5: TMenuItem;
mnuViewTemplateIconLegend: TMenuItem;
fldAccessTemplates: TVA508ComponentAccessibility;
fldAccessReminders: TVA508ComponentAccessibility;
imgLblReminders: TVA508ImageListLabeler;
imgLblTemplates: TVA508ImageListLabeler;
procedure FormCanResize(Sender: TObject; var NewWidth,
NewHeight: Integer; var Resize: Boolean);
procedure FormResize(Sender: TObject);
procedure sbTemplatesClick(Sender: TObject);
procedure sbEncounterClick(Sender: TObject);
procedure sbRemindersClick(Sender: TObject);
procedure sbOrdersClick(Sender: TObject);
procedure sbResize(Sender: TObject);
procedure tvTemplatesGetImageIndex(Sender: TObject; Node: TTreeNode);
procedure tvTemplatesGetSelectedIndex(Sender: TObject;
Node: TTreeNode);
procedure tvTemplatesExpanding(Sender: TObject; Node: TTreeNode;
var AllowExpansion: Boolean);
procedure tvTemplatesClick(Sender: TObject);
procedure tvTemplatesDblClick(Sender: TObject);
procedure tvTemplatesCollapsing(Sender: TObject; Node: TTreeNode;
var AllowCollapse: Boolean);
procedure tvTemplatesKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure tvTemplatesKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure popTemplatesPopup(Sender: TObject);
procedure mnuPreviewTemplateClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure mnuCollapseTreeClick(Sender: TObject);
procedure btnFindClick(Sender: TObject);
procedure edtSearchChange(Sender: TObject);
procedure ToggleMenuItem(Sender: TObject);
procedure edtSearchEnter(Sender: TObject);
procedure edtSearchExit(Sender: TObject);
procedure mnuFindTemplatesClick(Sender: TObject);
procedure tvTemplatesDragging(Sender: TObject; Node: TTreeNode;
var CanDrag: Boolean);
procedure mnuEditTemplatesClick(Sender: TObject);
procedure mnuNewTemplateClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure pnlTemplateSearchResize(Sender: TObject);
procedure cbFindOptionClick(Sender: TObject);
procedure mnuInsertTemplateClick(Sender: TObject);
procedure tvRemindersMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure tvRemindersCurListChanged(Sender: TObject; Node: TTreeNode);
procedure mnuDefaultClick(Sender: TObject);
procedure mnuGotoDefaultClick(Sender: TObject);
procedure mnuViewNotesClick(Sender: TObject);
procedure mnuCopyTemplateClick(Sender: TObject);
procedure mnuViewTemplateIconLegendClick(Sender: TObject);
procedure pnlTemplatesButtonEnter(Sender: TObject);
procedure pnlTemplatesButtonExit(Sender: TObject);
procedure tvRemindersKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure tvRemindersNodeCaptioning(Sender: TObject;
var Caption: String);
procedure fldAccessTemplatesStateQuery(Sender: TObject; var Text: string);
procedure fldAccessTemplatesInstructionsQuery(Sender: TObject;
var Text: string);
procedure fldAccessRemindersInstructionsQuery(Sender: TObject;
var Text: string);
procedure fldAccessRemindersStateQuery(Sender: TObject; var Text: string);
private
FOpenToNode: string;
FOldMouseUp: TMouseEvent;
FEmptyNodeCount: integer;
FOldDragDrop: TDragDropEvent;
FOldDragOver: TDragOverEvent;
FOldFontChanged: TNotifyEvent;
FTextIconWidth: integer;
FInternalResize: integer;
FHoldResize: integer;
FOpenDrawer: TDrawer;
FLastOpenSize: integer;
FButtonHeights: integer;
FInternalExpand :boolean;
FInternalHiddenExpand :boolean;
FAsk :boolean;
FAskExp :boolean;
FAskNode :TTreeNode;
FDragNode :TTreeNode;
FClickOccurred: boolean;
FRichEditControl: TRichEdit;
FFindNext: boolean;
FLastFoundNode: TTreeNode;
FSplitter: TSplitter;
FOldCanResize: TCanResizeEvent;
FSplitterActive: boolean;
FHasPersonalTemplates: boolean;
FRemNotifyList: TORNotifyList;
FDefTempPiece: integer;
FNewNoteButton: TButton;
FCurrentVisibleDrawers: TDrawers;
FCurrentEnabledDrawers: TDrawers;
function GetAlign: TAlign;
procedure SetAlign(const Value: TAlign);
function MinDrawerControlHeight: integer;
procedure DisableArrowKeyMove(Sender: TObject);
protected
procedure PositionToReminder(Sender: TObject);
procedure RemindersChanged(Sender: TObject);
procedure SetFindNext(const Value: boolean);
procedure ReloadTemplates;
procedure SetRichEditControl(const Value: TRichEdit);
procedure CheckAsk;
procedure FontChanged(Sender: TObject);
procedure InitButtons;
procedure StartInternalResize;
procedure EndInternalResize;
procedure ResizeToVisible;
function ButtonHeights: integer;
procedure GetDrawerControls(Drawer: TDrawer;
var Btn: TORAlignSpeedButton;
var Ctrl: TWinControl);
procedure AddTemplateNode(const tmpl: TTemplate; const Owner: TTreeNode = nil);
procedure MoveCaret(X, Y: integer);
procedure NewRECDragDrop(Sender, Source: TObject; X, Y: Integer);
procedure NewRECDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState;
var Accept: Boolean);
procedure InsertText;
procedure SetSplitter(const Value: TSplitter);
procedure SplitterCanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean);
procedure SetSplitterActive(Active: boolean);
function EnableDrawer(Drawer: TDrawer; EnableIt: boolean): boolean;
function InsertOK(Ask: boolean): boolean;
procedure OpenToNode(Path: string = '');
property FindNext: boolean read FFindNext write SetFindNext;
public
constructor CreateDrawers(AOwner: TComponent; AParent: TWinControl;
VisibleDrawers, EnabledDrawers: TDrawers);
procedure ExternalReloadTemplates;
procedure OpenDrawer(Drawer: TDrawer);
procedure ToggleDrawer(Drawer: TDrawer);
procedure ShowDrawers(Drawers: TDrawers);
procedure EnableDrawers(Drawers: TDrawers);
procedure DisplayDrawers(Show: Boolean); overload;
procedure DisplayDrawers(Show: Boolean; AEnable, ADisplay: TDrawers); overload;
function CanEditTemplates: boolean;
function CanEditShared: boolean;
procedure UpdatePersonalTemplates;
procedure NotifyWhenRemTreeChanges(Proc: TNotifyEvent);
procedure RemoveNotifyWhenRemTreeChanges(Proc: TNotifyEvent);
procedure ResetTemplates;
property RichEditControl: TRichEdit read FRichEditControl write SetRichEditControl;
property NewNoteButton: TButton read FNewNoteButton write FNewNoteButton;
property Splitter: TSplitter read FSplitter write SetSplitter;
property HasPersonalTemplates: boolean read FHasPersonalTemplates;
property LastOpenSize: integer read FLastOpenSize write FLastOpenSize;
property DefTempPiece: integer read FDefTempPiece write FDefTempPiece;
property TheOpenDrawer: TDrawer read FOpenDrawer;
published
property Align: TAlign read GetAlign write SetAlign;
end;
{ There is a different instance of frmDrawers on each tab, so make the
frmDrawers variable local to each tab, do not use this global var! }
//var
//frmDrawers: TfrmDrawers;
const
DrawerSplitters = 'frmDrawersSplitters';
implementation
uses fTemplateView, uCore, rTemplates, fTemplateEditor, dShared, uReminders,
fReminderDialog, RichEdit, fRptBox, Clipbrd, fTemplateDialog, fIconLegend,
VA508AccessibilityRouter, uVA508CPRSCompatibility, VAUtils, fFindingTemplates;
{$R *.DFM}
const
BaseMinDrawerControlHeight = 24;
FindNextText = 'Find Next';
function TfrmDrawers.MinDrawerControlHeight: integer;
begin
result := ResizeHeight( BaseFont, MainFont, BaseMinDrawerControlHeight);
end;
procedure TfrmDrawers.ResizeToVisible;
var
NewHeight: integer;
od: TDrawer;
Button: TORAlignSpeedButton;
WinCtrl: TWinControl;
procedure AllCtrls(AAlign: TAlign);
var
od: TDrawer;
begin
Parent.DisableAlign;
try
for od := succ(low(TDrawer)) to high(TDrawer) do
begin
GetDrawerControls(od, Button, WinCtrl);
Button.Parent.Align := AAlign;
WinCtrl.Align := AAlign;
end;
finally
Parent.EnableAlign;
end;
end;
begin
if((FHoldResize = 0) and Visible) then
begin
FButtonHeights := -1; //Force re-calculate
NewHeight := 0;
AllCtrls(alNone);
for od := succ(low(TDrawer)) to high(TDrawer) do
begin
GetDrawerControls(od, Button, WinCtrl);
if(Button.Parent.Visible) then
begin
Button.Parent.Top := NewHeight;
inc(NewHeight, Button.Parent.Height);
WinCtrl.Top := NewHeight;
if(WinCtrl.Visible) then
begin
if(FLastOpenSize < 10) or (FLastOpenSize > (Parent.Height - 20)) then
begin
FLastOpenSize := (Parent.Height div 4) * 3;
dec(FLastOpenSize, ButtonHeights);
if(FLastOpenSize < MinDrawerControlHeight) then
FLastOpenSize := MinDrawerControlHeight;
end;
inc(NewHeight, FLastOpenSize);
WinCtrl.Height := FLastOpenSize;
end
else
WinCtrl.Height := 0;
end;
end;
AllCtrls(alTop);
StartInternalResize;
try
ClientHeight := NewHeight
finally
EndInternalResize;
end;
end;
end;
procedure TfrmDrawers.FormCanResize(Sender: TObject; var NewWidth,
NewHeight: Integer; var Resize: Boolean);
var
od: TDrawer;
Btn: TORAlignSpeedButton;
Ctrl: TWinControl;
IsVisible: boolean;
begin
if(FInternalResize = 0) then
begin
IsVisible := FALSE;
for od := succ(low(TDrawer)) to high(TDrawer) do
begin
GetDrawerControls(od, Btn, Ctrl);
if(Ctrl.Visible) then
begin
IsVisible := TRUE;
break;
end;
end;
if(not IsVisible) then
NewHeight := ButtonHeights;
end;
end;
function TfrmDrawers.ButtonHeights: integer;
begin
if(FButtonHeights < 0) then
begin
FButtonHeights := 0;
if(pnlOrdersButton.Visible) then
inc(FButtonHeights, sbOrders.Height);
if(pnlRemindersButton.Visible) then
inc(FButtonHeights, sbReminders.Height);
if(pnlEncounterButton.Visible) then
inc(FButtonHeights, sbEncounter.Height);
if(pnlTemplatesButton.Visible) then
inc(FButtonHeights, sbTemplates.Height);
end;
Result := FButtonHeights;
end;
procedure TfrmDrawers.ShowDrawers(Drawers: TDrawers);
var
od: TDrawer;
Btn: TORAlignSpeedButton;
Ctrl: TWinControl;
SaveLOS: integer;
begin
if(FCurrentVisibleDrawers = []) or (Drawers <> FCurrentVisibleDrawers) then
begin
FCurrentVisibleDrawers := Drawers;
SaveLOS := FLastOpenSize;
OpenDrawer(odNone);
for od := succ(low(TDrawer)) to high(TDrawer) do
begin
GetDrawerControls(od, Btn, Ctrl);
Btn.Parent.Visible := (od in Drawers);
Ctrl.Visible := FALSE;
Ctrl.Height := 0;
end;
FButtonHeights := -1;
FLastOpenSize := SaveLOS;
ResizeToVisible;
if(odReminders in Drawers) then
begin
NotifyWhenRemindersChange(RemindersChanged);
NotifyWhenProcessingReminderChanges(PositionToReminder);
end
else
begin
RemoveNotifyRemindersChange(RemindersChanged);
RemoveNotifyWhenProcessingReminderChanges(PositionToReminder);
end;
end;
end;
procedure TfrmDrawers.OpenDrawer(Drawer: TDrawer);
var
Btn: TORAlignSpeedButton;
Ctrl: TWinControl;
begin
if(FOpenDrawer <> Drawer) then
begin
StartInternalResize;
try
if(FOpenDrawer <> odNone) then
begin
GetDrawerControls(FOpenDrawer, Btn, Ctrl);
Btn.Down := FALSE;
with Btn.Parent as TPanel do
if BevelOuter = bvLowered then
BevelOuter := bvRaised;
Ctrl.Visible := FALSE;
Ctrl.Height := 0;
end;
if(Drawer = odNone) then
begin
FOpenDrawer := Drawer;
SetSplitterActive(FALSE);
end
else
begin
GetDrawerControls(Drawer, Btn, Ctrl);
if(Btn.Parent.Visible) and (Btn.Enabled) then
begin
SetSplitterActive(TRUE);
Btn.Down := TRUE;
with Btn.Parent as TPanel do
if BevelOuter = bvRaised then
BevelOuter := bvLowered;
Ctrl.Visible := TRUE;
FOpenDrawer := Drawer;
end
else
SetSplitterActive(FALSE);
end;
finally
EndInternalResize;
end;
ResizeToVisible;
end;
end;
procedure TfrmDrawers.GetDrawerControls(Drawer: TDrawer;
var Btn: TORAlignSpeedButton; var Ctrl: TWinControl);
begin
case Drawer of
odTemplates:
begin
Btn := sbTemplates;
Ctrl := pnlTemplates;
end;
odEncounter:
begin
Btn := sbEncounter;
Ctrl := lbEncounter;
end;
odReminders:
begin
Btn := sbReminders;
Ctrl := tvReminders;
end;
odOrders:
begin
Btn := sbOrders;
Ctrl := lbOrders;
end;
else
begin
Btn := nil;
Ctrl := nil;
end;
end;
end;
constructor TfrmDrawers.CreateDrawers(AOwner: TComponent; AParent: TWinControl;
VisibleDrawers, EnabledDrawers: TDrawers);
begin
FInternalResize := 0;
StartInternalResize;
try
Create(AOwner);
FButtonHeights := -1;
FLastOpenSize := 0;
FOpenDrawer := odNone;
Parent := AParent;
Align := alBottom;
FOldFontChanged := Font.OnChange;
Font.OnChange := FontChanged;
InitButtons;
ShowDrawers(VisibleDrawers);
EnableDrawers(EnabledDrawers);
Show;
finally
EndInternalResize;
end;
end;
function TfrmDrawers.EnableDrawer(Drawer: TDrawer; EnableIt: boolean): boolean;
var
Btn: TORAlignSpeedButton;
Ctrl: TWinControl;
begin
inc(FHoldResize);
try
GetDrawerControls(Drawer, Btn, Ctrl);
Btn.Parent.Enabled := EnableIt;
if(Drawer = FOpenDrawer) and (not Btn.Parent.Enabled) then
OpenDrawer(odNone);
finally
dec(FHoldResize);
end;
ResizeToVisible;
Result := EnableIt;
end;
procedure TfrmDrawers.EnableDrawers(Drawers: TDrawers);
var
od: TDrawer;
begin
if(FCurrentEnabledDrawers = []) or (Drawers <> FCurrentEnabledDrawers) then
begin
FCurrentEnabledDrawers := Drawers;
inc(FHoldResize);
try
for od := succ(low(TDrawer)) to high(TDrawer) do
EnableDrawer(od, (od in Drawers));
finally
dec(FHoldResize);
end;
ResizeToVisible;
end;
end;
procedure TfrmDrawers.FormResize(Sender: TObject);
begin
if(FInternalResize = 0) and (FOpenDrawer <> odNone) then
begin
FLastOpenSize := Height;
dec(FLastOpenSize, ButtonHeights);
if(FLastOpenSize < MinDrawerControlHeight) then
FLastOpenSize := MinDrawerControlHeight;
ResizeToVisible;
end;
end;
procedure TfrmDrawers.sbTemplatesClick(Sender: TObject);
begin
if(FOpenDrawer <> odTemplates) then
begin
ReloadTemplates;
btnFind.Enabled := (edtSearch.Text <> '');
pnlTemplateSearch.Visible := mnuFindTemplates.Checked;
end;
ToggleDrawer(odTemplates);
if ScreenReaderActive then
pnlTemplatesButton.SetFocus;
end;
procedure TfrmDrawers.sbEncounterClick(Sender: TObject);
begin
ToggleDrawer(odEncounter);
end;
procedure TfrmDrawers.sbRemindersClick(Sender: TObject);
begin
if(InitialRemindersLoaded) then
ToggleDrawer(odReminders)
else
begin
StartupReminders;
if(GetReminderStatus = rsNone) then
begin
EnableDrawer(odReminders, FALSE);
sbReminders.Down := FALSE;
with sbReminders.Parent as TPanel do
if BevelOuter = bvLowered then
BevelOuter := bvRaised;
end
else
ToggleDrawer(odReminders)
end;
if ScreenReaderActive then
pnlRemindersButton.SetFocus;
end;
procedure TfrmDrawers.sbOrdersClick(Sender: TObject);
begin
ToggleDrawer(odOrders);
end;
procedure TfrmDrawers.ToggleDrawer(Drawer: TDrawer);
begin
if(Drawer = FOpenDrawer) then
OpenDrawer(odNone)
else
OpenDrawer(Drawer);
end;
procedure TfrmDrawers.EndInternalResize;
begin
if(FInternalResize > 0) then dec(FInternalResize);
end;
procedure TfrmDrawers.StartInternalResize;
begin
inc(FInternalResize);
end;
procedure TfrmDrawers.sbResize(Sender: TObject);
var
Button: TORAlignSpeedButton;
Mar: integer; // Mar Needed because you can't assign Margin a negative value
begin
Button := (Sender as TORAlignSpeedButton);
Mar := (Button.Width - FTextIconWidth) div 2;
if(Mar < 0) then
Mar := 0;
Button.Margin := Mar;
end;
procedure TfrmDrawers.InitButtons;
var
od: TDrawer;
Btn: TORAlignSpeedButton;
Ctrl: TWinControl;
TmpWidth: integer;
TmpHeight: integer;
MaxHeight: integer;
begin
StartInternalResize;
try
FTextIconWidth := 0;
MaxHeight := 0;
for od := succ(low(TDrawer)) to high(TDrawer) do
begin
GetDrawerControls(od, Btn, Ctrl);
TmpWidth := Canvas.TextWidth(Btn.Caption) + Btn.Spacing +
(Btn.Glyph.Width div Btn.NumGlyphs) + 4;
if(TmpWidth > FTextIconWidth) then
FTextIconWidth := TmpWidth;
TmpHeight := Canvas.TextHeight(Btn.Caption) + 9;
if(TmpHeight > MaxHeight) then
MaxHeight := TmpHeight;
end;
if(MaxHeight > 0) then
begin
for od := succ(low(TDrawer)) to high(TDrawer) do
begin
GetDrawerControls(od, Btn, Ctrl);
Btn.Parent.Height := MaxHeight;
end;
end;
Constraints.MinWidth := FTextIconWidth;
finally
EndInternalResize;
end;
ResizeToVisible;
end;
procedure TfrmDrawers.FontChanged(Sender: TObject);
var
Ht: integer;
begin
if(assigned(FOldFontChanged)) then
FOldFontChanged(Sender);
if(FInternalResize = 0) then
begin
InitButtons;
ResizeToVisible;
btnFind.Width := Canvas.TextWidth(FindNextText) + 10;
btnFind.Height := edtSearch.Height;
btnFind.Left := pnlTemplateSearch.Width - btnFind.Width;
edtSearch.Width := pnlTemplateSearch.Width - btnFind.Width;
cbMatchCase.Width := Canvas.TextWidth(cbMatchCase.Caption)+23;
cbWholeWords.Width := Canvas.TextWidth(cbWholeWords.Caption)+23;
Ht := Canvas.TextHeight(cbMatchCase.Caption);
if(Ht < 17) then Ht := 17;
pnlTemplateSearch.Height := edtSearch.Height + Ht;
cbMatchCase.Height := Ht;
cbWholeWords.Height := Ht;
cbMatchCase.Top := edtSearch.Height;
cbWholeWords.Top := edtSearch.Height;
pnlTemplateSearchResize(Sender);
end;
end;
procedure TfrmDrawers.AddTemplateNode(const tmpl: TTemplate; const Owner: TTreeNode = nil);
begin
dmodShared.AddTemplateNode(tvTemplates, FEmptyNodeCount, tmpl, FALSE, Owner);
end;
procedure TfrmDrawers.tvTemplatesGetImageIndex(Sender: TObject;
Node: TTreeNode);
begin
Node.ImageIndex := dmodShared.ImgIdx(Node);
end;
procedure TfrmDrawers.tvTemplatesGetSelectedIndex(Sender: TObject;
Node: TTreeNode);
begin
Node.SelectedIndex := dmodShared.ImgIdx(Node);
end;
procedure TfrmDrawers.tvTemplatesExpanding(Sender: TObject;
Node: TTreeNode; var AllowExpansion: Boolean);
begin
if(assigned(Node)) then
begin
if(Dragging) then EndDrag(FALSE);
if(not FInternalExpand) then
begin
if(TTemplate(Node.Data).RealType = ttGroup) then
begin
FAsk := TRUE;
FAskExp := TRUE;
AllowExpansion := FALSE;
FAskNode := Node;
end;
end;
if(AllowExpansion) then
begin
FClickOccurred := FALSE;
AllowExpansion := dmodShared.ExpandNode(tvTemplates, Node, FEmptyNodeCount);
if(FInternalHiddenExpand) then AllowExpansion := FALSE;
end;
end;
end;
procedure TfrmDrawers.CheckAsk;
begin
if(FAsk) then
begin
FAsk := FALSE;
FInternalExpand := TRUE;
try
if(FAskExp) then
FAskNode.Expand(FALSE)
else
FAskNode.Collapse(FALSE);
finally
FInternalExpand := FALSE;
end;
end;
end;
procedure TfrmDrawers.tvTemplatesClick(Sender: TObject);
begin
FClickOccurred := TRUE;
CheckAsk;
end;
procedure TfrmDrawers.tvTemplatesDblClick(Sender: TObject);
begin
if(not FClickOccurred) then CheckAsk
else
begin
FAsk := FALSE;
if((assigned(tvTemplates.Selected)) and
(TTemplate(tvTemplates.Selected.Data).RealType in [ttDoc, ttGroup])) then
InsertText;
end;
end;
procedure TfrmDrawers.tvTemplatesCollapsing(Sender: TObject;
Node: TTreeNode; var AllowCollapse: Boolean);
begin
if(assigned(Node)) then
begin
if(Dragging) then EndDrag(FALSE);
if(not FInternalExpand) then
begin
if(TTemplate(Node.Data).RealType = ttGroup) then
begin
FAsk := TRUE;
FAskExp := FALSE;
AllowCollapse := FALSE;
FAskNode := Node;
end;
end;
if(AllowCollapse) then
FClickOccurred := FALSE;
end;
end;
procedure TfrmDrawers.tvTemplatesKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
CheckAsk;
case Key of
VK_SPACE, VK_RETURN:
begin
InsertText;
Key := 0;
end;
end;
end;
procedure TfrmDrawers.tvTemplatesKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
CheckAsk;
end;
procedure TfrmDrawers.SetRichEditControl(const Value: TRichEdit);
begin
if(FRichEditControl <> Value) then
begin
if(assigned(FRichEditControl)) then
begin
FRichEditControl.OnDragDrop := FOldDragDrop;
FRichEditControl.OnDragOver := FOldDragOver;
end;
FRichEditControl := Value;
if(assigned(FRichEditControl)) then
begin
FOldDragDrop := FRichEditControl.OnDragDrop;
FOldDragOver := FRichEditControl.OnDragOver;
FRichEditControl.OnDragDrop := NewRECDragDrop;
FRichEditControl.OnDragOver := NewRECDragOver;
end;
end;
end;
procedure TfrmDrawers.MoveCaret(X, Y: integer);
var
pt: TPoint;
begin
FRichEditControl.SetFocus;
pt := Point(x, y);
FRichEditControl.SelStart := FRichEditControl.Perform(EM_CHARFROMPOS,0,LParam(@pt));
end;
procedure TfrmDrawers.NewRECDragDrop(Sender, Source: TObject; X,
Y: Integer);
begin
if(Source = tvTemplates) then
begin
MoveCaret(X, Y);
InsertText;
end
else
if(assigned(FOldDragDrop)) then
FOldDragDrop(Sender, Source, X, Y);
end;
procedure TfrmDrawers.NewRECDragOver(Sender, Source: TObject; X,
Y: Integer; State: TDragState; var Accept: Boolean);
begin
Accept := FALSE;
if(Source = tvTemplates) then
begin
if(assigned(FDragNode)) and (TTemplate(FDragNode.Data).RealType in [ttDoc, ttGroup]) then
begin
Accept := TRUE;
MoveCaret(X, Y);
end;
end
else
if(assigned(FOldDragOver)) then
FOldDragOver(Sender, Source, X, Y, State, Accept);
end;
procedure TfrmDrawers.InsertText;
var
BeforeLine, AfterTop: integer;
txt, DocInfo: string;
Template: TTemplate;
begin
DocInfo := '';
if InsertOK(TRUE) and (dmodShared.TemplateOK(tvTemplates.Selected.Data)) then
begin
Template := TTemplate(tvTemplates.Selected.Data);
Template.TemplatePreviewMode := FALSE;
if Template.IsReminderDialog then
Template.ExecuteReminderDialog(TForm(Owner))
else
begin
if Template.IsCOMObject then
txt := Template.COMObjectText('', DocInfo)
else
txt := Template.Text;
if(txt <> '') then
begin
CheckBoilerplate4Fields(txt, 'Template: ' + Template.PrintName);
if txt <> '' then
begin
BeforeLine := SendMessage(FRichEditControl.Handle, EM_EXLINEFROMCHAR, 0, FRichEditControl.SelStart);
FRichEditControl.SelText := txt;
FRichEditControl.SetFocus;
SendMessage(FRichEditControl.Handle, EM_SCROLLCARET, 0, 0);
AfterTop := SendMessage(FRichEditControl.Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
SendMessage(FRichEditControl.Handle, EM_LINESCROLL, 0, -1 * (AfterTop - BeforeLine));
SpeakTextInserted;
end;
end;
end;
end;
end;
procedure TfrmDrawers.popTemplatesPopup(Sender: TObject);
var
Node: TTreeNode;
ok, ok2, NodeFound: boolean;
Def: string;
begin
ok := FALSE;
ok2 := FALSE;
if(FOpenDrawer = odTemplates) then
begin
Node := tvTemplates.Selected;
tvTemplates.Selected := Node; // This line prevents selected from changing after menu closes
NodeFound := (assigned(Node));
if(NodeFound) then
begin
with TTemplate(Node.Data) do
begin
ok := (RealType in [ttDoc, ttGroup]);
ok2 := ok and (not IsReminderDialog) and (not IsCOMObject);
end;
end;
Def := Piece(GetUserTemplateDefaults, '/', FDefTempPiece);
mnuGotoDefault.Enabled := (Def <> '');
mnuViewNotes.Enabled := NodeFound and (TTemplate(Node.Data).Description <> '');
mnuDefault.Enabled := NodeFound;
mnuDefault.Checked := NodeFound and (tvTemplates.GetNodeID(TORTreeNode(Node), 1, ';') = Def);
end
else
begin
mnuDefault.Enabled := FALSE;
mnuGotoDefault.Enabled := FALSE;
mnuViewNotes.Enabled := FALSE;
end;
mnuPreviewTemplate.Enabled := ok2;
mnuCopyTemplate.Enabled := ok2;
mnuInsertTemplate.Enabled := ok and InsertOK(FALSE);
mnuFindTemplates.Enabled := (FOpenDrawer = odTemplates);
mnuCollapseTree.Enabled := ((FOpenDrawer = odTemplates) and
(dmodShared.NeedsCollapsing(tvTemplates)));
mnuEditTemplates.Enabled := (UserTemplateAccessLevel in [taAll, taEditor]);
mnuNewTemplate.Enabled := (UserTemplateAccessLevel in [taAll, taEditor]);
end;
procedure TfrmDrawers.mnuPreviewTemplateClick(Sender: TObject);
var
tmpl: TTemplate;
txt: String;
begin
if(assigned(tvTemplates.Selected)) then
begin
if(dmodShared.TemplateOK(tvTemplates.Selected.Data,'template preview')) then
begin
tmpl := TTemplate(tvTemplates.Selected.Data);
tmpl.TemplatePreviewMode := TRUE; // Prevents "Are you sure?" dialog when canceling
txt := tmpl.Text;
if(not tmpl.DialogAborted) then
ShowTemplateData(Self, tmpl.PrintName, txt);
end;
end;
end;
procedure TfrmDrawers.FormDestroy(Sender: TObject);
begin
dmodShared.RemoveDrawerTree(Self);
KillObj(@FRemNotifyList);
end;
procedure TfrmDrawers.mnuCollapseTreeClick(Sender: TObject);
begin
tvTemplates.Selected := nil;
tvTemplates.FullCollapse;
end;
procedure TfrmDrawers.ReloadTemplates;
begin
SetFindNext(FALSE);
LoadTemplateData;
if(UserTemplateAccessLevel <> taNone) and (assigned(MyTemplate)) and
(MyTemplate.Children in [tcActive, tcBoth]) then
begin
AddTemplateNode(MyTemplate);
FHasPersonalTemplates := TRUE;
end;
AddTemplateNode(RootTemplate);
OpenToNode;
end;
procedure TfrmDrawers.btnFindClick(Sender: TObject);
var
Found, TmpNode: TTreeNode;
IsNext: boolean;
begin
if(edtSearch.text <> '') then
begin
IsNext := ((FFindNext) and assigned (FLastFoundNode));
if IsNext then
TmpNode := FLastFoundNode
else
TmpNode := tvTemplates.Items.GetFirstNode;
FInternalExpand := TRUE;
FInternalHiddenExpand := TRUE;
try
Found := FindTemplate(edtSearch.Text, tvTemplates, Application.MainForm, TmpNode,
IsNext, not cbMatchCase.Checked, cbWholeWords.Checked);
finally
FInternalExpand := FALSE;
FInternalHiddenExpand := FALSE;
end;
if assigned(Found) then
begin
FLastFoundNode := Found;
SetFindNext(TRUE);
FInternalExpand := TRUE;
try
tvTemplates.Selected := Found;
finally
FInternalExpand := FALSE;
end;
end;
end;
edtSearch.SetFocus;
end;
procedure TfrmDrawers.SetFindNext(const Value: boolean);
begin
if(FFindNext <> Value) then
begin
FFindNext := Value;
if(FFindNext) then btnFind.Caption := FindNextText
else btnFind.Caption := 'Find';
end;
end;
procedure TfrmDrawers.edtSearchChange(Sender: TObject);
begin
btnFind.Enabled := (edtSearch.Text <> '');
SetFindNext(FALSE);
end;
procedure TfrmDrawers.ToggleMenuItem(Sender: TObject);
var
TmpMI: TMenuItem;
begin
TmpMI := (Sender as TMenuItem);
TmpMI.Checked := not TmpMI.Checked;
SetFindNext(FALSE);
if(pnlTemplateSearch.Visible) then edtSearch.SetFocus;
end;
procedure TfrmDrawers.edtSearchEnter(Sender: TObject);
begin
btnFind.Default := TRUE;
end;
procedure TfrmDrawers.edtSearchExit(Sender: TObject);
begin
btnFind.Default := FALSE;
end;
procedure TfrmDrawers.mnuFindTemplatesClick(Sender: TObject);
var
FindOn: boolean;
begin
mnuFindTemplates.Checked := not mnuFindTemplates.Checked;
FindOn := mnuFindTemplates.Checked;
pnlTemplateSearch.Visible := FindOn;
if(FindOn) and (FOpenDrawer = odTemplates) then
edtSearch.SetFocus;
end;
procedure TfrmDrawers.tvTemplatesDragging(Sender: TObject; Node: TTreeNode;
var CanDrag: Boolean);
begin
if(TTemplate(Node.Data).RealType in [ttDoc, ttGroup]) then
begin
FDragNode := Node;
CanDrag := TRUE;
end
else
begin
FDragNode := nil;
CanDrag := FALSE;
end;
end;
procedure TfrmDrawers.mnuEditTemplatesClick(Sender: TObject);
begin
EditTemplates(Self);
end;
procedure TfrmDrawers.mnuNewTemplateClick(Sender: TObject);
begin
EditTemplates(Self, TRUE);
end;
procedure TfrmDrawers.FormCreate(Sender: TObject);
begin
dmodShared.AddDrawerTree(Self);
FHasPersonalTemplates := FALSE;
end;
procedure TfrmDrawers.ExternalReloadTemplates;
begin
if(FOpenToNode = '') and (assigned(tvTemplates.Selected)) then
FOpenToNode := tvTemplates.GetNodeID(TORTreeNode(tvTemplates.Selected),1,';');
tvTemplates.Items.Clear;
FHasPersonalTemplates := FALSE;
FEmptyNodeCount := 0;
ReloadTemplates;
end;
procedure TfrmDrawers.fldAccessRemindersInstructionsQuery(Sender: TObject;
var Text: string);
begin
inherited;
if FOpenDrawer = odReminders then
Text := 'to close'
else
Text := 'to open';
Text := Text + ' drawer press space bar';
end;
procedure TfrmDrawers.fldAccessRemindersStateQuery(Sender: TObject;
var Text: string);
begin
inherited;
if FOpenDrawer = odReminders then
Text := ', Drawer Open'
else
Text := ', Drawer Closed';
end;
procedure TfrmDrawers.fldAccessTemplatesInstructionsQuery(Sender: TObject;
var Text: string);
begin
inherited;
if FOpenDrawer = odTemplates then
Text := 'to close'
else
Text := 'to open';
Text := Text + ' drawer press space bar';
end;
procedure TfrmDrawers.fldAccessTemplatesStateQuery(Sender: TObject;
var Text: string);
begin
if FOpenDrawer = odTemplates then
Text := ', Drawer Open'
else
Text := ', Drawer Closed';
end;
procedure TfrmDrawers.DisplayDrawers(Show: Boolean);
begin
DisplayDrawers(Show, [], []);
end;
procedure TfrmDrawers.DisplayDrawers(Show: Boolean; AEnable, ADisplay: TDrawers);
begin
if(not (csLoading in ComponentState)) then
begin
if Show then
begin
EnableDrawers(AEnable);
ShowDrawers(ADisplay);
end
else
begin
ShowDrawers([]);
end;
if(assigned(FSplitter)) then
begin
if(Show and (FOpenDrawer <> odNone)) then
SetSplitterActive(TRUE)
else
SetSplitterActive(FALSE);
end;
end;
end;
function TfrmDrawers.CanEditTemplates: boolean;
begin
Result := (UserTemplateAccessLevel in [taAll, taEditor]);
end;
function TfrmDrawers.CanEditShared: boolean;
begin
Result := (UserTemplateAccessLevel = taEditor);
end;
procedure TfrmDrawers.pnlTemplateSearchResize(Sender: TObject);
begin
if((cbMatchCase.Width + cbWholeWords.Width) > pnlTemplateSearch.Width) then
cbWholeWords.Left := cbMatchCase.Width
else
cbWholeWords.Left := pnlTemplateSearch.Width - cbWholeWords.Width;
end;
procedure TfrmDrawers.cbFindOptionClick(Sender: TObject);
begin
SetFindNext(FALSE);
if(pnlTemplateSearch.Visible) then edtSearch.SetFocus;
end;
procedure TfrmDrawers.mnuInsertTemplateClick(Sender: TObject);
begin
if((assigned(tvTemplates.Selected)) and
(TTemplate(tvTemplates.Selected.Data).RealType in [ttDoc, ttGroup])) then
InsertText;
end;
procedure TfrmDrawers.SetSplitter(const Value: TSplitter);
begin
if(FSplitter <> Value) then
begin
if(assigned(FSplitter)) then
FSplitter.OnCanResize := FOldCanResize;
FSplitter := Value;
if(assigned(FSplitter)) then
begin
FOldCanResize := FSplitter.OnCanResize;
FSplitter.OnCanResize := SplitterCanResize;
SetSplitterActive(FSplitterActive);
end;
end;
end;
procedure TfrmDrawers.SplitterCanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean);
begin
Accept := FSplitterActive;
end;
procedure TfrmDrawers.SetSplitterActive(Active: boolean);
begin
FSplitterActive := Active;
if(Active) then
begin
FSplitter.Cursor := crVSplit;
FSplitter.ResizeStyle := rsPattern;
end
else
begin
FSplitter.Cursor := crDefault;
FSplitter.ResizeStyle := ExtCtrls.rsNone;
end;
end;
procedure TfrmDrawers.UpdatePersonalTemplates;
var
NeedPersonal: boolean;
Node: TTreeNode;
function FindNode: TTreeNode;
begin
Result := tvTemplates.Items.GetFirstNode;
while assigned(Result) do
begin
if(Result.Data = MyTemplate) then exit;
Result := Result.getNextSibling;
end;
end;
begin
NeedPersonal := (UserTemplateAccessLevel <> taNone);
if(NeedPersonal <> FHasPersonalTemplates) then
begin
if(NeedPersonal) then
begin
if(assigned(MyTemplate)) and (MyTemplate.Children in [tcActive, tcBoth]) then
begin
AddTemplateNode(MyTemplate);
FHasPersonalTemplates := TRUE;
if(assigned(MyTemplate)) then
begin
Node := FindNode;
if(assigned(Node)) then
Node.MoveTo(nil, naAddFirst);
end;
end;
end
else
begin
if(assigned(MyTemplate)) then
begin
Node := FindNode;
if(assigned(Node)) then Node.Delete;
end;
FHasPersonalTemplates := FALSE;
end;
end;
end;
procedure TfrmDrawers.RemindersChanged(Sender: TObject);
begin
inc(FHoldResize);
try
if(EnableDrawer(odReminders, (GetReminderStatus <> rsNone))) then
begin
BuildReminderTree(tvReminders);
FOldMouseUp := tvReminders.OnMouseUp;
end
else
begin
FOldMouseUp := nil;
tvReminders.PopupMenu := nil;
end;
tvReminders.OnMouseUp := tvRemindersMouseUp;
finally
dec(FHoldResize);
end;
end;
procedure TfrmDrawers.tvRemindersMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if(Button = mbLeft) and (assigned(tvReminders.Selected)) and
(htOnItem in tvReminders.GetHitTestInfoAt(X, Y)) then
ViewReminderDialog(ReminderNode(tvReminders.Selected));
end;
procedure TfrmDrawers.PositionToReminder(Sender: TObject);
var
Rem: TReminder;
begin
if(assigned(Sender)) then
begin
if(Sender is TReminder) then
begin
Rem := TReminder(Sender);
if(Rem.CurrentNodeID <> '') then
tvReminders.Selected := tvReminders.FindPieceNode(Rem.CurrentNodeID, 1, IncludeParentID)
else
begin
tvReminders.Selected := tvReminders.FindPieceNode(RemCode + (Sender as TReminder).IEN, 1);
if(assigned(tvReminders.Selected)) then
TORTreeNode(tvReminders.Selected).EnsureVisible;
end;
Rem.CurrentNodeID := '';
end;
end
else
tvReminders.Selected := nil;
end;
procedure TfrmDrawers.tvRemindersCurListChanged(Sender: TObject;
Node: TTreeNode);
begin
if(assigned(FRemNotifyList)) then
FRemNotifyList.Notify(Node);
end;
procedure TfrmDrawers.NotifyWhenRemTreeChanges(Proc: TNotifyEvent);
begin
if(not assigned(FRemNotifyList)) then
FRemNotifyList := TORNotifyList.Create;
FRemNotifyList.Add(Proc);
end;
procedure TfrmDrawers.RemoveNotifyWhenRemTreeChanges(Proc: TNotifyEvent);
begin
if(assigned(FRemNotifyList)) then
FRemNotifyList.Remove(Proc);
end;
function TfrmDrawers.GetAlign: TAlign;
begin
Result := inherited Align;
end;
procedure TfrmDrawers.SetAlign(const Value: TAlign);
begin
inherited Align := Value;
ResizeToVisible;
end;
procedure TfrmDrawers.ResetTemplates;
begin
FOpenToNode := Piece(GetUserTemplateDefaults, '/', FDefTempPiece);
end;
procedure TfrmDrawers.mnuDefaultClick(Sender: TObject);
var
NodeID: string;
UserTempDefNode: string;
begin
NodeID := tvTemplates.GetNodeID(TORTreeNode(tvTemplates.Selected), 1, ';');
UserTempDefNode := Piece(GetUserTemplateDefaults, '/', FDefTempPiece);
if NodeID <> UserTempDefNode then
SetUserTemplateDefaults(tvTemplates.GetNodeID(TORTreeNode(tvTemplates.Selected), 1, ';'),
FDefTempPiece)
else SetUserTemplateDefaults('', FDefTempPiece);
end;
procedure TfrmDrawers.OpenToNode(Path: string = '');
var
OldInternalHE, OldInternalEX: boolean;
begin
if(Path <> '') then
FOpenToNode := PATH;
if(FOpenToNode <> '') then
begin
OldInternalHE := FInternalHiddenExpand;
OldInternalEX := FInternalExpand;
try
FInternalExpand := TRUE;
FInternalHiddenExpand := FALSE;
dmodShared.SelectNode(tvTemplates, FOpenToNode, FEmptyNodeCount);
finally
FInternalHiddenExpand := OldInternalHE;
FInternalExpand := OldInternalEX;
end;
FOpenToNode := '';
end;
end;
procedure TfrmDrawers.mnuGotoDefaultClick(Sender: TObject);
begin
OpenToNode(Piece(GetUserTemplateDefaults, '/', FDefTempPiece));
end;
procedure TfrmDrawers.mnuViewNotesClick(Sender: TObject);
var
tmpl: TTemplate;
tmpSL: TStringList;
begin
if(assigned(tvTemplates.Selected)) then
begin
tmpl := TTemplate(tvTemplates.Selected.Data);
if(tmpl.Description = '') then
ShowMsg('No notes found for ' + tmpl.PrintName)
else
begin
tmpSL := TStringList.Create;
try
tmpSL.Text := tmpl.Description;
ReportBox(tmpSL, tmpl.PrintName + ' Notes:', TRUE);
finally
tmpSL.Free;
end;
end;
end;
end;
procedure TfrmDrawers.mnuCopyTemplateClick(Sender: TObject);
var
txt: string;
Template: TTemplate;
begin
txt := '';
if((assigned(tvTemplates.Selected)) and
(TTemplate(tvTemplates.Selected.Data).RealType in [ttDoc, ttGroup])) and
(dmodShared.TemplateOK(tvTemplates.Selected.Data)) then
begin
Template := TTemplate(tvTemplates.Selected.Data);
txt := Template.Text;
CheckBoilerplate4Fields(txt, 'Template: ' + Template.PrintName);
if txt <> '' then
begin
Clipboard.SetTextBuf(PChar(txt));
GetScreenReader.Speak('Text Copied to Clip board');
end;
end;
if txt <> '' then
StatusText('Templated Text copied to clipboard.');
end;
function TfrmDrawers.InsertOK(Ask: boolean): boolean;
function REOK: boolean;
begin
Result := assigned(FRichEditControl) and
FRichEditControl.Visible and
FRichEditControl.Parent.Visible;
end;
begin
Result := REOK;
if (not ask) and (not Result) and (assigned(FNewNoteButton)) then
Result := TRUE
else
if ask and (not Result) and assigned(FNewNoteButton) and
FNewNoteButton.Visible and FNewNoteButton.Enabled then
begin
FNewNoteButton.Click;
Result := REOK;
end;
end;
procedure TfrmDrawers.mnuViewTemplateIconLegendClick(Sender: TObject);
begin
ShowIconLegend(ilTemplates);
end;
procedure TfrmDrawers.pnlTemplatesButtonEnter(Sender: TObject);
begin
with Sender as TPanel do
if (ControlCount > 0) and (Controls[0] is TSpeedButton) and (TSpeedButton(Controls[0]).Down)
then
BevelOuter := bvLowered
else
BevelOuter := bvRaised;
end;
procedure TfrmDrawers.pnlTemplatesButtonExit(Sender: TObject);
begin
with Sender as TPanel do
BevelOuter := bvNone;
DisableArrowKeyMove(Sender);
end;
procedure TfrmDrawers.tvRemindersKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
case Key of
VK_RETURN, VK_SPACE:
begin
ViewReminderDialog(ReminderNode(tvReminders.Selected));
Key := 0;
end;
end;
end;
procedure TfrmDrawers.tvRemindersNodeCaptioning(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 TfrmDrawers.DisableArrowKeyMove(Sender: TObject);
var
CurrPanel : TKeyClickPanel;
begin
if Sender is TKeyClickPanel then
begin
CurrPanel := Sender as TKeyClickPanel;
If Boolean(Hi(GetKeyState(VK_UP)))
OR Boolean(Hi(GetKeyState(VK_DOWN)))
OR Boolean(Hi(GetKeyState(VK_LEFT)))
OR Boolean(Hi(GetKeyState(VK_RIGHT))) then
begin
if Assigned(CurrPanel) then
CurrPanel.SetFocus;
end;
end;
end;
initialization
SpecifyFormIsNotADialog(TfrmDrawers);
end.