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

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

Added HTML templating

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 Template.TemplatePreviewMode := FALSE;
980 if Template.IsReminderDialog then begin
981 Template.ExecuteReminderDialog(TForm(Owner))
982 end else begin
983 if Template.IsCOMObject then
984 txt := Template.COMObjectText('', DocInfo)
985 else begin
986 uTemplates.bUsingHTMLMode := HTMLEditActive; //kt 8/09 Will be used in TTemplate.GetText
987 txt := Template.Text;
988 TemplateIsHTML := rHTMLTools.IsHTML(txt); //kt
989 if not InsertOK(FALSE,TemplateIsHTML) then exit; //kt
990 end;
991 if(txt <> '') then begin
992// CheckBoilerplate4Fields(txt, 'Template: ' + Template.PrintName); <-- original line. //kt 7/15/2007
993 CheckBoilerplate4Fields(txt, DKLangConstW('fDrawers_Templatex') + Template.PrintName); //kt added 7/15/2007
994 if HTMLEditActive then begin //kt added block 8/09
995 //FHtmlEditControl.InsertTextAtCaret(txt);
996 FHtmlEditControl.SelText := txt;
997 FHtmlEditControl.SetFocus;
998 end else begin //kt original below 8/09
999 BeforeLine := SendMessage(FRichEditControl.Handle, EM_EXLINEFROMCHAR, 0, FRichEditControl.SelStart);
1000 FRichEditControl.SelText := txt;
1001 FRichEditControl.SetFocus;
1002 SendMessage(FRichEditControl.Handle, EM_SCROLLCARET, 0, 0);
1003 AfterTop := SendMessage(FRichEditControl.Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
1004 SendMessage(FRichEditControl.Handle, EM_LINESCROLL, 0, -1 * (AfterTop - BeforeLine));
1005 end; //kt 8/09
1006 end;
1007 end;
1008 end;
1009end;
1010
1011procedure TfrmDrawers.popTemplatesPopup(Sender: TObject);
1012var
1013 Node: TTreeNode;
1014 ok, ok2, NodeFound: boolean;
1015 Def: string;
1016
1017begin
1018 ok := FALSE;
1019 ok2 := FALSE;
1020 if(FOpenDrawer = odTemplates) then
1021 begin
1022 Node := tvTemplates.Selected;
1023 tvTemplates.Selected := Node; // This line prevents selected from changing after menu closes
1024 NodeFound := (assigned(Node));
1025 if(NodeFound) then
1026 begin
1027 with TTemplate(Node.Data) do
1028 begin
1029 ok := (RealType in [ttDoc, ttGroup]);
1030 ok2 := ok and (not IsReminderDialog) and (not IsCOMObject);
1031 end;
1032 end;
1033 Def := Piece(GetUserTemplateDefaults, '/', FDefTempPiece);
1034 mnuGotoDefault.Enabled := (Def <> '');
1035 mnuViewNotes.Enabled := NodeFound and (TTemplate(Node.Data).Description <> '');
1036 mnuDefault.Enabled := NodeFound;
1037 mnuDefault.Checked := NodeFound and (tvTemplates.GetNodeID(TORTreeNode(Node), 1, ';') = Def);
1038 end
1039 else
1040 begin
1041 mnuDefault.Enabled := FALSE;
1042 mnuGotoDefault.Enabled := FALSE;
1043 mnuViewNotes.Enabled := FALSE;
1044 end;
1045 mnuPreviewTemplate.Enabled := ok2;
1046 mnuCopyTemplate.Enabled := ok2;
1047 mnuInsertTemplate.Enabled := ok and InsertOK(FALSE);
1048 mnuFindTemplates.Enabled := (FOpenDrawer = odTemplates);
1049 mnuCollapseTree.Enabled := ((FOpenDrawer = odTemplates) and
1050 (dmodShared.NeedsCollapsing(tvTemplates)));
1051 mnuEditTemplates.Enabled := (UserTemplateAccessLevel in [taAll, taEditor]);
1052 mnuNewTemplate.Enabled := (UserTemplateAccessLevel in [taAll, taEditor]);
1053end;
1054
1055procedure TfrmDrawers.mnuPreviewTemplateClick(Sender: TObject);
1056var
1057 tmpl: TTemplate;
1058 txt: String;
1059
1060begin
1061 if(assigned(tvTemplates.Selected)) then
1062 begin
1063// if(dmodShared.TemplateOK(tvTemplates.Selected.Data,'template preview')) then <-- original line. //kt 7/15/2007
1064 if(dmodShared.TemplateOK(tvTemplates.Selected.Data,DKLangConstW('fDrawers_template_preview'))) then //kt added 7/15/2007
1065 begin
1066 tmpl := TTemplate(tvTemplates.Selected.Data);
1067 tmpl.TemplatePreviewMode := TRUE; // Prevents "Are you sure?" dialog when canceling
1068 txt := tmpl.Text;
1069 if(not tmpl.DialogAborted) then
1070 ShowTemplateData(Self, tmpl.PrintName, txt);
1071 end;
1072 end;
1073end;
1074
1075procedure TfrmDrawers.FormDestroy(Sender: TObject);
1076begin
1077 TAccessibleTreeView.UnwrapControl(tvReminders);
1078 dmodShared.RemoveDrawerTree(Self);
1079 KillObj(@FRemNotifyList);
1080end;
1081
1082procedure TfrmDrawers.mnuCollapseTreeClick(Sender: TObject);
1083begin
1084 tvTemplates.Selected := nil;
1085 tvTemplates.FullCollapse;
1086end;
1087
1088procedure TfrmDrawers.ReloadTemplates;
1089begin
1090 LoadTemplateData;
1091 if(UserTemplateAccessLevel <> taNone) and (assigned(MyTemplate)) and
1092 (MyTemplate.Children in [tcActive, tcBoth]) then
1093 begin
1094 AddTemplateNode(MyTemplate);
1095 FHasPersonalTemplates := TRUE;
1096 end;
1097 AddTemplateNode(RootTemplate);
1098 OpenToNode;
1099end;
1100
1101procedure TfrmDrawers.btnFindClick(Sender: TObject);
1102var
1103 TmpNode: TTreeNode;
1104 Found: boolean;
1105 S1,S2: string;
1106
1107begin
1108 if(edtSearch.text <> '') then
1109 begin
1110 if(FEmptyNodeCount > 0) then
1111 begin
1112 FInternalExpand := TRUE;
1113 FInternalHiddenExpand := TRUE;
1114 try
1115 TmpNode := tvTemplates.Items.GetFirstNode;
1116 while(assigned(TmpNode)) do
1117 begin
1118 TmpNode.Expand(TRUE);
1119 TmpNode := TmpNode.GetNextSibling;
1120 end;
1121 finally
1122 FInternalExpand := FALSE;
1123 FInternalHiddenExpand := FALSE;
1124 end;
1125 end;
1126 if((FFindNext) and assigned (FLastFoundNode)) then
1127 TmpNode := FLastFoundNode.GetNext
1128 else
1129 TmpNode := tvTemplates.Items.GetFirstNode;
1130 Found := FALSE;
1131 if(assigned(TmpNode)) then
1132 begin
1133 S1 := edtSearch.Text;
1134 if(not cbMatchCase.Checked) then
1135 S1 := UpperCase(S1);
1136 while (assigned(TmpNode) and (not Found)) do
1137 begin
1138 S2 := TmpNode.Text;
1139 if(not cbMatchCase.Checked) then
1140 S2 := UpperCase(S2);
1141 Found := SearchMatch(S1, S2, cbWholeWords.Checked);
1142 if(not Found) then
1143 TmpNode := TmpNode.GetNext;
1144 end;
1145 end;
1146 if(Found) then
1147 begin
1148 FLastFoundNode := TmpNode;
1149 SetFindNext(TRUE);
1150 FInternalExpand := TRUE;
1151 try
1152 tvTemplates.Selected := TmpNode;
1153 finally
1154 FInternalExpand := FALSE;
1155 end;
1156 end
1157 else
1158 begin
1159 if(FFindNext) then
1160 S1 := ''
1161 else
1162// S1 := ' "' + edtSearch.Text + '" was not Found.'; <-- original line. //kt 7/15/2007
1163 S1 := ' "' + edtSearch.Text + '"' + DKLangConstW('fDrawers_was_not_Foundx'); //kt added 7/15/2007
1164 SetFindNext(FALSE);
1165// InfoBox('Search Complete.' + S1, 'Information', MB_OK or MB_ICONINFORMATION); <-- original line. //kt 7/15/2007
1166 InfoBox(DKLangConstW('fDrawers_Search_Completex') + S1, DKLangConstW('fDrawers_Information'), MB_OK or MB_ICONINFORMATION); //kt added 7/15/2007
1167 end;
1168 end;
1169 edtSearch.SetFocus;
1170end;
1171
1172procedure TfrmDrawers.SetFindNext(const Value: boolean);
1173begin
1174 if(FFindNext <> Value) then
1175 begin
1176 FFindNext := Value;
1177 if(FFindNext) then btnFind.Caption := FindNextText
1178// else btnFind.Caption := 'Find'; <-- original line. //kt 7/15/2007
1179 else btnFind.Caption := DKLangConstW('fDrawers_Find'); //kt added 7/15/2007
1180 end;
1181end;
1182
1183procedure TfrmDrawers.edtSearchChange(Sender: TObject);
1184begin
1185 btnFind.Enabled := (edtSearch.Text <> '');
1186 SetFindNext(FALSE);
1187end;
1188
1189procedure TfrmDrawers.ToggleMenuItem(Sender: TObject);
1190var
1191 TmpMI: TMenuItem;
1192
1193begin
1194 TmpMI := (Sender as TMenuItem);
1195 TmpMI.Checked := not TmpMI.Checked;
1196 SetFindNext(FALSE);
1197 if(pnlTemplateSearch.Visible) then edtSearch.SetFocus;
1198end;
1199
1200procedure TfrmDrawers.edtSearchEnter(Sender: TObject);
1201begin
1202 btnFind.Default := TRUE;
1203end;
1204
1205procedure TfrmDrawers.edtSearchExit(Sender: TObject);
1206begin
1207 btnFind.Default := FALSE;
1208end;
1209
1210procedure TfrmDrawers.mnuFindTemplatesClick(Sender: TObject);
1211var
1212 FindOn: boolean;
1213
1214begin
1215 mnuFindTemplates.Checked := not mnuFindTemplates.Checked;
1216 FindOn := mnuFindTemplates.Checked;
1217 pnlTemplateSearch.Visible := FindOn;
1218 if(FindOn) and (FOpenDrawer = odTemplates) then
1219 edtSearch.SetFocus;
1220end;
1221
1222procedure TfrmDrawers.tvTemplatesDragging(Sender: TObject; Node: TTreeNode;
1223 var CanDrag: Boolean);
1224
1225begin
1226 if(TTemplate(Node.Data).RealType in [ttDoc, ttGroup]) then
1227 begin
1228 FDragNode := Node;
1229 CanDrag := TRUE;
1230 end
1231 else
1232 begin
1233 FDragNode := nil;
1234 CanDrag := FALSE;
1235 end;
1236end;
1237
1238procedure TfrmDrawers.mnuEditTemplatesClick(Sender: TObject);
1239begin
1240 EditTemplates(Self);
1241end;
1242
1243procedure TfrmDrawers.mnuNewTemplateClick(Sender: TObject);
1244begin
1245 EditTemplates(Self, TRUE);
1246end;
1247
1248procedure TfrmDrawers.FormCreate(Sender: TObject);
1249begin
1250 dmodShared.AddDrawerTree(Self);
1251 FHasPersonalTemplates := FALSE;
1252 TAccessibleTreeView.WrapControl(tvReminders);
1253end;
1254
1255procedure TfrmDrawers.ExternalReloadTemplates;
1256begin
1257 if(FOpenToNode = '') and (assigned(tvTemplates.Selected)) then
1258 FOpenToNode := tvTemplates.GetNodeID(TORTreeNode(tvTemplates.Selected),1,';');
1259 tvTemplates.Items.Clear;
1260 FHasPersonalTemplates := FALSE;
1261 FEmptyNodeCount := 0;
1262 ReloadTemplates;
1263end;
1264
1265procedure TfrmDrawers.DisplayDrawers(Show: Boolean);
1266begin
1267 DisplayDrawers(Show, [], []);
1268end;
1269
1270procedure TfrmDrawers.DisplayDrawers(Show: Boolean; AEnable, ADisplay: TDrawers);
1271begin
1272 if(not (csLoading in ComponentState)) then
1273 begin
1274 if Show then
1275 begin
1276 EnableDrawers(AEnable);
1277 ShowDrawers(ADisplay);
1278 end
1279 else
1280 begin
1281 ShowDrawers([]);
1282 end;
1283 if(assigned(FSplitter)) then
1284 begin
1285 if(Show and (FOpenDrawer <> odNone)) then
1286 SetSplitterActive(TRUE)
1287 else
1288 SetSplitterActive(FALSE);
1289 end;
1290 end;
1291end;
1292
1293function TfrmDrawers.CanEditTemplates: boolean;
1294begin
1295 Result := (UserTemplateAccessLevel in [taAll, taEditor]);
1296end;
1297
1298function TfrmDrawers.CanEditShared: boolean;
1299begin
1300 Result := (UserTemplateAccessLevel = taEditor);
1301end;
1302
1303procedure TfrmDrawers.pnlTemplateSearchResize(Sender: TObject);
1304begin
1305 if((cbMatchCase.Width + cbWholeWords.Width) > pnlTemplateSearch.Width) then
1306 cbWholeWords.Left := cbMatchCase.Width
1307 else
1308 cbWholeWords.Left := pnlTemplateSearch.Width - cbWholeWords.Width;
1309end;
1310
1311procedure TfrmDrawers.cbFindOptionClick(Sender: TObject);
1312begin
1313 SetFindNext(FALSE);
1314 if(pnlTemplateSearch.Visible) then edtSearch.SetFocus;
1315end;
1316
1317procedure TfrmDrawers.mnuInsertTemplateClick(Sender: TObject);
1318begin
1319 if((assigned(tvTemplates.Selected)) and
1320 (TTemplate(tvTemplates.Selected.Data).RealType in [ttDoc, ttGroup])) then
1321 InsertText;
1322end;
1323
1324procedure TfrmDrawers.SetSplitter(const Value: TSplitter);
1325begin
1326 if(FSplitter <> Value) then
1327 begin
1328 if(assigned(FSplitter)) then
1329 FSplitter.OnCanResize := FOldCanResize;
1330 FSplitter := Value;
1331 if(assigned(FSplitter)) then
1332 begin
1333 FOldCanResize := FSplitter.OnCanResize;
1334 FSplitter.OnCanResize := SplitterCanResize;
1335 SetSplitterActive(FSplitterActive);
1336 end;
1337 end;
1338end;
1339
1340procedure TfrmDrawers.SplitterCanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean);
1341begin
1342 Accept := FSplitterActive;
1343end;
1344
1345procedure TfrmDrawers.SetSplitterActive(Active: boolean);
1346begin
1347 FSplitterActive := Active;
1348 if(Active) then
1349 begin
1350 FSplitter.Cursor := crVSplit;
1351 FSplitter.ResizeStyle := rsPattern;
1352 end
1353 else
1354 begin
1355 FSplitter.Cursor := crDefault;
1356 FSplitter.ResizeStyle := ExtCtrls.rsNone;
1357 end;
1358end;
1359
1360procedure TfrmDrawers.UpdatePersonalTemplates;
1361var
1362 NeedPersonal: boolean;
1363 Node: TTreeNode;
1364
1365 function FindNode: TTreeNode;
1366 begin
1367 Result := tvTemplates.Items.GetFirstNode;
1368 while assigned(Result) do
1369 begin
1370 if(Result.Data = MyTemplate) then exit;
1371 Result := Result.getNextSibling;
1372 end;
1373 end;
1374
1375begin
1376 NeedPersonal := (UserTemplateAccessLevel <> taNone);
1377 if(NeedPersonal <> FHasPersonalTemplates) then
1378 begin
1379 if(NeedPersonal) then
1380 begin
1381 if(assigned(MyTemplate)) and (MyTemplate.Children in [tcActive, tcBoth]) then
1382 begin
1383 AddTemplateNode(MyTemplate);
1384 FHasPersonalTemplates := TRUE;
1385 if(assigned(MyTemplate)) then
1386 begin
1387 Node := FindNode;
1388 if(assigned(Node)) then
1389 Node.MoveTo(nil, naAddFirst);
1390 end;
1391 end;
1392 end
1393 else
1394 begin
1395 if(assigned(MyTemplate)) then
1396 begin
1397 Node := FindNode;
1398 if(assigned(Node)) then Node.Delete;
1399 end;
1400 FHasPersonalTemplates := FALSE;
1401 end;
1402 end;
1403end;
1404
1405procedure TfrmDrawers.RemindersChanged(Sender: TObject);
1406begin
1407 inc(FHoldResize);
1408 try
1409 if(EnableDrawer(odReminders, (GetReminderStatus <> rsNone))) then
1410 begin
1411 BuildReminderTree(tvReminders);
1412 FOldMouseUp := tvReminders.OnMouseUp;
1413 end
1414 else
1415 begin
1416 FOldMouseUp := nil;
1417 tvReminders.PopupMenu := nil;
1418 end;
1419 tvReminders.OnMouseUp := tvRemindersMouseUp;
1420 finally
1421 dec(FHoldResize);
1422 end;
1423end;
1424
1425procedure TfrmDrawers.tvRemindersMouseUp(Sender: TObject;
1426 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1427begin
1428 if(Button = mbLeft) and (assigned(tvReminders.Selected)) and
1429 (htOnItem in tvReminders.GetHitTestInfoAt(X, Y)) then
1430 ViewReminderDialog(ReminderNode(tvReminders.Selected));
1431end;
1432
1433procedure TfrmDrawers.PositionToReminder(Sender: TObject);
1434var
1435 Rem: TReminder;
1436
1437begin
1438 if(assigned(Sender)) then
1439 begin
1440 if(Sender is TReminder) then
1441 begin
1442 Rem := TReminder(Sender);
1443 if(Rem.CurrentNodeID <> '') then
1444 tvReminders.Selected := tvReminders.FindPieceNode(Rem.CurrentNodeID, 1, IncludeParentID)
1445 else
1446 begin
1447 tvReminders.Selected := tvReminders.FindPieceNode(RemCode + (Sender as TReminder).IEN, 1);
1448 if(assigned(tvReminders.Selected)) then
1449 TORTreeNode(tvReminders.Selected).EnsureVisible;
1450 end;
1451 Rem.CurrentNodeID := '';
1452 end;
1453 end
1454 else
1455 tvReminders.Selected := nil;
1456end;
1457
1458procedure TfrmDrawers.tvRemindersCurListChanged(Sender: TObject;
1459 Node: TTreeNode);
1460begin
1461 if(assigned(FRemNotifyList)) then
1462 FRemNotifyList.Notify(Node);
1463end;
1464
1465procedure TfrmDrawers.NotifyWhenRemTreeChanges(Proc: TNotifyEvent);
1466begin
1467 if(not assigned(FRemNotifyList)) then
1468 FRemNotifyList := TORNotifyList.Create;
1469 FRemNotifyList.Add(Proc);
1470end;
1471
1472procedure TfrmDrawers.RemoveNotifyWhenRemTreeChanges(Proc: TNotifyEvent);
1473begin
1474 if(assigned(FRemNotifyList)) then
1475 FRemNotifyList.Remove(Proc);
1476end;
1477
1478function TfrmDrawers.GetAlign: TAlign;
1479begin
1480 Result := inherited Align;
1481end;
1482
1483procedure TfrmDrawers.SetAlign(const Value: TAlign);
1484begin
1485 inherited Align := Value;
1486 ResizeToVisible;
1487end;
1488
1489procedure TfrmDrawers.ResetTemplates;
1490begin
1491 FOpenToNode := Piece(GetUserTemplateDefaults, '/', FDefTempPiece);
1492end;
1493
1494procedure TfrmDrawers.mnuDefaultClick(Sender: TObject);
1495var
1496 NodeID: string;
1497 UserTempDefNode: string;
1498begin
1499 NodeID := tvTemplates.GetNodeID(TORTreeNode(tvTemplates.Selected), 1, ';');
1500 UserTempDefNode := Piece(GetUserTemplateDefaults, '/', FDefTempPiece);
1501 if NodeID <> UserTempDefNode then
1502 SetUserTemplateDefaults(tvTemplates.GetNodeID(TORTreeNode(tvTemplates.Selected), 1, ';'),
1503 FDefTempPiece)
1504 else SetUserTemplateDefaults('', FDefTempPiece);
1505end;
1506
1507procedure TfrmDrawers.OpenToNode(Path: string = '');
1508var
1509 OldInternalHE, OldInternalEX: boolean;
1510
1511begin
1512 if(Path <> '') then
1513 FOpenToNode := PATH;
1514 if(FOpenToNode <> '') then
1515 begin
1516 OldInternalHE := FInternalHiddenExpand;
1517 OldInternalEX := FInternalExpand;
1518 try
1519 FInternalExpand := TRUE;
1520 FInternalHiddenExpand := FALSE;
1521 dmodShared.SelectNode(tvTemplates, FOpenToNode, FEmptyNodeCount);
1522 finally
1523 FInternalHiddenExpand := OldInternalHE;
1524 FInternalExpand := OldInternalEX;
1525 end;
1526 FOpenToNode := '';
1527 end;
1528end;
1529
1530procedure TfrmDrawers.mnuGotoDefaultClick(Sender: TObject);
1531begin
1532 OpenToNode(Piece(GetUserTemplateDefaults, '/', FDefTempPiece));
1533end;
1534
1535procedure TfrmDrawers.mnuViewNotesClick(Sender: TObject);
1536var
1537 tmpl: TTemplate;
1538 tmpSL: TStringList;
1539
1540begin
1541 if(assigned(tvTemplates.Selected)) then
1542 begin
1543 tmpl := TTemplate(tvTemplates.Selected.Data);
1544 if(tmpl.Description = '') then
1545// ShowMessage('No notes found for ' + tmpl.PrintName) <-- original line. //kt 7/15/2007
1546 ShowMessage(DKLangConstW('fDrawers_No_notes_found_for') + tmpl.PrintName) //kt added 7/15/2007
1547 else
1548 begin
1549 tmpSL := TStringList.Create;
1550 try
1551 tmpSL.Text := tmpl.Description;
1552// ReportBox(tmpSL, tmpl.PrintName + ' Notes:', TRUE); <-- original line. //kt 7/15/2007
1553 ReportBox(tmpSL, tmpl.PrintName + DKLangConstW('fDrawers_Notesx'), TRUE); //kt added 7/15/2007
1554 finally
1555 tmpSL.Free;
1556 end;
1557 end;
1558 end;
1559end;
1560
1561procedure TfrmDrawers.mnuCopyTemplateClick(Sender: TObject);
1562var
1563 txt: string;
1564 Template: TTemplate;
1565
1566begin
1567 txt := '';
1568 if((assigned(tvTemplates.Selected)) and
1569 (TTemplate(tvTemplates.Selected.Data).RealType in [ttDoc, ttGroup])) and
1570 (dmodShared.TemplateOK(tvTemplates.Selected.Data)) then
1571 begin
1572 Template := TTemplate(tvTemplates.Selected.Data);
1573 txt := Template.Text;
1574// CheckBoilerplate4Fields(txt, 'Template: ' + Template.PrintName); <-- original line. //kt 7/15/2007
1575 CheckBoilerplate4Fields(txt, DKLangConstW('fDrawers_Templatex') + Template.PrintName); //kt added 7/15/2007
1576 if txt <> '' then
1577 Clipboard.SetTextBuf(PChar(txt));
1578 end;
1579 if txt <> '' then
1580// StatusText('Templated Text copied to clipboard.'); <-- original line. //kt 7/15/2007
1581 StatusText(DKLangConstW('fDrawers_Templated_Text_copied_to_clipboardx')); //kt added 7/15/2007
1582end;
1583
1584
1585//kt 8/09 function TfrmDrawers.InsertOK(Ask: boolean): boolean;
1586function TfrmDrawers.InsertOK(Ask: boolean; TemplateIsHTML : boolean): boolean; //kt 8/09
1587
1588 function EditControlOK: boolean; //kt 8/09 renamed. Was REOK
1589 begin
1590 if HTMLEditActive then begin //kt added this part 8/09
1591 Result := assigned(FHtmlEditControl) and
1592 FHtmlEditControl.Visible and
1593 TWinControl(FHtmlEditControl).Parent.Visible;
1594 end else begin //kt original below.
1595 Result := assigned(FRichEditControl) and
1596 FRichEditControl.Visible and
1597 FRichEditControl.Parent.Visible and
1598 FRichEditControl.Parent.Parent.Visible; //kt added last line
1599 end;
1600 end;
1601
1602begin
1603 Result := EditControlOK; //kt renamed function.
1604 if (not ask) and (not Result) and (assigned(FNewNoteButton)) then
1605 Result := TRUE
1606 else
1607 if ask and (not Result) and assigned(FNewNoteButton) and
1608 FNewNoteButton.Visible and FNewNoteButton.Enabled then
1609 begin
1610 FNewNoteButton.Click;
1611 if TemplateIsHTML and Assigned(FHtmlModeSwitcher) then begin //kt 8/09
1612 FHtmlModeSwitcher(TemplateIsHTML, true); //kt 8/09
1613 FHtmlEditControl.MoveCaretToEnd; //kt 8/09
1614 end; //kt 8/09
1615 Result := EditControlOK; //kt 8/09 Renamed function.
1616 end;
1617end;
1618
1619procedure TfrmDrawers.mnuViewTemplateIconLegendClick(Sender: TObject);
1620begin
1621 ShowIconLegend(ilTemplates);
1622end;
1623
1624procedure TfrmDrawers.pnlTemplatesButtonEnter(Sender: TObject);
1625begin
1626 with Sender as TPanel do
1627 if (ControlCount > 0) and (Controls[0] is TSpeedButton) and (TSpeedButton(Controls[0]).Down)
1628 then
1629 BevelOuter := bvLowered
1630 else
1631 BevelOuter := bvRaised;
1632end;
1633
1634procedure TfrmDrawers.pnlTemplatesButtonExit(Sender: TObject);
1635begin
1636 with Sender as TPanel do
1637 BevelOuter := bvNone;
1638 DisableArrowKeyMove(Sender);
1639end;
1640
1641procedure TfrmDrawers.tvRemindersKeyDown(Sender: TObject; var Key: Word;
1642 Shift: TShiftState);
1643begin
1644 case Key of
1645 VK_RETURN, VK_SPACE:
1646 begin
1647 ViewReminderDialog(ReminderNode(tvReminders.Selected));
1648 Key := 0;
1649 end;
1650 end;
1651end;
1652
1653procedure TfrmDrawers.tvRemindersNodeCaptioning(Sender: TObject;
1654 var Caption: String);
1655var
1656 StringData: string;
1657begin
1658 StringData := (Sender as TORTreeNode).StringData;
1659 if (Length(StringData) > 0) and (StringData[1] = 'R') then //Only tag reminder statuses
1660 case StrToIntDef(Piece(StringData,'^',6 {Due}),-1) of
1661// 0: Caption := Caption + ' -- Applicable'; <-- original line. //kt 7/15/2007
1662 0: Caption := Caption + DKLangConstW('fDrawers_xx_Applicable'); //kt added 7/15/2007
1663// 1: Caption := Caption + ' -- DUE'; <-- original line. //kt 7/15/2007
1664 1: Caption := Caption + DKLangConstW('fDrawers_xx_DUE'); //kt added 7/15/2007
1665// 2: Caption := Caption + ' -- Not Applicable'; <-- original line. //kt 7/15/2007
1666 2: Caption := Caption + DKLangConstW('fDrawers_xx_Not_Applicable'); //kt added 7/15/2007
1667// else Caption := Caption + ' -- Not Evaluated'; <-- original line. //kt 7/15/2007
1668 else Caption := Caption + DKLangConstW('fDrawers_xx_Not_Evaluated'); //kt added 7/15/2007
1669 end;
1670end;
1671
1672procedure TfrmDrawers.tvRemindersAddition(Sender: TObject;
1673 Node: TTreeNode);
1674begin
1675 TAccessibleTreeNode.WrapControl(Node as TORTreeNode);
1676end;
1677
1678procedure TfrmDrawers.tvRemindersDeletion(Sender: TObject;
1679 Node: TTreeNode);
1680begin
1681 TAccessibleTreeNode.UnwrapControl(Node as TORTreeNode);
1682end;
1683
1684procedure TfrmDrawers.DisableArrowKeyMove(Sender: TObject);
1685var
1686 CurrPanel : TKeyClickPanel;
1687begin
1688 if Sender is TKeyClickPanel then
1689 begin
1690 CurrPanel := Sender as TKeyClickPanel;
1691 If Boolean(Hi(GetKeyState(VK_UP)))
1692 OR Boolean(Hi(GetKeyState(VK_DOWN)))
1693 OR Boolean(Hi(GetKeyState(VK_LEFT)))
1694 OR Boolean(Hi(GetKeyState(VK_RIGHT))) then
1695 begin
1696 if Assigned(CurrPanel) then
1697 CurrPanel.SetFocus;
1698 end;
1699 end;
1700end;
1701
1702end.
1703
Note: See TracBrowser for help on using the repository browser.