source: cprs/branches/tmg-cprs/CPRS-Chart/fDrawers.pas@ 611

Last change on this file since 611 was 541, checked in by Kevin Toppenberg, 15 years ago

TMG Ver 1.1 Added HTML Support, better demographics editing
File size: 51.5 KB
Line 
1//kt -- Modified with SourceScanner on 7/15/2007
2unit fDrawers;
3{
4bugs noticed:
5 if delete only note (currently editing) then drawers and encounter button still enabled
6}
7//vw mod for template callup. Checks in test 4/15/07
8interface
9
10uses
11 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
12 ExtCtrls, StdCtrls, Buttons, ORCtrls, ComCtrls, ImgList, uTemplates,
13 TMGHTML2, rHTMLTools, StrUtils, //kt added uses on this line. 8/09
14 Menus, ORClasses, ORFn, DKLang;
15
16type
17 THTMLModeSwitcher = procedure(HTMLMode : boolean; Quiet : boolean) of object; //kt 8/09
18 TDrawer = (odNone, odTemplates, odEncounter, odReminders, odOrders);
19 TDrawers = set of TDrawer;
20
21 TfrmDrawers = class(TForm)
22 lbOrders: TORListBox;
23 sbOrders: TORAlignSpeedButton;
24 sbReminders: TORAlignSpeedButton;
25 sbEncounter: TORAlignSpeedButton;
26 sbTemplates: TORAlignSpeedButton;
27 pnlOrdersButton: TKeyClickPanel;
28 pnlRemindersButton: TKeyClickPanel;
29 pnlEncounterButton: TKeyClickPanel;
30 pnlTemplatesButton: TKeyClickPanel;
31 lbEncounter: TORListBox;
32 popTemplates: TPopupMenu;
33 mnuPreviewTemplate: TMenuItem;
34 pnlTemplates: TPanel;
35 tvTemplates: TORTreeView;
36 N1: TMenuItem;
37 mnuCollapseTree: TMenuItem;
38 N2: TMenuItem;
39 mnuEditTemplates: TMenuItem;
40 pnlTemplateSearch: TPanel;
41 btnFind: TORAlignButton;
42 edtSearch: TCaptionEdit;
43 mnuFindTemplates: TMenuItem;
44 mnuNewTemplate: TMenuItem;
45 cbMatchCase: TCheckBox;
46 cbWholeWords: TCheckBox;
47 mnuInsertTemplate: TMenuItem;
48 tvReminders: TORTreeView;
49 mnuDefault: TMenuItem;
50 N3: TMenuItem;
51 mnuGotoDefault: TMenuItem;
52 N4: TMenuItem;
53 mnuViewNotes: TMenuItem;
54 mnuCopyTemplate: TMenuItem;
55 N5: TMenuItem;
56 mnuViewTemplateIconLegend: TMenuItem;
57 DKLanguageController1: TDKLanguageController;
58 procedure FormCanResize(Sender: TObject; var NewWidth,
59 NewHeight: Integer; var Resize: Boolean);
60 procedure FormResize(Sender: TObject);
61 procedure sbTemplatesClick(Sender: TObject);
62 procedure sbEncounterClick(Sender: TObject);
63 procedure sbRemindersClick(Sender: TObject);
64 procedure sbOrdersClick(Sender: TObject);
65 procedure sbResize(Sender: TObject);
66 procedure tvTemplatesGetImageIndex(Sender: TObject; Node: TTreeNode);
67 procedure tvTemplatesGetSelectedIndex(Sender: TObject;
68 Node: TTreeNode);
69 procedure tvTemplatesExpanding(Sender: TObject; Node: TTreeNode;
70 var AllowExpansion: Boolean);
71 procedure tvTemplatesClick(Sender: TObject);
72 procedure tvTemplatesDblClick(Sender: TObject);
73 procedure tvTemplatesCollapsing(Sender: TObject; Node: TTreeNode;
74 var AllowCollapse: Boolean);
75 procedure tvTemplatesKeyDown(Sender: TObject; var Key: Word;
76 Shift: TShiftState);
77 procedure tvTemplatesKeyUp(Sender: TObject; var Key: Word;
78 Shift: TShiftState);
79 procedure popTemplatesPopup(Sender: TObject);
80 procedure mnuPreviewTemplateClick(Sender: TObject);
81 procedure FormDestroy(Sender: TObject);
82 procedure mnuCollapseTreeClick(Sender: TObject);
83 procedure btnFindClick(Sender: TObject);
84 procedure edtSearchChange(Sender: TObject);
85 procedure ToggleMenuItem(Sender: TObject);
86 procedure edtSearchEnter(Sender: TObject);
87 procedure edtSearchExit(Sender: TObject);
88 procedure mnuFindTemplatesClick(Sender: TObject);
89 procedure tvTemplatesDragging(Sender: TObject; Node: TTreeNode;
90 var CanDrag: Boolean);
91 procedure mnuEditTemplatesClick(Sender: TObject);
92 procedure mnuNewTemplateClick(Sender: TObject);
93 procedure FormCreate(Sender: TObject);
94 procedure pnlTemplateSearchResize(Sender: TObject);
95 procedure cbFindOptionClick(Sender: TObject);
96 procedure mnuInsertTemplateClick(Sender: TObject);
97 procedure tvRemindersMouseUp(Sender: TObject; Button: TMouseButton;
98 Shift: TShiftState; X, Y: Integer);
99 procedure tvRemindersCurListChanged(Sender: TObject; Node: TTreeNode);
100 procedure mnuDefaultClick(Sender: TObject);
101 procedure mnuGotoDefaultClick(Sender: TObject);
102 procedure mnuViewNotesClick(Sender: TObject);
103 procedure mnuCopyTemplateClick(Sender: TObject);
104 procedure mnuViewTemplateIconLegendClick(Sender: TObject);
105 procedure pnlTemplatesButtonEnter(Sender: TObject);
106 procedure pnlTemplatesButtonExit(Sender: TObject);
107 procedure tvRemindersKeyDown(Sender: TObject; var Key: Word;
108 Shift: TShiftState);
109 procedure tvRemindersNodeCaptioning(Sender: TObject;
110 var Caption: String);
111 procedure tvRemindersAddition(Sender: TObject; Node: TTreeNode);
112 procedure tvRemindersDeletion(Sender: TObject; Node: TTreeNode);
113 private
114 //kt Begin Mod (change Consts to Vars) 7/15/2007
115 DrawerSplitters : string; //kt
116 FindNextText : string; //kt
117 //kt End Mod -------------------
118 FHtmlEditControl: THtmlObj; //kt 8/09
119 FHtmlModeSwitcher : THTMLModeSwitcher; //kt 8/09
120 FOpenToNode: string;
121 FOldMouseUp: TMouseEvent;
122 FEmptyNodeCount: integer;
123 FOldDragDrop: TDragDropEvent;
124 FOldDragOver: TDragOverEvent;
125 FOldFontChanged: TNotifyEvent;
126 FTextIconWidth: integer;
127 FInternalResize: integer;
128 FHoldResize: integer;
129 FOpenDrawer: TDrawer;
130 FLastOpenSize: integer;
131 FButtonHeights: integer;
132 FInternalExpand :boolean;
133 FInternalHiddenExpand :boolean;
134 FAsk :boolean;
135 FAskExp :boolean;
136 FAskNode :TTreeNode;
137 FDragNode :TTreeNode;
138 FClickOccurred: boolean;
139 FRichEditControl: TRichEdit;
140 FFindNext: boolean;
141 FLastFoundNode: TTreeNode;
142 FSplitter: TSplitter;
143 FOldCanResize: TCanResizeEvent;
144 FSplitterActive: boolean;
145 FHasPersonalTemplates: boolean;
146 FRemNotifyList: TORNotifyList;
147 FDefTempPiece: integer;
148 FNewNoteButton: TButton;
149 FCurrentVisibleDrawers: TDrawers;
150 FCurrentEnabledDrawers: TDrawers;
151 function GetAlign: TAlign;
152 procedure SetAlign(const Value: TAlign);
153 function MinDrawerControlHeight: integer;
154 procedure DisableArrowKeyMove(Sender: TObject);
155 protected
156 procedure PositionToReminder(Sender: TObject);
157 procedure RemindersChanged(Sender: TObject);
158 procedure SetFindNext(const Value: boolean);
159 procedure ReloadTemplates;
160 procedure SetRichEditControl(const Value: TRichEdit);
161 procedure SetHTMLEditControl(const Value: THtmlObj); //kt 8/09
162 procedure CheckAsk;
163 procedure FontChanged(Sender: TObject);
164 procedure InitButtons;
165 procedure StartInternalResize;
166 procedure EndInternalResize;
167 procedure ResizeToVisible;
168 function ButtonHeights: integer;
169 procedure GetDrawerControls(Drawer: TDrawer;
170 var Btn: TORAlignSpeedButton;
171 var Ctrl: TWinControl);
172 procedure AddTemplateNode(const tmpl: TTemplate; const Owner: TTreeNode = nil);
173 procedure MoveCaret(X, Y: integer);
174 procedure MoveHTMLCaret(X, Y: integer); //kt 8/09
175 procedure NewRECDragDrop(Sender, Source: TObject; X, Y: Integer);
176 procedure NewRECDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState;
177 var Accept: Boolean);
178 procedure NewRECHTMLDragDrop(Sender, Source: TObject; X, Y: Integer); //kt 8/09
179 procedure NewRECHTMLDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState;
180 var Accept: Boolean); //kt 8/09
181 procedure InsertText;
182 procedure SetSplitter(const Value: TSplitter);
183 procedure SplitterCanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean);
184 procedure SetSplitterActive(Active: boolean);
185 function EnableDrawer(Drawer: TDrawer; EnableIt: boolean): boolean;
186 //kt 8/09 function InsertOK(Ask: boolean): boolean;
187 function InsertOK(Ask: boolean; TemplateIsHTML : boolean = false): boolean; //kt 8/09
188 procedure OpenToNode(Path: string = '');
189 property FindNext: boolean read FFindNext write SetFindNext;
190 procedure SetupVars;
191 public
192 constructor CreateDrawers(AOwner: TComponent; AParent: TWinControl;
193 VisibleDrawers, EnabledDrawers: TDrawers);
194 procedure ExternalReloadTemplates;
195 procedure OpenDrawer(Drawer: TDrawer);
196 procedure ToggleDrawer(Drawer: TDrawer);
197 procedure ShowDrawers(Drawers: TDrawers);
198 procedure EnableDrawers(Drawers: TDrawers);
199 procedure DisplayDrawers(Show: Boolean); overload;
200 procedure DisplayDrawers(Show: Boolean; AEnable, ADisplay: TDrawers); overload;
201 function CanEditTemplates: boolean;
202 function CanEditShared: boolean;
203 procedure UpdatePersonalTemplates;
204 procedure NotifyWhenRemTreeChanges(Proc: TNotifyEvent);
205 procedure RemoveNotifyWhenRemTreeChanges(Proc: TNotifyEvent);
206 procedure ResetTemplates;
207 property RichEditControl: TRichEdit read FRichEditControl write SetRichEditControl;
208 property HTMLEditControl : THtmlObj read FHtmlEditControl write SetHTMLEditControl; //kt 8/09
209 property HTMLModeSwitcher : THTMLModeSwitcher read FHtmlModeSwitcher write FHtmlModeSwitcher; //kt 8/09
210 property NewNoteButton: TButton read FNewNoteButton write FNewNoteButton;
211 property Splitter: TSplitter read FSplitter write SetSplitter;
212 property HasPersonalTemplates: boolean read FHasPersonalTemplates;
213 property LastOpenSize: integer read FLastOpenSize write FLastOpenSize;
214 property DefTempPiece: integer read FDefTempPiece write FDefTempPiece;
215 property TheOpenDrawer: TDrawer read FOpenDrawer;
216 function HTMLEditActive : boolean; //kt 8/09
217 published
218 property Align: TAlign read GetAlign write SetAlign;
219 end;
220
221{ There is a different instance of frmDrawers on each tab, so make the
222 frmDrawers variable local to each tab, do not use this global var! }
223//var
224 //frmDrawers: TfrmDrawers;
225
226const
227 DrawerSplitters = 'frmDrawersSplitters';
228
229implementation
230
231uses fTemplateView, uCore, rTemplates, fTemplateEditor, dShared, uReminders,
232 fReminderDialog, RichEdit, fRptBox, Clipbrd, fTemplateDialog, fIconLegend,
233 Inifiles, //kt 8/09
234 uAccessibleTreeView, uAccessibleTreeNode;
235
236{$R *.DFM}
237
238const
239 BaseMinDrawerControlHeight = 24;
240//FindNextText = 'Find Next'; <-- original line. //kt 7/15/2007
241
242procedure TfrmDrawers.SetupVars;
243//kt Added entire function to replace constant declarations 7/15/2007
244begin
245 FindNextText := DKLangConstW('fDrawers_Find_Next');
246end;
247
248function TfrmDrawers.MinDrawerControlHeight: integer;
249begin
250 result := ResizeHeight( BaseFont, MainFont, BaseMinDrawerControlHeight);
251end;
252
253procedure TfrmDrawers.ResizeToVisible;
254var
255 NewHeight: integer;
256 od: TDrawer;
257 Button: TORAlignSpeedButton;
258 WinCtrl: TWinControl;
259
260 procedure AllCtrls(AAlign: TAlign);
261 var
262 od: TDrawer;
263
264 begin
265 Parent.DisableAlign;
266 try
267 for od := succ(low(TDrawer)) to high(TDrawer) do
268 begin
269 GetDrawerControls(od, Button, WinCtrl);
270 Button.Parent.Align := AAlign;
271 WinCtrl.Align := AAlign;
272 end;
273 finally
274 Parent.EnableAlign;
275 end;
276 end;
277
278begin
279 if((FHoldResize = 0) and Visible) then
280 begin
281 FButtonHeights := -1; //Force re-calculate
282 NewHeight := 0;
283 AllCtrls(alNone);
284 for od := succ(low(TDrawer)) to high(TDrawer) do
285 begin
286 GetDrawerControls(od, Button, WinCtrl);
287 if(Button.Parent.Visible) then
288 begin
289 Button.Parent.Top := NewHeight;
290 inc(NewHeight, Button.Parent.Height);
291 WinCtrl.Top := NewHeight;
292 if(WinCtrl.Visible) then
293 begin
294 if(FLastOpenSize < 10) or (FLastOpenSize > (Parent.Height - 20)) then
295 begin
296 FLastOpenSize := (Parent.Height div 4) * 3;
297 dec(FLastOpenSize, ButtonHeights);
298 if(FLastOpenSize < MinDrawerControlHeight) then
299 FLastOpenSize := MinDrawerControlHeight;
300 end;
301 inc(NewHeight, FLastOpenSize);
302 WinCtrl.Height := FLastOpenSize;
303 end
304 else
305 WinCtrl.Height := 0;
306 end;
307 end;
308 AllCtrls(alTop);
309 StartInternalResize;
310 try
311 ClientHeight := NewHeight
312 finally
313 EndInternalResize;
314 end;
315 end;
316end;
317
318procedure TfrmDrawers.FormCanResize(Sender: TObject; var NewWidth,
319 NewHeight: Integer; var Resize: Boolean);
320var
321 od: TDrawer;
322 Btn: TORAlignSpeedButton;
323 Ctrl: TWinControl;
324 IsVisible: boolean;
325
326begin
327 if(FInternalResize = 0) then
328 begin
329 IsVisible := FALSE;
330 for od := succ(low(TDrawer)) to high(TDrawer) do
331 begin
332 GetDrawerControls(od, Btn, Ctrl);
333 if(Ctrl.Visible) then
334 begin
335 IsVisible := TRUE;
336 break;
337 end;
338 end;
339 if(not IsVisible) then
340 NewHeight := ButtonHeights;
341 end;
342end;
343
344function TfrmDrawers.ButtonHeights: integer;
345begin
346 if(FButtonHeights < 0) then
347 begin
348 FButtonHeights := 0;
349 if(pnlOrdersButton.Visible) then
350 inc(FButtonHeights, sbOrders.Height);
351 if(pnlRemindersButton.Visible) then
352 inc(FButtonHeights, sbReminders.Height);
353 if(pnlEncounterButton.Visible) then
354 inc(FButtonHeights, sbEncounter.Height);
355 if(pnlTemplatesButton.Visible) then
356 inc(FButtonHeights, sbTemplates.Height);
357 end;
358 Result := FButtonHeights;
359end;
360
361procedure TfrmDrawers.ShowDrawers(Drawers: TDrawers);
362var
363 od: TDrawer;
364 Btn: TORAlignSpeedButton;
365 Ctrl: TWinControl;
366 SaveLOS: integer;
367
368begin
369 if(FCurrentVisibleDrawers = []) or (Drawers <> FCurrentVisibleDrawers) then
370 begin
371 FCurrentVisibleDrawers := Drawers;
372 SaveLOS := FLastOpenSize;
373 OpenDrawer(odNone);
374 for od := succ(low(TDrawer)) to high(TDrawer) do
375 begin
376 GetDrawerControls(od, Btn, Ctrl);
377 Btn.Parent.Visible := (od in Drawers);
378 Ctrl.Visible := FALSE;
379 Ctrl.Height := 0;
380 end;
381 FButtonHeights := -1;
382 FLastOpenSize := SaveLOS;
383 ResizeToVisible;
384 if(odReminders in Drawers) then
385 begin
386 NotifyWhenRemindersChange(RemindersChanged);
387 NotifyWhenProcessingReminderChanges(PositionToReminder);
388 end
389 else
390 begin
391 RemoveNotifyRemindersChange(RemindersChanged);
392 RemoveNotifyWhenProcessingReminderChanges(PositionToReminder);
393 end;
394 end;
395end;
396
397procedure TfrmDrawers.OpenDrawer(Drawer: TDrawer);
398var
399 Btn: TORAlignSpeedButton;
400 Ctrl: TWinControl;
401
402begin
403 if(FOpenDrawer <> Drawer) then
404 begin
405 StartInternalResize;
406 try
407 if(FOpenDrawer <> odNone) then
408 begin
409 GetDrawerControls(FOpenDrawer, Btn, Ctrl);
410 Btn.Down := FALSE;
411 with Btn.Parent as TPanel do
412 if BevelOuter = bvLowered then
413 BevelOuter := bvRaised;
414 Ctrl.Visible := FALSE;
415 Ctrl.Height := 0;
416 end;
417 if(Drawer = odNone) then
418 begin
419 FOpenDrawer := Drawer;
420 SetSplitterActive(FALSE);
421 end
422 else
423 begin
424 GetDrawerControls(Drawer, Btn, Ctrl);
425 if(Btn.Parent.Visible) and (Btn.Enabled) then
426 begin
427 SetSplitterActive(TRUE);
428 Btn.Down := TRUE;
429 with Btn.Parent as TPanel do
430 if BevelOuter = bvRaised then
431 BevelOuter := bvLowered;
432 Ctrl.Visible := TRUE;
433 FOpenDrawer := Drawer;
434 end
435 else
436 SetSplitterActive(FALSE);
437 end;
438 finally
439 EndInternalResize;
440 end;
441 ResizeToVisible;
442 end;
443end;
444
445procedure TfrmDrawers.GetDrawerControls(Drawer: TDrawer;
446 var Btn: TORAlignSpeedButton; var Ctrl: TWinControl);
447begin
448 case Drawer of
449 odTemplates:
450 begin
451 Btn := sbTemplates;
452 Ctrl := pnlTemplates;
453 end;
454
455 odEncounter:
456 begin
457 Btn := sbEncounter;
458 Ctrl := lbEncounter;
459 end;
460
461 odReminders:
462 begin
463 Btn := sbReminders;
464 Ctrl := tvReminders;
465 end;
466
467 odOrders:
468 begin
469 Btn := sbOrders;
470 Ctrl := lbOrders;
471 end;
472
473 else
474 begin
475 Btn := nil;
476 Ctrl := nil;
477 end;
478 end;
479end;
480
481constructor TfrmDrawers.CreateDrawers(AOwner: TComponent; AParent: TWinControl;
482 VisibleDrawers, EnabledDrawers: TDrawers);
483begin
484 FInternalResize := 0;
485 StartInternalResize;
486 try
487 Create(AOwner);
488 FButtonHeights := -1;
489 FLastOpenSize := 0;
490 FOpenDrawer := odNone;
491 Parent := AParent;
492 Align := alBottom;
493 FOldFontChanged := Font.OnChange;
494 Font.OnChange := FontChanged;
495 InitButtons;
496 ShowDrawers(VisibleDrawers);
497 EnableDrawers(EnabledDrawers);
498 Show;
499 finally
500 EndInternalResize;
501 end;
502end;
503
504function TfrmDrawers.EnableDrawer(Drawer: TDrawer; EnableIt: boolean): boolean;
505var
506 Btn: TORAlignSpeedButton;
507 Ctrl: TWinControl;
508
509begin
510 inc(FHoldResize);
511 try
512 GetDrawerControls(Drawer, Btn, Ctrl);
513 Btn.Parent.Enabled := EnableIt;
514 if(Drawer = FOpenDrawer) and (not Btn.Parent.Enabled) then
515 OpenDrawer(odNone);
516 finally
517 dec(FHoldResize);
518 end;
519 ResizeToVisible;
520 Result := EnableIt;
521end;
522
523procedure TfrmDrawers.EnableDrawers(Drawers: TDrawers);
524var
525 od: TDrawer;
526
527begin
528 if(FCurrentEnabledDrawers = []) or (Drawers <> FCurrentEnabledDrawers) then
529 begin
530 FCurrentEnabledDrawers := Drawers;
531 inc(FHoldResize);
532 try
533 for od := succ(low(TDrawer)) to high(TDrawer) do
534 EnableDrawer(od, (od in Drawers));
535 finally
536 dec(FHoldResize);
537 end;
538 ResizeToVisible;
539 end;
540end;
541
542procedure TfrmDrawers.FormResize(Sender: TObject);
543begin
544 if(FInternalResize = 0) and (FOpenDrawer <> odNone) then
545 begin
546 FLastOpenSize := Height;
547 dec(FLastOpenSize, ButtonHeights);
548 if(FLastOpenSize < MinDrawerControlHeight) then
549 FLastOpenSize := MinDrawerControlHeight;
550 ResizeToVisible;
551 end;
552end;
553
554procedure TfrmDrawers.sbTemplatesClick(Sender: TObject);
555begin
556 if(FOpenDrawer <> odTemplates) then
557 begin
558 ReloadTemplates;
559 btnFind.Enabled := (edtSearch.Text <> '');
560 pnlTemplateSearch.Visible := mnuFindTemplates.Checked;
561 end;
562 ToggleDrawer(odTemplates);
563end;
564
565procedure TfrmDrawers.sbEncounterClick(Sender: TObject);
566begin
567 ToggleDrawer(odEncounter);
568end;
569
570procedure TfrmDrawers.sbRemindersClick(Sender: TObject);
571begin
572 if(InitialRemindersLoaded) then
573 ToggleDrawer(odReminders)
574 else
575 begin
576 StartupReminders;
577 if(GetReminderStatus = rsNone) then
578 begin
579 EnableDrawer(odReminders, FALSE);
580 sbReminders.Down := FALSE;
581 with sbReminders.Parent as TPanel do
582 if BevelOuter = bvLowered then
583 BevelOuter := bvRaised;
584 end
585 else
586 ToggleDrawer(odReminders)
587 end;
588end;
589
590procedure TfrmDrawers.sbOrdersClick(Sender: TObject);
591begin
592 ToggleDrawer(odOrders);
593end;
594
595procedure TfrmDrawers.ToggleDrawer(Drawer: TDrawer);
596begin
597 if(Drawer = FOpenDrawer) then
598 OpenDrawer(odNone)
599 else
600 OpenDrawer(Drawer);
601end;
602
603procedure TfrmDrawers.EndInternalResize;
604begin
605 if(FInternalResize > 0) then dec(FInternalResize);
606end;
607
608procedure TfrmDrawers.StartInternalResize;
609begin
610 inc(FInternalResize);
611end;
612
613procedure TfrmDrawers.sbResize(Sender: TObject);
614var
615 Button: TORAlignSpeedButton;
616 Mar: integer; // Mar Needed because you can't assign Margin a negative value
617
618begin
619 Button := (Sender as TORAlignSpeedButton);
620 Mar := (Button.Width - FTextIconWidth) div 2;
621 if(Mar < 0) then
622 Mar := 0;
623 Button.Margin := Mar;
624end;
625
626procedure TfrmDrawers.InitButtons;
627var
628 od: TDrawer;
629 Btn: TORAlignSpeedButton;
630 Ctrl: TWinControl;
631 TmpWidth: integer;
632 TmpHeight: integer;
633 MaxHeight: integer;
634
635begin
636 StartInternalResize;
637 try
638 FTextIconWidth := 0;
639 MaxHeight := 0;
640 for od := succ(low(TDrawer)) to high(TDrawer) do
641 begin
642 GetDrawerControls(od, Btn, Ctrl);
643 TmpWidth := Canvas.TextWidth(Btn.Caption) + Btn.Spacing +
644 (Btn.Glyph.Width div Btn.NumGlyphs) + 4;
645 if(TmpWidth > FTextIconWidth) then
646 FTextIconWidth := TmpWidth;
647 TmpHeight := Canvas.TextHeight(Btn.Caption) + 9;
648 if(TmpHeight > MaxHeight) then
649 MaxHeight := TmpHeight;
650 end;
651 if(MaxHeight > 0) then
652 begin
653 for od := succ(low(TDrawer)) to high(TDrawer) do
654 begin
655 GetDrawerControls(od, Btn, Ctrl);
656 Btn.Parent.Height := MaxHeight;
657 end;
658 end;
659 Constraints.MinWidth := FTextIconWidth;
660 finally
661 EndInternalResize;
662 end;
663 ResizeToVisible;
664end;
665
666procedure TfrmDrawers.FontChanged(Sender: TObject);
667var
668 Ht: integer;
669
670begin
671 if(assigned(FOldFontChanged)) then
672 FOldFontChanged(Sender);
673 if(FInternalResize = 0) then
674 begin
675 InitButtons;
676 ResizeToVisible;
677 btnFind.Width := Canvas.TextWidth(FindNextText) + 10;
678 btnFind.Height := edtSearch.Height;
679 btnFind.Left := pnlTemplateSearch.Width - btnFind.Width;
680 edtSearch.Width := pnlTemplateSearch.Width - btnFind.Width;
681 cbMatchCase.Width := Canvas.TextWidth(cbMatchCase.Caption)+23;
682 cbWholeWords.Width := Canvas.TextWidth(cbWholeWords.Caption)+23;
683 Ht := Canvas.TextHeight(cbMatchCase.Caption);
684 if(Ht < 17) then Ht := 17;
685 pnlTemplateSearch.Height := edtSearch.Height + Ht;
686 cbMatchCase.Height := Ht;
687 cbWholeWords.Height := Ht;
688 cbMatchCase.Top := edtSearch.Height;
689 cbWholeWords.Top := edtSearch.Height;
690 pnlTemplateSearchResize(Sender);
691 end;
692end;
693
694procedure TfrmDrawers.AddTemplateNode(const tmpl: TTemplate; const Owner: TTreeNode = nil);
695begin
696 dmodShared.AddTemplateNode(tvTemplates, FEmptyNodeCount, tmpl, FALSE, Owner);
697end;
698
699procedure TfrmDrawers.tvTemplatesGetImageIndex(Sender: TObject;
700 Node: TTreeNode);
701
702begin
703 Node.ImageIndex := dmodShared.ImgIdx(Node);
704end;
705
706procedure TfrmDrawers.tvTemplatesGetSelectedIndex(Sender: TObject;
707 Node: TTreeNode);
708begin
709//vw mod for template callup. Checks in test
710
711 //Application.MessageBox(PChar('Node='+IntToStr(Node.Index)+' tvtemplates.VertScrollPos='+IntToStr(tvTemplates.VertScrollPos)),PChar(Application.Title),MB_ICONINFORMATION);
712// sbTemplates.Caption := 'Templates '+ 'Node='+IntToStr(Node.Index)+' VertScrollPos='+IntToStr(tvTemplates.VertScrollPos) ; <-- original line. //kt 7/15/2007
713
714 // changed caption to only say "Templates" elh 2/18/09
715 //sbTemplates.Caption := DKLangConstW('fDrawers_Templates')+ DKLangConstW('fDrawers_Nodex')+IntToStr(Node.Index)+DKLangConstW('fDrawers_VertScrollPosx')+IntToStr(tvTemplates.VertScrollPos) ; //kt added 7/15/2007
716 sbTemplates.Caption := DKLangConstW('fDrawers_Templates');
717
718//end vw mod
719 Node.SelectedIndex := dmodShared.ImgIdx(Node);
720end;
721
722procedure TfrmDrawers.tvTemplatesExpanding(Sender: TObject;
723 Node: TTreeNode; var AllowExpansion: Boolean);
724begin
725 if(assigned(Node)) then
726 begin
727 if(Dragging) then EndDrag(FALSE);
728 if(not FInternalExpand) then
729 begin
730 if(TTemplate(Node.Data).RealType = ttGroup) then
731 begin
732 FAsk := TRUE;
733 FAskExp := TRUE;
734 AllowExpansion := FALSE;
735 FAskNode := Node;
736 end;
737 end;
738 if(AllowExpansion) then
739 begin
740 FClickOccurred := FALSE;
741 AllowExpansion := dmodShared.ExpandNode(tvTemplates, Node, FEmptyNodeCount);
742 if(FInternalHiddenExpand) then AllowExpansion := FALSE;
743 end;
744 end;
745 //vw mod for template callup. Checks in test
746
747 //Application.MessageBox(PChar('Node='+IntToStr(Node.Index)+' tvtemplates.VertScrollPos='+IntToStr(tvTemplates.VertScrollPos)),PChar(Application.Title),MB_ICONINFORMATION);
748// sbTemplates.Caption := 'Templates '+ 'Node='+IntToStr(Node.Index)+' VertScrollPos='+IntToStr(tvTemplates.VertScrollPos) ; <-- original line. //kt 7/15/2007
749
750 // changed caption to only say "Templates" elh 2/18/09
751 //sbTemplates.Caption := DKLangConstW('fDrawers_Templates')+ DKLangConstW('fDrawers_Nodex')+IntToStr(Node.Index)+DKLangConstW('fDrawers_VertScrollPosx')+IntToStr(tvTemplates.VertScrollPos) ; //kt added 7/15/2007
752 sbTemplates.Caption := DKLangConstW('fDrawers_Templates');
753
754 //end vw mod
755end;
756
757procedure TfrmDrawers.CheckAsk;
758begin
759 if(FAsk) then
760 begin
761 FAsk := FALSE;
762 FInternalExpand := TRUE;
763 try
764 if(FAskExp) then
765 FAskNode.Expand(FALSE)
766 else
767 FAskNode.Collapse(FALSE);
768 finally
769 FInternalExpand := FALSE;
770 end;
771 end;
772end;
773
774procedure TfrmDrawers.tvTemplatesClick(Sender: TObject);
775begin
776 FClickOccurred := TRUE;
777 CheckAsk;
778end;
779
780procedure TfrmDrawers.tvTemplatesDblClick(Sender: TObject);
781begin
782 if(not FClickOccurred) then CheckAsk
783 else
784 begin
785 FAsk := FALSE;
786 if((assigned(tvTemplates.Selected)) and
787 (TTemplate(tvTemplates.Selected.Data).RealType in [ttDoc, ttGroup])) then
788 InsertText;
789 end;
790end;
791
792procedure TfrmDrawers.tvTemplatesCollapsing(Sender: TObject;
793 Node: TTreeNode; var AllowCollapse: Boolean);
794begin
795 if(assigned(Node)) then
796 begin
797 if(Dragging) then EndDrag(FALSE);
798 if(not FInternalExpand) then
799 begin
800 if(TTemplate(Node.Data).RealType = ttGroup) then
801 begin
802 FAsk := TRUE;
803 FAskExp := FALSE;
804 AllowCollapse := FALSE;
805 FAskNode := Node;
806 end;
807 end;
808 if(AllowCollapse) then
809 FClickOccurred := FALSE;
810 end;
811 //vw mod for template callup. Checks in test
812
813 //Application.MessageBox(PChar('Node='+IntToStr(Node.Index)+' tvtemplates.VertScrollPos='+IntToStr(tvTemplates.VertScrollPos)),PChar(Application.Title),MB_ICONINFORMATION);
814// sbTemplates.Caption := 'Templates '+ 'Node='+IntToStr(Node.Index)+' VertScrollPos='+IntToStr(tvTemplates.VertScrollPos) ; <-- original line. //kt 7/15/2007
815
816 // changed caption to only say "Templates" elh 2/18/09
817 //sbTemplates.Caption := DKLangConstW('fDrawers_Templates')+ DKLangConstW('fDrawers_Nodex')+IntToStr(Node.Index)+DKLangConstW('fDrawers_VertScrollPosx')+IntToStr(tvTemplates.VertScrollPos) ; //kt added 7/15/2007
818 sbTemplates.Caption := DKLangConstW('fDrawers_Templates');
819
820 //end vw mod
821end;
822
823procedure TfrmDrawers.tvTemplatesKeyDown(Sender: TObject; var Key: Word;
824 Shift: TShiftState);
825begin
826 CheckAsk;
827 case Key of
828 VK_SPACE, VK_RETURN:
829 begin
830 InsertText;
831 Key := 0;
832 end;
833 end;
834end;
835
836procedure TfrmDrawers.tvTemplatesKeyUp(Sender: TObject; var Key: Word;
837 Shift: TShiftState);
838begin
839 CheckAsk;
840end;
841
842procedure TfrmDrawers.SetRichEditControl(const Value: TRichEdit);
843begin
844 if(FRichEditControl <> Value) then
845 begin
846 if(assigned(FRichEditControl)) then
847 begin
848 FRichEditControl.OnDragDrop := FOldDragDrop;
849 FRichEditControl.OnDragOver := FOldDragOver;
850 end;
851 FRichEditControl := Value;
852 if(assigned(FRichEditControl)) then
853 begin
854 FOldDragDrop := FRichEditControl.OnDragDrop;
855 FOldDragOver := FRichEditControl.OnDragOver;
856 FRichEditControl.OnDragDrop := NewRECDragDrop;
857 FRichEditControl.OnDragOver := NewRECDragOver;
858 end;
859 end;
860end;
861
862procedure TfrmDrawers.SetHTMLEditControl(const Value: THtmlObj);
863//kt added this function 8/09
864begin
865 if (FHtmlEditControl <> Value) then begin
866 if (assigned(FHtmlEditControl)) then begin
867 FHtmlEditControl.OnDragDrop := FOldDragDrop;
868 FHtmlEditControl.OnDragOver := FOldDragOver;
869 end;
870 FHtmlEditControl := Value;
871 if (assigned(FHtmlEditControl)) then begin
872 FOldDragDrop := FHtmlEditControl.OnDragDrop;
873 FOldDragOver := FHtmlEditControl.OnDragOver;
874 FHtmlEditControl.OnDragDrop := NewRECHTMLDragDrop;
875 FHtmlEditControl.OnDragOver := NewRECHTMLDragOver;
876 end;
877 end;
878end;
879
880function TfrmDrawers.HTMLEditActive : boolean;
881//kt added this function 8/09
882begin
883 if assigned(FHtmlEditControl) then begin
884 Result := FHtmlEditControl.Active;
885 end else Result := false;
886end;
887
888procedure TfrmDrawers.MoveCaret(X, Y: integer);
889var
890 pt: TPoint;
891
892begin
893 FRichEditControl.SetFocus;
894 pt := Point(x, y);
895 FRichEditControl.SelStart := FRichEditControl.Perform(EM_CHARFROMPOS,0,LParam(@pt));
896end;
897
898procedure TfrmDrawers.MoveHTMLCaret(X, Y: integer);
899//kt added entire function 8/09
900var pt: TPoint;
901begin
902 FHtmlEditControl.SetFocus;
903 pt := Point(x, y);
904 FHTMLEditControl.MoveCaretToPos(pt);
905end;
906
907procedure TfrmDrawers.NewRECDragDrop(Sender, Source: TObject; X,
908 Y: Integer);
909begin
910 if(Source = tvTemplates) then
911 begin
912 MoveCaret(X, Y);
913 InsertText;
914 end
915 else
916 if(assigned(FOldDragDrop)) then
917 FOldDragDrop(Sender, Source, X, Y);
918end;
919
920procedure TfrmDrawers.NewRECDragOver(Sender, Source: TObject; X,
921 Y: Integer; State: TDragState; var Accept: Boolean);
922
923begin
924 Accept := FALSE;
925 if(Source = tvTemplates) then
926 begin
927 if(assigned(FDragNode)) and (TTemplate(FDragNode.Data).RealType in [ttDoc, ttGroup]) then
928 begin
929 Accept := TRUE;
930 MoveCaret(X, Y);
931 end;
932 end
933 else
934 if(assigned(FOldDragOver)) then
935 FOldDragOver(Sender, Source, X, Y, State, Accept);
936end;
937
938procedure TfrmDrawers.NewRECHTMLDragDrop(Sender, Source: TObject; X, Y: Integer);
939//kt added function 8/09
940//NOTE: I think this can be combined with NewRECDragDrop, but must fix MoveCaret
941begin
942 if (Source = tvTemplates) then begin
943 MoveHTMLCaret(X, Y);
944 InsertText;
945 end else if(assigned(FOldDragDrop)) then begin
946 FOldDragDrop(Sender, Source, X, Y);
947 end;
948end;
949
950procedure TfrmDrawers.NewRECHTMLDragOver(Sender, Source: TObject;
951 X, Y: Integer; State: TDragState;
952 var Accept: Boolean);
953//kt added function 8/09
954begin
955 Accept := FALSE;
956 if (Source = tvTemplates) then begin
957 if (assigned(FDragNode))
958 and (TTemplate(FDragNode.Data).RealType in [ttDoc, ttGroup]) then begin
959 Accept := TRUE;
960 MoveHTMLCaret(X, Y);
961 end;
962 end else if (assigned(FOldDragOver)) then begin
963 FOldDragOver(Sender, Source, X, Y, State, Accept);
964 end;
965end;
966
967procedure TfrmDrawers.InsertText;
968var
969 BeforeLine, AfterTop: integer;
970 txt, DocInfo: string;
971 Template: TTemplate;
972 TemplateIsHTML : boolean; //kt 8/09
973
974begin
975 DocInfo := '';
976 //kt if InsertOK(TRUE) and (dmodShared.TemplateOK(tvTemplates.Selected.Data)) then begin
977 if (dmodShared.TemplateOK(tvTemplates.Selected.Data)) then begin //kt
978 Template := TTemplate(tvTemplates.Selected.Data);
979 TemplateIsHTML := rHTMLTools.IsHTML(Template.Text); //kt
980 if not InsertOK(TRUE,TemplateIsHTML) then exit; //kt
981 Template.TemplatePreviewMode := FALSE;
982 if Template.IsReminderDialog then
983 Template.ExecuteReminderDialog(TForm(Owner))
984 else
985 begin
986 if Template.IsCOMObject then
987 txt := Template.COMObjectText('', DocInfo)
988 else
989 uTemplates.bUsingHTMLMode := HTMLEditActive; //kt 8/09 Will be used in TTemplate.GetText
990 txt := Template.Text;
991 if(txt <> '') then
992 begin
993// CheckBoilerplate4Fields(txt, 'Template: ' + Template.PrintName); <-- original line. //kt 7/15/2007
994 CheckBoilerplate4Fields(txt, DKLangConstW('fDrawers_Templatex') + Template.PrintName); //kt added 7/15/2007
995 if HTMLEditActive then begin //kt added block 8/09
996 //FHtmlEditControl.InsertTextAtCaret(txt);
997 FHtmlEditControl.SelText := txt;
998 FHtmlEditControl.SetFocus;
999 end else begin //kt original below 8/09
1000 BeforeLine := SendMessage(FRichEditControl.Handle, EM_EXLINEFROMCHAR, 0, FRichEditControl.SelStart);
1001 FRichEditControl.SelText := txt;
1002 FRichEditControl.SetFocus;
1003 SendMessage(FRichEditControl.Handle, EM_SCROLLCARET, 0, 0);
1004 AfterTop := SendMessage(FRichEditControl.Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
1005 SendMessage(FRichEditControl.Handle, EM_LINESCROLL, 0, -1 * (AfterTop - BeforeLine));
1006 end; //kt 8/09
1007 end;
1008 end;
1009 end;
1010end;
1011
1012procedure TfrmDrawers.popTemplatesPopup(Sender: TObject);
1013var
1014 Node: TTreeNode;
1015 ok, ok2, NodeFound: boolean;
1016 Def: string;
1017
1018begin
1019 ok := FALSE;
1020 ok2 := FALSE;
1021 if(FOpenDrawer = odTemplates) then
1022 begin
1023 Node := tvTemplates.Selected;
1024 tvTemplates.Selected := Node; // This line prevents selected from changing after menu closes
1025 NodeFound := (assigned(Node));
1026 if(NodeFound) then
1027 begin
1028 with TTemplate(Node.Data) do
1029 begin
1030 ok := (RealType in [ttDoc, ttGroup]);
1031 ok2 := ok and (not IsReminderDialog) and (not IsCOMObject);
1032 end;
1033 end;
1034 Def := Piece(GetUserTemplateDefaults, '/', FDefTempPiece);
1035 mnuGotoDefault.Enabled := (Def <> '');
1036 mnuViewNotes.Enabled := NodeFound and (TTemplate(Node.Data).Description <> '');
1037 mnuDefault.Enabled := NodeFound;
1038 mnuDefault.Checked := NodeFound and (tvTemplates.GetNodeID(TORTreeNode(Node), 1, ';') = Def);
1039 end
1040 else
1041 begin
1042 mnuDefault.Enabled := FALSE;
1043 mnuGotoDefault.Enabled := FALSE;
1044 mnuViewNotes.Enabled := FALSE;
1045 end;
1046 mnuPreviewTemplate.Enabled := ok2;
1047 mnuCopyTemplate.Enabled := ok2;
1048 mnuInsertTemplate.Enabled := ok and InsertOK(FALSE);
1049 mnuFindTemplates.Enabled := (FOpenDrawer = odTemplates);
1050 mnuCollapseTree.Enabled := ((FOpenDrawer = odTemplates) and
1051 (dmodShared.NeedsCollapsing(tvTemplates)));
1052 mnuEditTemplates.Enabled := (UserTemplateAccessLevel in [taAll, taEditor]);
1053 mnuNewTemplate.Enabled := (UserTemplateAccessLevel in [taAll, taEditor]);
1054end;
1055
1056procedure TfrmDrawers.mnuPreviewTemplateClick(Sender: TObject);
1057var
1058 tmpl: TTemplate;
1059 txt: String;
1060
1061begin
1062 if(assigned(tvTemplates.Selected)) then
1063 begin
1064// if(dmodShared.TemplateOK(tvTemplates.Selected.Data,'template preview')) then <-- original line. //kt 7/15/2007
1065 if(dmodShared.TemplateOK(tvTemplates.Selected.Data,DKLangConstW('fDrawers_template_preview'))) then //kt added 7/15/2007
1066 begin
1067 tmpl := TTemplate(tvTemplates.Selected.Data);
1068 tmpl.TemplatePreviewMode := TRUE; // Prevents "Are you sure?" dialog when canceling
1069 txt := tmpl.Text;
1070 if(not tmpl.DialogAborted) then
1071 ShowTemplateData(Self, tmpl.PrintName, txt);
1072 end;
1073 end;
1074end;
1075
1076procedure TfrmDrawers.FormDestroy(Sender: TObject);
1077begin
1078 TAccessibleTreeView.UnwrapControl(tvReminders);
1079 dmodShared.RemoveDrawerTree(Self);
1080 KillObj(@FRemNotifyList);
1081end;
1082
1083procedure TfrmDrawers.mnuCollapseTreeClick(Sender: TObject);
1084begin
1085 tvTemplates.Selected := nil;
1086 tvTemplates.FullCollapse;
1087end;
1088
1089procedure TfrmDrawers.ReloadTemplates;
1090begin
1091 LoadTemplateData;
1092 if(UserTemplateAccessLevel <> taNone) and (assigned(MyTemplate)) and
1093 (MyTemplate.Children in [tcActive, tcBoth]) then
1094 begin
1095 AddTemplateNode(MyTemplate);
1096 FHasPersonalTemplates := TRUE;
1097 end;
1098 AddTemplateNode(RootTemplate);
1099 OpenToNode;
1100end;
1101
1102procedure TfrmDrawers.btnFindClick(Sender: TObject);
1103var
1104 TmpNode: TTreeNode;
1105 Found: boolean;
1106 S1,S2: string;
1107
1108begin
1109 if(edtSearch.text <> '') then
1110 begin
1111 if(FEmptyNodeCount > 0) then
1112 begin
1113 FInternalExpand := TRUE;
1114 FInternalHiddenExpand := TRUE;
1115 try
1116 TmpNode := tvTemplates.Items.GetFirstNode;
1117 while(assigned(TmpNode)) do
1118 begin
1119 TmpNode.Expand(TRUE);
1120 TmpNode := TmpNode.GetNextSibling;
1121 end;
1122 finally
1123 FInternalExpand := FALSE;
1124 FInternalHiddenExpand := FALSE;
1125 end;
1126 end;
1127 if((FFindNext) and assigned (FLastFoundNode)) then
1128 TmpNode := FLastFoundNode.GetNext
1129 else
1130 TmpNode := tvTemplates.Items.GetFirstNode;
1131 Found := FALSE;
1132 if(assigned(TmpNode)) then
1133 begin
1134 S1 := edtSearch.Text;
1135 if(not cbMatchCase.Checked) then
1136 S1 := UpperCase(S1);
1137 while (assigned(TmpNode) and (not Found)) do
1138 begin
1139 S2 := TmpNode.Text;
1140 if(not cbMatchCase.Checked) then
1141 S2 := UpperCase(S2);
1142 Found := SearchMatch(S1, S2, cbWholeWords.Checked);
1143 if(not Found) then
1144 TmpNode := TmpNode.GetNext;
1145 end;
1146 end;
1147 if(Found) then
1148 begin
1149 FLastFoundNode := TmpNode;
1150 SetFindNext(TRUE);
1151 FInternalExpand := TRUE;
1152 try
1153 tvTemplates.Selected := TmpNode;
1154 finally
1155 FInternalExpand := FALSE;
1156 end;
1157 end
1158 else
1159 begin
1160 if(FFindNext) then
1161 S1 := ''
1162 else
1163// S1 := ' "' + edtSearch.Text + '" was not Found.'; <-- original line. //kt 7/15/2007
1164 S1 := ' "' + edtSearch.Text + '"' + DKLangConstW('fDrawers_was_not_Foundx'); //kt added 7/15/2007
1165 SetFindNext(FALSE);
1166// InfoBox('Search Complete.' + S1, 'Information', MB_OK or MB_ICONINFORMATION); <-- original line. //kt 7/15/2007
1167 InfoBox(DKLangConstW('fDrawers_Search_Completex') + S1, DKLangConstW('fDrawers_Information'), MB_OK or MB_ICONINFORMATION); //kt added 7/15/2007
1168 end;
1169 end;
1170 edtSearch.SetFocus;
1171end;
1172
1173procedure TfrmDrawers.SetFindNext(const Value: boolean);
1174begin
1175 if(FFindNext <> Value) then
1176 begin
1177 FFindNext := Value;
1178 if(FFindNext) then btnFind.Caption := FindNextText
1179// else btnFind.Caption := 'Find'; <-- original line. //kt 7/15/2007
1180 else btnFind.Caption := DKLangConstW('fDrawers_Find'); //kt added 7/15/2007
1181 end;
1182end;
1183
1184procedure TfrmDrawers.edtSearchChange(Sender: TObject);
1185begin
1186 btnFind.Enabled := (edtSearch.Text <> '');
1187 SetFindNext(FALSE);
1188end;
1189
1190procedure TfrmDrawers.ToggleMenuItem(Sender: TObject);
1191var
1192 TmpMI: TMenuItem;
1193
1194begin
1195 TmpMI := (Sender as TMenuItem);
1196 TmpMI.Checked := not TmpMI.Checked;
1197 SetFindNext(FALSE);
1198 if(pnlTemplateSearch.Visible) then edtSearch.SetFocus;
1199end;
1200
1201procedure TfrmDrawers.edtSearchEnter(Sender: TObject);
1202begin
1203 btnFind.Default := TRUE;
1204end;
1205
1206procedure TfrmDrawers.edtSearchExit(Sender: TObject);
1207begin
1208 btnFind.Default := FALSE;
1209end;
1210
1211procedure TfrmDrawers.mnuFindTemplatesClick(Sender: TObject);
1212var
1213 FindOn: boolean;
1214
1215begin
1216 mnuFindTemplates.Checked := not mnuFindTemplates.Checked;
1217 FindOn := mnuFindTemplates.Checked;
1218 pnlTemplateSearch.Visible := FindOn;
1219 if(FindOn) and (FOpenDrawer = odTemplates) then
1220 edtSearch.SetFocus;
1221end;
1222
1223procedure TfrmDrawers.tvTemplatesDragging(Sender: TObject; Node: TTreeNode;
1224 var CanDrag: Boolean);
1225
1226begin
1227 if(TTemplate(Node.Data).RealType in [ttDoc, ttGroup]) then
1228 begin
1229 FDragNode := Node;
1230 CanDrag := TRUE;
1231 end
1232 else
1233 begin
1234 FDragNode := nil;
1235 CanDrag := FALSE;
1236 end;
1237end;
1238
1239procedure TfrmDrawers.mnuEditTemplatesClick(Sender: TObject);
1240begin
1241 EditTemplates(Self);
1242end;
1243
1244procedure TfrmDrawers.mnuNewTemplateClick(Sender: TObject);
1245begin
1246 EditTemplates(Self, TRUE);
1247end;
1248
1249procedure TfrmDrawers.FormCreate(Sender: TObject);
1250begin
1251 dmodShared.AddDrawerTree(Self);
1252 FHasPersonalTemplates := FALSE;
1253 TAccessibleTreeView.WrapControl(tvReminders);
1254end;
1255
1256procedure TfrmDrawers.ExternalReloadTemplates;
1257begin
1258 if(FOpenToNode = '') and (assigned(tvTemplates.Selected)) then
1259 FOpenToNode := tvTemplates.GetNodeID(TORTreeNode(tvTemplates.Selected),1,';');
1260 tvTemplates.Items.Clear;
1261 FHasPersonalTemplates := FALSE;
1262 FEmptyNodeCount := 0;
1263 ReloadTemplates;
1264end;
1265
1266procedure TfrmDrawers.DisplayDrawers(Show: Boolean);
1267begin
1268 DisplayDrawers(Show, [], []);
1269end;
1270
1271procedure TfrmDrawers.DisplayDrawers(Show: Boolean; AEnable, ADisplay: TDrawers);
1272begin
1273 if(not (csLoading in ComponentState)) then
1274 begin
1275 if Show then
1276 begin
1277 EnableDrawers(AEnable);
1278 ShowDrawers(ADisplay);
1279 end
1280 else
1281 begin
1282 ShowDrawers([]);
1283 end;
1284 if(assigned(FSplitter)) then
1285 begin
1286 if(Show and (FOpenDrawer <> odNone)) then
1287 SetSplitterActive(TRUE)
1288 else
1289 SetSplitterActive(FALSE);
1290 end;
1291 end;
1292end;
1293
1294function TfrmDrawers.CanEditTemplates: boolean;
1295begin
1296 Result := (UserTemplateAccessLevel in [taAll, taEditor]);
1297end;
1298
1299function TfrmDrawers.CanEditShared: boolean;
1300begin
1301 Result := (UserTemplateAccessLevel = taEditor);
1302end;
1303
1304procedure TfrmDrawers.pnlTemplateSearchResize(Sender: TObject);
1305begin
1306 if((cbMatchCase.Width + cbWholeWords.Width) > pnlTemplateSearch.Width) then
1307 cbWholeWords.Left := cbMatchCase.Width
1308 else
1309 cbWholeWords.Left := pnlTemplateSearch.Width - cbWholeWords.Width;
1310end;
1311
1312procedure TfrmDrawers.cbFindOptionClick(Sender: TObject);
1313begin
1314 SetFindNext(FALSE);
1315 if(pnlTemplateSearch.Visible) then edtSearch.SetFocus;
1316end;
1317
1318procedure TfrmDrawers.mnuInsertTemplateClick(Sender: TObject);
1319begin
1320 if((assigned(tvTemplates.Selected)) and
1321 (TTemplate(tvTemplates.Selected.Data).RealType in [ttDoc, ttGroup])) then
1322 InsertText;
1323end;
1324
1325procedure TfrmDrawers.SetSplitter(const Value: TSplitter);
1326begin
1327 if(FSplitter <> Value) then
1328 begin
1329 if(assigned(FSplitter)) then
1330 FSplitter.OnCanResize := FOldCanResize;
1331 FSplitter := Value;
1332 if(assigned(FSplitter)) then
1333 begin
1334 FOldCanResize := FSplitter.OnCanResize;
1335 FSplitter.OnCanResize := SplitterCanResize;
1336 SetSplitterActive(FSplitterActive);
1337 end;
1338 end;
1339end;
1340
1341procedure TfrmDrawers.SplitterCanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean);
1342begin
1343 Accept := FSplitterActive;
1344end;
1345
1346procedure TfrmDrawers.SetSplitterActive(Active: boolean);
1347begin
1348 FSplitterActive := Active;
1349 if(Active) then
1350 begin
1351 FSplitter.Cursor := crVSplit;
1352 FSplitter.ResizeStyle := rsPattern;
1353 end
1354 else
1355 begin
1356 FSplitter.Cursor := crDefault;
1357 FSplitter.ResizeStyle := ExtCtrls.rsNone;
1358 end;
1359end;
1360
1361procedure TfrmDrawers.UpdatePersonalTemplates;
1362var
1363 NeedPersonal: boolean;
1364 Node: TTreeNode;
1365
1366 function FindNode: TTreeNode;
1367 begin
1368 Result := tvTemplates.Items.GetFirstNode;
1369 while assigned(Result) do
1370 begin
1371 if(Result.Data = MyTemplate) then exit;
1372 Result := Result.getNextSibling;
1373 end;
1374 end;
1375
1376begin
1377 NeedPersonal := (UserTemplateAccessLevel <> taNone);
1378 if(NeedPersonal <> FHasPersonalTemplates) then
1379 begin
1380 if(NeedPersonal) then
1381 begin
1382 if(assigned(MyTemplate)) and (MyTemplate.Children in [tcActive, tcBoth]) then
1383 begin
1384 AddTemplateNode(MyTemplate);
1385 FHasPersonalTemplates := TRUE;
1386 if(assigned(MyTemplate)) then
1387 begin
1388 Node := FindNode;
1389 if(assigned(Node)) then
1390 Node.MoveTo(nil, naAddFirst);
1391 end;
1392 end;
1393 end
1394 else
1395 begin
1396 if(assigned(MyTemplate)) then
1397 begin
1398 Node := FindNode;
1399 if(assigned(Node)) then Node.Delete;
1400 end;
1401 FHasPersonalTemplates := FALSE;
1402 end;
1403 end;
1404end;
1405
1406procedure TfrmDrawers.RemindersChanged(Sender: TObject);
1407begin
1408 inc(FHoldResize);
1409 try
1410 if(EnableDrawer(odReminders, (GetReminderStatus <> rsNone))) then
1411 begin
1412 BuildReminderTree(tvReminders);
1413 FOldMouseUp := tvReminders.OnMouseUp;
1414 end
1415 else
1416 begin
1417 FOldMouseUp := nil;
1418 tvReminders.PopupMenu := nil;
1419 end;
1420 tvReminders.OnMouseUp := tvRemindersMouseUp;
1421 finally
1422 dec(FHoldResize);
1423 end;
1424end;
1425
1426procedure TfrmDrawers.tvRemindersMouseUp(Sender: TObject;
1427 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1428begin
1429 if(Button = mbLeft) and (assigned(tvReminders.Selected)) and
1430 (htOnItem in tvReminders.GetHitTestInfoAt(X, Y)) then
1431 ViewReminderDialog(ReminderNode(tvReminders.Selected));
1432end;
1433
1434procedure TfrmDrawers.PositionToReminder(Sender: TObject);
1435var
1436 Rem: TReminder;
1437
1438begin
1439 if(assigned(Sender)) then
1440 begin
1441 if(Sender is TReminder) then
1442 begin
1443 Rem := TReminder(Sender);
1444 if(Rem.CurrentNodeID <> '') then
1445 tvReminders.Selected := tvReminders.FindPieceNode(Rem.CurrentNodeID, 1, IncludeParentID)
1446 else
1447 begin
1448 tvReminders.Selected := tvReminders.FindPieceNode(RemCode + (Sender as TReminder).IEN, 1);
1449 if(assigned(tvReminders.Selected)) then
1450 TORTreeNode(tvReminders.Selected).EnsureVisible;
1451 end;
1452 Rem.CurrentNodeID := '';
1453 end;
1454 end
1455 else
1456 tvReminders.Selected := nil;
1457end;
1458
1459procedure TfrmDrawers.tvRemindersCurListChanged(Sender: TObject;
1460 Node: TTreeNode);
1461begin
1462 if(assigned(FRemNotifyList)) then
1463 FRemNotifyList.Notify(Node);
1464end;
1465
1466procedure TfrmDrawers.NotifyWhenRemTreeChanges(Proc: TNotifyEvent);
1467begin
1468 if(not assigned(FRemNotifyList)) then
1469 FRemNotifyList := TORNotifyList.Create;
1470 FRemNotifyList.Add(Proc);
1471end;
1472
1473procedure TfrmDrawers.RemoveNotifyWhenRemTreeChanges(Proc: TNotifyEvent);
1474begin
1475 if(assigned(FRemNotifyList)) then
1476 FRemNotifyList.Remove(Proc);
1477end;
1478
1479function TfrmDrawers.GetAlign: TAlign;
1480begin
1481 Result := inherited Align;
1482end;
1483
1484procedure TfrmDrawers.SetAlign(const Value: TAlign);
1485begin
1486 inherited Align := Value;
1487 ResizeToVisible;
1488end;
1489
1490procedure TfrmDrawers.ResetTemplates;
1491begin
1492 FOpenToNode := Piece(GetUserTemplateDefaults, '/', FDefTempPiece);
1493end;
1494
1495procedure TfrmDrawers.mnuDefaultClick(Sender: TObject);
1496var
1497 NodeID: string;
1498 UserTempDefNode: string;
1499begin
1500 NodeID := tvTemplates.GetNodeID(TORTreeNode(tvTemplates.Selected), 1, ';');
1501 UserTempDefNode := Piece(GetUserTemplateDefaults, '/', FDefTempPiece);
1502 if NodeID <> UserTempDefNode then
1503 SetUserTemplateDefaults(tvTemplates.GetNodeID(TORTreeNode(tvTemplates.Selected), 1, ';'),
1504 FDefTempPiece)
1505 else SetUserTemplateDefaults('', FDefTempPiece);
1506end;
1507
1508procedure TfrmDrawers.OpenToNode(Path: string = '');
1509var
1510 OldInternalHE, OldInternalEX: boolean;
1511
1512begin
1513 if(Path <> '') then
1514 FOpenToNode := PATH;
1515 if(FOpenToNode <> '') then
1516 begin
1517 OldInternalHE := FInternalHiddenExpand;
1518 OldInternalEX := FInternalExpand;
1519 try
1520 FInternalExpand := TRUE;
1521 FInternalHiddenExpand := FALSE;
1522 dmodShared.SelectNode(tvTemplates, FOpenToNode, FEmptyNodeCount);
1523 finally
1524 FInternalHiddenExpand := OldInternalHE;
1525 FInternalExpand := OldInternalEX;
1526 end;
1527 FOpenToNode := '';
1528 end;
1529end;
1530
1531procedure TfrmDrawers.mnuGotoDefaultClick(Sender: TObject);
1532begin
1533 OpenToNode(Piece(GetUserTemplateDefaults, '/', FDefTempPiece));
1534end;
1535
1536procedure TfrmDrawers.mnuViewNotesClick(Sender: TObject);
1537var
1538 tmpl: TTemplate;
1539 tmpSL: TStringList;
1540
1541begin
1542 if(assigned(tvTemplates.Selected)) then
1543 begin
1544 tmpl := TTemplate(tvTemplates.Selected.Data);
1545 if(tmpl.Description = '') then
1546// ShowMessage('No notes found for ' + tmpl.PrintName) <-- original line. //kt 7/15/2007
1547 ShowMessage(DKLangConstW('fDrawers_No_notes_found_for') + tmpl.PrintName) //kt added 7/15/2007
1548 else
1549 begin
1550 tmpSL := TStringList.Create;
1551 try
1552 tmpSL.Text := tmpl.Description;
1553// ReportBox(tmpSL, tmpl.PrintName + ' Notes:', TRUE); <-- original line. //kt 7/15/2007
1554 ReportBox(tmpSL, tmpl.PrintName + DKLangConstW('fDrawers_Notesx'), TRUE); //kt added 7/15/2007
1555 finally
1556 tmpSL.Free;
1557 end;
1558 end;
1559 end;
1560end;
1561
1562procedure TfrmDrawers.mnuCopyTemplateClick(Sender: TObject);
1563var
1564 txt: string;
1565 Template: TTemplate;
1566
1567begin
1568 txt := '';
1569 if((assigned(tvTemplates.Selected)) and
1570 (TTemplate(tvTemplates.Selected.Data).RealType in [ttDoc, ttGroup])) and
1571 (dmodShared.TemplateOK(tvTemplates.Selected.Data)) then
1572 begin
1573 Template := TTemplate(tvTemplates.Selected.Data);
1574 txt := Template.Text;
1575// CheckBoilerplate4Fields(txt, 'Template: ' + Template.PrintName); <-- original line. //kt 7/15/2007
1576 CheckBoilerplate4Fields(txt, DKLangConstW('fDrawers_Templatex') + Template.PrintName); //kt added 7/15/2007
1577 if txt <> '' then
1578 Clipboard.SetTextBuf(PChar(txt));
1579 end;
1580 if txt <> '' then
1581// StatusText('Templated Text copied to clipboard.'); <-- original line. //kt 7/15/2007
1582 StatusText(DKLangConstW('fDrawers_Templated_Text_copied_to_clipboardx')); //kt added 7/15/2007
1583end;
1584
1585
1586//kt 8/09 function TfrmDrawers.InsertOK(Ask: boolean): boolean;
1587function TfrmDrawers.InsertOK(Ask: boolean; TemplateIsHTML : boolean): boolean; //kt 8/09
1588
1589 function EditControlOK: boolean; //kt 8/09 renamed. Was REOK
1590 begin
1591 if HTMLEditActive then begin //kt added this part 8/09
1592 Result := assigned(FHtmlEditControl) and
1593 FHtmlEditControl.Visible and
1594 TWinControl(FHtmlEditControl).Parent.Visible;
1595 end else begin //kt original below.
1596 Result := assigned(FRichEditControl) and
1597 FRichEditControl.Visible and
1598 FRichEditControl.Parent.Visible and
1599 FRichEditControl.Parent.Parent.Visible; //kt added last line
1600 end;
1601 end;
1602
1603begin
1604 Result := EditControlOK; //kt renamed function.
1605 if (not ask) and (not Result) and (assigned(FNewNoteButton)) then
1606 Result := TRUE
1607 else
1608 if ask and (not Result) and assigned(FNewNoteButton) and
1609 FNewNoteButton.Visible and FNewNoteButton.Enabled then
1610 begin
1611 FNewNoteButton.Click;
1612 if TemplateIsHTML and Assigned(FHtmlModeSwitcher) then begin //kt 8/09
1613 FHtmlModeSwitcher(TemplateIsHTML, true); //kt 8/09
1614 FHtmlEditControl.MoveCaretToEnd; //kt 8/09
1615 end; //kt 8/09
1616 Result := EditControlOK; //kt 8/09 Renamed function.
1617 end;
1618end;
1619
1620procedure TfrmDrawers.mnuViewTemplateIconLegendClick(Sender: TObject);
1621begin
1622 ShowIconLegend(ilTemplates);
1623end;
1624
1625procedure TfrmDrawers.pnlTemplatesButtonEnter(Sender: TObject);
1626begin
1627 with Sender as TPanel do
1628 if (ControlCount > 0) and (Controls[0] is TSpeedButton) and (TSpeedButton(Controls[0]).Down)
1629 then
1630 BevelOuter := bvLowered
1631 else
1632 BevelOuter := bvRaised;
1633end;
1634
1635procedure TfrmDrawers.pnlTemplatesButtonExit(Sender: TObject);
1636begin
1637 with Sender as TPanel do
1638 BevelOuter := bvNone;
1639 DisableArrowKeyMove(Sender);
1640end;
1641
1642procedure TfrmDrawers.tvRemindersKeyDown(Sender: TObject; var Key: Word;
1643 Shift: TShiftState);
1644begin
1645 case Key of
1646 VK_RETURN, VK_SPACE:
1647 begin
1648 ViewReminderDialog(ReminderNode(tvReminders.Selected));
1649 Key := 0;
1650 end;
1651 end;
1652end;
1653
1654procedure TfrmDrawers.tvRemindersNodeCaptioning(Sender: TObject;
1655 var Caption: String);
1656var
1657 StringData: string;
1658begin
1659 StringData := (Sender as TORTreeNode).StringData;
1660 if (Length(StringData) > 0) and (StringData[1] = 'R') then //Only tag reminder statuses
1661 case StrToIntDef(Piece(StringData,'^',6 {Due}),-1) of
1662// 0: Caption := Caption + ' -- Applicable'; <-- original line. //kt 7/15/2007
1663 0: Caption := Caption + DKLangConstW('fDrawers_xx_Applicable'); //kt added 7/15/2007
1664// 1: Caption := Caption + ' -- DUE'; <-- original line. //kt 7/15/2007
1665 1: Caption := Caption + DKLangConstW('fDrawers_xx_DUE'); //kt added 7/15/2007
1666// 2: Caption := Caption + ' -- Not Applicable'; <-- original line. //kt 7/15/2007
1667 2: Caption := Caption + DKLangConstW('fDrawers_xx_Not_Applicable'); //kt added 7/15/2007
1668// else Caption := Caption + ' -- Not Evaluated'; <-- original line. //kt 7/15/2007
1669 else Caption := Caption + DKLangConstW('fDrawers_xx_Not_Evaluated'); //kt added 7/15/2007
1670 end;
1671end;
1672
1673procedure TfrmDrawers.tvRemindersAddition(Sender: TObject;
1674 Node: TTreeNode);
1675begin
1676 TAccessibleTreeNode.WrapControl(Node as TORTreeNode);
1677end;
1678
1679procedure TfrmDrawers.tvRemindersDeletion(Sender: TObject;
1680 Node: TTreeNode);
1681begin
1682 TAccessibleTreeNode.UnwrapControl(Node as TORTreeNode);
1683end;
1684
1685procedure TfrmDrawers.DisableArrowKeyMove(Sender: TObject);
1686var
1687 CurrPanel : TKeyClickPanel;
1688begin
1689 if Sender is TKeyClickPanel then
1690 begin
1691 CurrPanel := Sender as TKeyClickPanel;
1692 If Boolean(Hi(GetKeyState(VK_UP)))
1693 OR Boolean(Hi(GetKeyState(VK_DOWN)))
1694 OR Boolean(Hi(GetKeyState(VK_LEFT)))
1695 OR Boolean(Hi(GetKeyState(VK_RIGHT))) then
1696 begin
1697 if Assigned(CurrPanel) then
1698 CurrPanel.SetFocus;
1699 end;
1700 end;
1701end;
1702
1703end.
1704
Note: See TracBrowser for help on using the repository browser.