Module

fTemplateDialog

Path

C:\CPRS\CPRS30\Templates\fTemplateDialog.pas

Last Modified

7/15/2014 3:26:44 PM

Units Used in Interface

Name Comments
fBase508Form -
uConst -
uTemplates -

Units Used in Implementation

Name Comments
dShared -
fRptBox -
rMisc -
uDlgComponents -
uInit -
uTemplateFields -

Classes

Name Comments
TfrmTemplateDialog -

Procedures

Name Owner Declaration Scope Comments
AppShowHint TfrmTemplateDialog procedure AppShowHint(var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo); Private -
btnAllClick TfrmTemplateDialog procedure btnAllClick(Sender: TObject); Public/Published -
btnNoneClick TfrmTemplateDialog procedure btnNoneClick(Sender: TObject); Public/Published -
btnOKClick TfrmTemplateDialog procedure btnOKClick(Sender: TObject); Public/Published -
btnPreviewClick TfrmTemplateDialog procedure btnPreviewClick(Sender: TObject); Public/Published -
BuildAllControls TfrmTemplateDialog procedure BuildAllControls; Private -
BuildCB TfrmTemplateDialog procedure BuildCB(CBidx: integer; var Y: integer; FirstTime: boolean); Private StringIn, StringOut: string;
CheckBoilerplate4Fields - procedure CheckBoilerplate4Fields(var AText: string; const CaptionText: string = ''; PreviewMode: boolean = FALSE); overload; Interfaced -
CheckBoilerplate4Fields - procedure CheckBoilerplate4Fields(SL: TStrings; const CaptionText: string = ''; PreviewMode: boolean = FALSE); overload; Interfaced -
ChkAll TfrmTemplateDialog procedure ChkAll(Chk: boolean); Private -
CountDlgProps - procedure CountDlgProps(var DlgID: string); Local Updates the item and parent item id's with the count
EntryDestroyed TfrmTemplateDialog procedure EntryDestroyed(Sender: TObject); Private -
FieldChanged TfrmTemplateDialog procedure FieldChanged(Sender: TObject); Private -
FormClose TfrmTemplateDialog procedure FormClose(Sender: TObject; var Action: TCloseAction); Public/Published -
FormCloseQuery TfrmTemplateDialog procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); Public/Published -
FormCreate TfrmTemplateDialog procedure FormCreate(Sender: TObject); Public/Published -
FormDestroy TfrmTemplateDialog procedure FormDestroy(Sender: TObject); Public/Published -
FormMouseWheel TfrmTemplateDialog procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); Public/Published -
FormPaint TfrmTemplateDialog procedure FormPaint(Sender: TObject); Public/Published -
FormShow TfrmTemplateDialog procedure FormShow(Sender: TObject); Public/Published -
GetText - procedure GetText(SL: TStrings; IncludeEmbeddedFields: Boolean); Global -
IncDlgID - procedure IncDlgID(var id: string); Local Appends an item count in the form of id.0, id.1, id.2, etc
InitScreenReaderSetup TfrmTemplateDialog procedure InitScreenReaderSetup; Private -
ItemChecked TfrmTemplateDialog procedure ItemChecked(Sender: TObject); Private -
NextTabCtrl - procedure NextTabCtrl(ACtrl: TControl); Local -
ParentCBEnter TfrmTemplateDialog procedure ParentCBEnter(Sender: TObject); Private -
ParentCBExit TfrmTemplateDialog procedure ParentCBExit(Sender: TObject); Private -
ShutdownTemplateDialog - procedure ShutdownTemplateDialog; Interfaced -
SizeFormToCancelBtn TfrmTemplateDialog procedure SizeFormToCancelBtn(); Private -
UMScreenReaderInit TfrmTemplateDialog procedure UMScreenReaderInit(var Message: TMessage); message UM_MISC; Private -

Functions

Name Owner Declaration Scope Comments
DoTemplateDialog - function DoTemplateDialog(SL: TStrings; const CaptionText: string; PreviewMode: boolean = FALSE): boolean; Interfaced
Returns True if Cancel button is pressed
Returns True if Cancel button is pressed
FindObjectByID TfrmTemplateDialog function FindObjectByID( id: string): TControl; Private -
GetObjectID TfrmTemplateDialog function GetObjectID( Control: TControl): string; Private -
GetParentID TfrmTemplateDialog function GetParentID( Control: TControl): string; Private -
IsAncestor TfrmTemplateDialog function IsAncestor( OldID: string; NewID: string): boolean; Private -

Global Variables

Name Type Declaration Comments
frmTemplateDialog TfrmTemplateDialog frmTemplateDialog: TfrmTemplateDialog; -
uTemplateDialogRunning Boolean uTemplateDialogRunning: boolean = false; -

Constants

Name Declaration Scope Comments
Gap 4 Global -
IndentGap 18 Global -


Module Source

1     unit fTemplateDialog;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       StdCtrls, ExtCtrls, ORCtrls, ORFn, AppEvnts, uTemplates, fBase508Form, uConst,
8       VA508AccessibilityManager;
9     
10    type
11      TfrmTemplateDialog = class(TfrmBase508Form)
12        sbMain: TScrollBox;
13        pnlBottom: TScrollBox;
14        btnCancel: TButton;
15        btnOK: TButton;
16        btnAll: TButton;
17        btnNone: TButton;
18        lblFootnote: TStaticText;
19        btnPreview: TButton;
20        procedure btnAllClick(Sender: TObject);
21        procedure btnNoneClick(Sender: TObject);
22        procedure FormPaint(Sender: TObject);
23        procedure FormCreate(Sender: TObject);
24        procedure FormDestroy(Sender: TObject);
25        procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
26        procedure btnOKClick(Sender: TObject);
27        procedure btnPreviewClick(Sender: TObject);
28        procedure FormClose(Sender: TObject; var Action: TCloseAction);
29        procedure FormShow(Sender: TObject);
30        procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
31          WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
32      private
33        FFirstBuild: boolean;
34        SL: TStrings;
35        BuildIdx: TStringList;
36        Entries: TStringList;
37        NoTextID: TStringList;
38        Index: string;
39        OneOnly: boolean;
40        Count: integer;
41        RepaintBuild: boolean;
42        FirstIndent: integer;
43        FBuilding: boolean;
44        FOldHintEvent: TShowHintEvent;
45        FMaxPnlWidth: integer;
46        FTabPos: integer;
47        FCheck4Required: boolean;
48        FSilent: boolean;
49        procedure SizeFormToCancelBtn();
50        procedure ChkAll(Chk: boolean);
51        procedure BuildCB(CBidx: integer; var Y: integer; FirstTime: boolean);
52        procedure ItemChecked(Sender: TObject);
53        procedure BuildAllControls;
54        procedure AppShowHint(var HintStr: string; var CanShow: Boolean;
55                              var HintInfo: THintInfo);
56        procedure FieldChanged(Sender: TObject);
57        procedure EntryDestroyed(Sender: TObject);
58        function GetObjectID( Control: TControl): string;
59        function GetParentID( Control: TControl): string;
60        function FindObjectByID( id: string): TControl;
61        function IsAncestor( OldID: string; NewID: string): boolean;
62        procedure ParentCBEnter(Sender: TObject);
63        procedure ParentCBExit(Sender: TObject);
64        procedure UMScreenReaderInit(var Message: TMessage); message UM_MISC;
65        procedure InitScreenReaderSetup;
66      public
67        property Silent: boolean read FSilent write FSilent ;
68      published
69      end;
70    
71    // Returns True if Cancel button is pressed
72    function DoTemplateDialog(SL: TStrings; const CaptionText: string; PreviewMode: boolean = FALSE): boolean;
73    procedure CheckBoilerplate4Fields(SL: TStrings; const CaptionText: string = ''; PreviewMode: boolean = FALSE); overload;
74    procedure CheckBoilerplate4Fields(var AText: string; const CaptionText: string = ''; PreviewMode: boolean = FALSE); overload;
75    procedure ShutdownTemplateDialog;
76    
77    var
78      frmTemplateDialog: TfrmTemplateDialog;
79    
80    implementation
81    
82    uses dShared, uTemplateFields, fRptBox, uInit, rMisc, uDlgComponents,
83      VA508AccessibilityRouter, VAUtils;
84    
85    {$R *.DFM}
86    
87    var
88      uTemplateDialogRunning: boolean = false;
89    
90    const
91      Gap = 4;
92      IndentGap = 18;
93    
94    
95    procedure GetText(SL: TStrings; IncludeEmbeddedFields: Boolean);
96    var
97      i, p1, p2: integer;
98      Txt, tmp: string;
99      Save, Hidden: boolean;
100     TmpCtrl: TStringList;
101   
102   begin
103     Txt := SL.Text;
104     SL.Clear;
105     TmpCtrl := TStringList.Create;
106     try
107       for i := 0 to frmTemplateDialog.sbMain.ControlCount-1 do
108         with frmTemplateDialog.sbMain do
109         begin
110           tmp := IntToStr(Controls[i].Tag);
111           tmp := StringOfChar('0', 7-length(tmp)) + tmp;
112           TmpCtrl.AddObject(tmp, Controls[i]);
113         end;
114       TmpCtrl.Sort;
115       for i := 0 to TmpCtrl.Count-1 do
116       begin
117         Save := FALSE;
118         if(TmpCtrl.Objects[i] is TORCheckBox) and (TORCheckBox(TmpCtrl.Objects[i]).Checked) then
119           Save := TRUE
120         else
121         if(frmTemplateDialog.OneOnly and (TmpCtrl.Objects[i] is TPanel)) then
122           Save := TRUE;
123         if(Save) then
124         begin
125           tmp := Piece(frmTemplateDialog.Index,U,TControl(TmpCtrl.Objects[i]).Tag);
126           p1 := StrToInt(Piece(tmp,'~',1));
127           p2 := StrToInt(Piece(tmp,'~',2));
128           Hidden := (copy(Piece(tmp,'~',3),2,1)=BOOLCHAR[TRUE]);
129           SL.Text := SL.Text + ResolveTemplateFields(Copy(Txt,p1,p2), FALSE, Hidden, IncludeEmbeddedFields);
130         end;
131       end;
132     finally
133       TmpCtrl.Free;
134     end;
135   end;
136   
137   // Returns True if Cancel button is pressed
138   function DoTemplateDialog(SL: TStrings; const CaptionText: string; PreviewMode: boolean = FALSE): boolean;
139   var
140     i, j, idx, Indent: integer;
141     DlgProps, Txt: string;
142     DlgIDCounts: TStringList;
143     DlgInt: TIntStruc;
144     CancelDlg: Boolean;
145     CancelMsg: String;
146   
147   
148     procedure IncDlgID(var id: string); //Appends an item count in the form of id.0, id.1, id.2, etc
149     var                                 //based on what is in the StringList for id.
150       k: integer;
151   
152     begin
153       k := DlgIDCounts.IndexOf(id);
154   
155       if (k >= 0) then
156         begin
157         DlgInt := TIntStruc(DlgIDCounts.Objects[k]);
158         DlgInt.x := DlgInt.x + 1;
159         id := id + '.' + InttoStr(DlgInt.x);
160         end
161       else
162         begin
163         DlgInt := TIntStruc.Create;
164         DlgInt.x := 0;
165         DlgIDCounts.AddObject(id, DlgInt);
166         id := id + '.0';
167         end;
168   
169     end;
170   
171     procedure CountDlgProps(var DlgID: string);  //Updates the item and parent item id's with the count
172     var                                          // value id.0, id.1, id.2, id.3, etc.  The input dialog
173       x: integer;                                // id is in the form 'a;b;c;d', where c is the item id
174       id, pid: string;                           // and d is the parent item id
175   
176     begin
177       id  := piece(DlgID,';',3);
178       pid := piece(DlgID,';',4);
179   
180       if length(pid) > 0 then
181         x := DlgIDCounts.IndexOf(pid)
182       else
183         x := -1;
184   
185       if (x >= 0) then
186         begin
187         DlgInt := TIntStruc(DlgIDCounts.Objects[x]);
188         pid := pid + '.' + InttoStr(DlgInt.x);
189         end;
190   
191       if length(id) > 0 then
192         IncDlgID(id);
193   
194       SetPiece(DlgID,';',3,id);
195       SetPiece(DlgID,';',4,pid);
196     end;
197   
198   begin
199     Result := FALSE;
200     CancelDlg := FALSE;
201     SetTemplateDialogCanceled(FALSE);
202     frmTemplateDialog := TfrmTemplateDialog.Create(Application);
203     try
204       DlgIDCounts := TStringList.Create;
205       DlgIDCounts.Sorted := TRUE;
206       DlgIDCounts.Duplicates := dupError;
207       frmTemplateDialog.Caption := CaptionText;
208       AssignFieldIDs(SL);
209       frmTemplateDialog.SL := SL;
210       frmTemplateDialog.Index := '';
211       Txt := SL.Text;
212       frmTemplateDialog.OneOnly := (DelimCount(Txt, ObjMarker) = 1);
213       frmTemplateDialog.Count := 0;
214       idx := 1;
215       frmTemplateDialog.FirstIndent := 99999;
216       repeat
217         i := pos(ObjMarker, Txt);
218         if(i > 1) then
219         begin
220           j := pos(DlgPropMarker, Txt);
221           if(j > 0) then
222             begin
223             DlgProps := copy(Txt, j + DlgPropMarkerLen, (i - j - DlgPropMarkerLen));
224             CountDlgProps(DlgProps);
225             end
226           else
227             begin
228             DlgProps := '';
229             j := i;
230             end;
231           inc(frmTemplateDialog.Count);
232           frmTemplateDialog.Index := frmTemplateDialog.Index +
233                                      IntToStr(idx)+'~'+IntToStr(j-1)+'~'+DlgProps+U;
234           inc(idx,i+ObjMarkerLen-1);
235           Indent := StrToIntDef(Piece(DlgProps, ';', 5),0);
236           if(frmTemplateDialog.FirstIndent > Indent) then
237             frmTemplateDialog.FirstIndent := Indent;
238         end;
239         if(i > 0) then
240           delete(txt, 1, i + ObjMarkerLen - 1);
241       until (i = 0);
242       if(frmTemplateDialog.Count > 0) then
243       begin
244         if(frmTemplateDialog.OneOnly) then
245         begin
246           frmTemplateDialog.btnNone.Visible := FALSE;
247           frmTemplateDialog.btnAll.Visible := FALSE;
248         end;
249         frmTemplateDialog.BuildAllControls;
250         repeat                      
251            frmTemplateDialog.ShowModal;
252            if(frmTemplateDialog.ModalResult = mrOK) then
253              GetText(SL, TRUE)     {TRUE = Include embedded fields}
254            else
255             if (not PreviewMode) and (not frmTemplateDialog.Silent) and (not uInit.TimedOut) then
256               begin
257                 CancelMsg := 'If you cancel, your changes will not be saved.  Are you sure you want to cancel?';
258                 if (InfoBox(CancelMsg, 'Cancel Dialog Processing', MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) = ID_YES) then 
259                   begin
260                     SL.Clear;
261                     Result := TRUE;
262                     CancelDlg := TRUE;
263                   end
264                 else
265                   CancelDlg := FALSE;
266               end
267             else
268               begin
269                 SL.Clear;
270                 Result := TRUE;
271                 CancelDlg := TRUE;
272               end;
273         until CancelDlg or (frmTemplateDialog.ModalResult = mrOK)
274       end
275       else
276         SL.Clear;
277     finally
278       //frmTemplateDialog.Free;    v22.11e RV
279       frmTemplateDialog.Release;
280       //frmTemplateDialog := nil;  access violation source?  removed 7/28/03 RV
281       for i := 0 to DlgIDCounts.Count-1 do begin
282         DlgIDCounts.Objects[i].Free;
283       end;
284       DlgIDCounts.Free;
285     end;
286   
287     if Result then
288       SetTemplateDialogCanceled(TRUE)
289     else
290     begin
291       SetTemplateDialogCanceled(FALSE);
292       CheckBoilerplate4Fields(SL, CaptionText, PreviewMode);
293     end;
294     
295   end;
296   
297   procedure ShutdownTemplateDialog;
298   begin
299     if uTemplateDialogRunning and assigned(frmTemplateDialog) then
300     begin
301       frmTemplateDialog.Silent := True;
302       frmTemplateDialog.ModalResult := mrCancel;
303     end;
304   end;
305   
306   procedure CheckBoilerplate4Fields(SL: TStrings; const CaptionText: string = ''; PreviewMode: boolean = FALSE);
307   begin
308     while(HasTemplateField(SL.Text)) do
309     begin
310       if (BoilerplateTemplateFieldsOK(SL.Text)) then
311       begin
312         SL[SL.Count-1] := SL[SL.Count-1] + DlgPropMarker + '00100;0;-1;;0' + ObjMarker;
313         DoTemplateDialog(SL, CaptionText, PreviewMode);
314       end
315       else
316         SL.Clear;
317     end;
318     StripScreenReaderCodes(SL);
319   end;
320   
321   procedure CheckBoilerplate4Fields(var AText: string; const CaptionText: string = ''; PreviewMode: boolean = FALSE);
322   var
323     tmp: TStringList;
324   
325   begin
326     tmp := TStringList.Create;
327     try
328       tmp.text := AText;
329       CheckBoilerplate4Fields(tmp, CaptionText, PreviewMode);
330       AText := tmp.text;
331     finally
332       tmp.free;
333     end;
334   end;
335   
336   procedure TfrmTemplateDialog.ChkAll(Chk: boolean);
337   var
338     i: integer;
339   
340   begin
341     for i := 0 to sbMain.ControlCount-1 do
342     begin
343       if(sbMain.Controls[i] is TORCheckBox) then
344         TORCheckBox(sbMain.Controls[i]).Checked := Chk;
345     end;
346   end;
347   
348   procedure TfrmTemplateDialog.btnAllClick(Sender: TObject);
349   begin
350     ChkAll(TRUE);
351   end;
352   
353   procedure TfrmTemplateDialog.btnNoneClick(Sender: TObject);
354   begin
355     ChkAll(FALSE);
356   end;
357   
358   function TfrmTemplateDialog.GetObjectID( Control: TControl): string;
359   var
360     idx, idx2: integer;
361   begin
362     result := '';
363     if Assigned(Control) then
364     begin
365       idx := Control.Tag;
366       if(idx > 0) then
367       begin
368         idx2 := BuildIdx.IndexOfObject(TObject(idx));
369         if idx2 >= 0 then
370           result := BuildIdx[idx2]
371         else
372           result := Piece(Piece(Piece(Index, U, idx),'~',3), ';', 3);
373       end;
374     end;
375   end;
376   
377   function TfrmTemplateDialog.GetParentID( Control: TControl): string;
378   var
379     idx: integer;
380   begin
381     result := '';
382     if Assigned(Control) then
383     begin
384       idx := Control.Tag;
385       if(idx > 0) then
386         result := Piece(Piece(Piece(Index, U, idx),'~',3), ';', 4);
387     end;
388   end;
389   
390   function TfrmTemplateDialog.FindObjectByID( id: string): TControl;
391   var
392     i: integer;
393     ObjID: string;
394   begin
395     result := nil;
396     if ID <> '' then
397     begin
398       for i := 0 to sbMain.ControlCount-1 do
399       begin
400         ObjID := GetObjectID(sbMain.Controls[i]);
401         if(ObjID = ID) then
402         begin
403           result := sbMain.Controls[i];
404           break;
405         end;
406       end;
407     end;
408   end;
409   
410   procedure TfrmTemplateDialog.InitScreenReaderSetup;
411   var
412     ctrl: TWinControl;
413     list: TList;
414   begin
415     if ScreenReaderSystemActive then
416     begin
417       list := TList.Create;
418       try
419         sbMain.GetTabOrderList(list);
420         if list.Count > 0 then
421         begin
422           ctrl := TWinControl(list[0]);
423           PostMessage(Handle, UM_MISC, WParam(ctrl), 0);
424         end;
425       finally
426         list.free;
427       end;
428     end;
429   end;
430   
431   function TfrmTemplateDialog.IsAncestor( OldID: string; NewID: string): boolean;
432   begin
433     if (OldID = '') or (NewID = '') then
434       result := False
435     else if OldID = NewID then
436       result := True
437     else
438       result := IsAncestor(OldID, GetParentID(FindObjectByID(NewID)));
439   end;
440   
441   procedure TfrmTemplateDialog.BuildCB(CBidx: integer; var Y: integer; FirstTime: boolean);
442   var
443     bGap, Indent, i, idx, p1, p2: integer;
444     EID, ID, PID, DlgProps, tmp, txt, tmpID: string;
445     pctrl, ctrl: TControl;
446     pnl: TPanel;
447     KillCtrl, doHint, dsp, noTextParent: boolean;
448     Entry: TTemplateDialogEntry;
449   //  StringIn, StringOut: string;
450     cb: TCPRSDialogParentCheckBox;
451   
452     procedure NextTabCtrl(ACtrl: TControl);
453     begin
454       if(ACtrl is TWinControl) then
455       begin
456         inc(FTabPos);
457         TWinControl(ACtrl).TabOrder := FTabPos;
458       end;
459     end;
460   
461   begin
462     tmp := Piece(Index, U, CBidx);
463     p1 := StrToInt(Piece(tmp,'~',1));
464     p2 := StrToInt(Piece(tmp,'~',2));
465     DlgProps := Piece(tmp,'~',3);
466     ID := Piece(DlgProps, ';', 3);
467     PID := Piece(DlgProps, ';', 4);
468   
469     ctrl := nil;
470     pctrl := nil;
471     if(PID <> '') then
472       noTextParent := (NoTextID.IndexOf(PID) < 0)
473     else
474       noTextParent := TRUE;
475     if not FirstTime then
476       ctrl := FindObjectByID(ID);
477     if noTextParent and (PID <> '') then
478       pctrl := FindObjectByID(PID);
479     if(PID = '') then
480       KillCtrl := FALSE
481     else
482     begin
483       if(assigned(pctrl)) then
484       begin
485         if(not (pctrl is TORCheckBox)) or
486           (copy(DlgProps,3,1) = BOOLCHAR[TRUE]) then // show if parent is unchecked
487           KillCtrl := FALSE
488         else
489           KillCtrl := (not TORCheckBox(pctrl).Checked);
490       end
491       else
492         KillCtrl := noTextParent;
493     end;
494     if KillCtrl then
495     begin
496       if(assigned(ctrl)) then
497       begin
498         if(ctrl is TORCheckBox) and (assigned(TORCheckBox(ctrl).Associate)) then
499           TORCheckBox(ctrl).Associate.Hide;
500         idx := BuildIdx.IndexOfObject(TObject(ctrl.Tag));
501         if idx >= 0 then
502           BuildIdx.delete(idx);
503         ctrl.Free;
504       end;
505       exit;
506     end;
507     tmp := copy(SL.Text, p1, p2);
508     if(copy(tmp, length(tmp)-1, 2) = CRLF) then
509       delete(tmp, length(tmp)-1, 2);
510     bGap := StrToIntDef(copy(DlgProps,5,1),0);
511     while bGap > 0 do
512     begin
513       if(copy(tmp, 1, 2) = CRLF) then
514       begin
515         delete(tmp, 1, 2);
516         dec(bGap);
517       end
518       else
519         bGap := 0;
520     end;
521     if(tmp = NoTextMarker) then
522     begin
523       if(NoTextID.IndexOf(ID) < 0) then
524         NoTextID.Add(ID);
525       exit;
526     end;
527     if(not assigned(ctrl)) then
528     begin
529       dsp := (copy(DlgProps,1,1)=BOOLCHAR[TRUE]);
530       EID := 'DLG' + IntToStr(CBIdx);
531       idx := Entries.IndexOf(EID);
532       doHint := FALSE;
533       txt := tmp;
534       if(idx < 0) then
535       begin
536         if(copy(DlgProps,2,1)=BOOLCHAR[TRUE]) then // First Line Only
537         begin
538           i := pos(CRLF, tmp);
539           if(i > 0) then
540           begin
541             dec(i);
542             if i > 70 then
543             begin
544               i := 71;
545               while (i > 0) and (tmp[i] <> ' ') do dec(i);
546               if i = 0 then
547                 i := 70
548               else
549                 dec(i);
550             end;
551             doHint := TRUE;
552             tmp := copy(tmp, 1, i) + ' ...';
553           end;
554         end;
555         Entry := GetDialogEntry(sbMain, EID, tmp);
556         Entry.AutoDestroyOnPanelFree := TRUE;
557         Entry.OnDestroy := EntryDestroyed;
558         Entries.AddObject(EID, Entry);
559       end
560       else
561         Entry := TTemplateDialogEntry(Entries.Objects[idx]);
562   
563       if(dsp or OneOnly) then
564         cb := nil
565       else
566         cb := TCPRSDialogParentCheckBox.Create(Self);
567   
568       pnl := Entry.GetPanel(FMaxPnlWidth, sbMain, cb);
569       pnl.Show;
570       if(doHint and (not pnl.ShowHint)) then
571       begin
572         pnl.ShowHint := TRUE;
573         Entry.Obj := pnl;
574         Entry.Text := txt;
575         pnl.hint := Entry.GetText;
576         Entry.OnChange := FieldChanged;
577       end;
578       if not assigned(cb) then
579         ctrl := pnl
580       else
581       begin
582         ctrl := cb;
583         ctrl.Parent := sbMain;
584   
585         TORCheckbox(ctrl).OnEnter := frmTemplateDialog.ParentCBEnter;
586         TORCheckbox(ctrl).OnExit := frmTemplateDialog.ParentCBExit;
587   
588         TORCheckBox(ctrl).Height := TORCheckBox(ctrl).Height + 5;
589         TORCheckBox(ctrl).Width := 17;
590   
591       {Insert next line when focus fixed}
592       //  ctrl.Width := IndentGap;
593       {Remove next line when focus fixed}
594         TORCheckBox(ctrl).AutoSize := false;
595         TORCheckBox(ctrl).Associate := pnl;
596         pnl.Tag := Integer(ctrl);
597         tmpID := copy(ID, 1, (pos('.', ID) - 1)); {copy the ID without the decimal place}
598   //      if Templates.IndexOf(tmpID) > -1 then
599   //        StringIn := 'Sub-Template: ' + TTemplate(Templates.Objects[Templates.IndexOf(tmpID)]).PrintName
600   //      else
601   //        StringIn := 'Sub-Template:';
602   //      StringOut := StringReplace(StringIn, '&', '&&', [rfReplaceAll]);
603   //      TORCheckBox(ctrl).Caption := StringOut;
604         UpdateColorsFor508Compliance(ctrl);
605   
606       end;
607       ctrl.Tag := CBIdx;
608   
609       Indent := StrToIntDef(Piece(DlgProps, ';', 5),0) - FirstIndent;
610       if dsp then inc(Indent);
611       ctrl.Left := Gap + (Indent * IndentGap);
612       //ctrl.Width := sbMain.ClientWidth - Gap - ctrl.Left - ScrollBarWidth;
613       if(ctrl is TORCheckBox) then
614         pnl.Left := ctrl.Left + IndentGap;
615   
616       if(ctrl is TORCheckBox) then with TORCheckBox(ctrl) do
617       begin
618         GroupIndex := StrToIntDef(Piece(DlgProps, ';', 2),0);
619         if(GroupIndex <> 0) then
620           RadioStyle := TRUE;
621         OnClick := ItemChecked;
622         StringData := DlgProps;
623       end;
624       if BuildIdx.IndexOfObject(TObject(CBIdx)) < 0 then
625         BuildIdx.AddObject(Piece(Piece(Piece(Index, U, CBIdx),'~',3), ';', 3), TObject(CBIdx));
626     end;
627     ctrl.Top := Y;
628     NextTabCtrl(ctrl);
629     if(ctrl is TORCheckBox) then
630     begin
631       TORCheckBox(ctrl).Associate.Top := Y;
632       NextTabCtrl(TORCheckBox(ctrl).Associate);
633       inc(Y, TORCheckBox(ctrl).Associate.Height+1);
634     end
635     else
636       inc(Y, ctrl.Height+1);
637   end;
638   
639   procedure TfrmTemplateDialog.ParentCBEnter(Sender: TObject);
640   begin
641     (Sender as TORCheckbox).FocusOnBox := true;
642   end;
643   
644   procedure TfrmTemplateDialog.ParentCBExit(Sender: TObject);
645   begin
646     (Sender as TORCheckbox).FocusOnBox := false;
647   
648   end;
649   
650   procedure TfrmTemplateDialog.ItemChecked(Sender: TObject);
651   begin
652     if(copy(TORCheckBox(Sender).StringData,4,1) = '1') then
653     begin
654       RepaintBuild := TRUE;
655       Invalidate;
656     end;
657   end;
658   
659   procedure TfrmTemplateDialog.BuildAllControls;
660   var
661     i, Y: integer;
662     FirstTime: boolean;
663   
664   begin
665     if FBuilding then exit;
666     FBuilding := TRUE;
667     try
668       FTabPos := 0;
669       FirstTime := (sbMain.ControlCount = 0);
670       NoTextID.Clear;
671       Y := Gap - sbMain.VertScrollBar.Position;
672       for i := 1 to Count do
673         BuildCB(i, Y, FirstTime);
674       if ScreenReaderSystemActive then
675       begin
676         amgrMain.RefreshComponents;
677         Application.ProcessMessages;
678       end;
679     finally
680       FBuilding := FALSE;
681     end;
682   end;
683   
684   procedure TfrmTemplateDialog.FormPaint(Sender: TObject);
685   begin
686     if RepaintBuild then
687     begin
688       RepaintBuild := FALSE;
689       BuildAllControls;
690       InitScreenReaderSetup;
691     end;
692   end;
693   
694   procedure TfrmTemplateDialog.FormShow(Sender: TObject);
695   begin
696     inherited;
697     if FFirstBuild then
698     begin
699       FFirstBuild := FALSE;
700       InitScreenReaderSetup;
701     end;
702   end;
703   
704   procedure TfrmTemplateDialog.FormCreate(Sender: TObject);
705   begin
706     uTemplateDialogRunning := True;
707     FFirstBuild := TRUE;
708     BuildIdx := TStringList.Create;
709     Entries := TStringList.Create;
710     NoTextID := TStringList.Create;
711     FOldHintEvent := Application.OnShowHint;
712     Application.OnShowHint := AppShowHint;
713     //ResizeAnchoredFormToFont(Self);
714     FMaxPnlWidth := FontWidthPixel(sbMain.Font.Handle) * MAX_ENTRY_WIDTH; //AGP change Template Dialog to wrap at 80 instead of 74
715     SetFormPosition(Self);
716     ResizeAnchoredFormToFont(Self);
717     SizeFormToCancelBtn();
718   end;
719   
720   procedure TfrmTemplateDialog.AppShowHint(var HintStr: string;
721     var CanShow: Boolean; var HintInfo: THintInfo);
722   const
723     HistHintDelay = 1200000; // 20 minutes
724   
725   begin
726   //  if(HintInfo.HintControl.Parent = sbMain) then
727       HintInfo.HideTimeout := HistHintDelay;
728     if(assigned(FOldHintEvent)) then
729       FOldHintEvent(HintStr, CanShow, HintInfo);
730   end;
731   
732   procedure TfrmTemplateDialog.FormDestroy(Sender: TObject);
733   begin
734     //Application.OnShowHint := FOldHintEvent;   v22.11f - RV - moved to OnClose
735     NoTextID.Free;
736     FreeEntries(Entries);
737     Entries.Free;
738     BuildIdx.Free;
739     uTemplateDialogRunning := False;  
740   end;
741   
742   procedure TfrmTemplateDialog.FormMouseWheel(Sender: TObject; Shift: TShiftState;
743     WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
744   begin
745     If RectContains(sbMain.BoundsRect, SbMain.ScreenToClient(MousePos)) then
746     begin
747       ScrollControl(sbMain, (WheelDelta > 0));
748       Handled := True;
749     end;
750   end;
751   
752   procedure TfrmTemplateDialog.FieldChanged(Sender: TObject);
753   begin
754     with TTemplateDialogEntry(Sender) do
755       TPanel(Obj).hint := GetText;
756   end;
757   
758   procedure TfrmTemplateDialog.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
759   var
760     Txt, tmp: string;
761     i, p1, p2: integer;
762     Save: boolean;
763   
764   begin
765     CanClose := TRUE;
766     if FCheck4Required then
767     begin
768       FCheck4Required := FALSE;
769       Txt := SL.Text;
770       for i := 0 to sbMain.ControlCount-1 do
771       begin
772         Save := FALSE;
773         if(sbMain.Controls[i] is TORCheckBox) and
774           (TORCheckBox(sbMain.Controls[i]).Checked) then
775           Save := TRUE
776         else
777         if(OneOnly and (sbMain.Controls[i] is TPanel)) then
778           Save := TRUE;
779         if(Save) then
780         begin
781           tmp := Piece(Index,U,sbMain.Controls[i].Tag);
782           p1 := StrToInt(Piece(tmp,'~',1));
783           p2 := StrToInt(Piece(tmp,'~',2));
784           if AreTemplateFieldsRequired(Copy(Txt,p1,p2)) then
785             CanClose := FALSE;
786         end;
787         if not CanClose then
788         begin
789           ShowMsg(MissingFieldsTxt);
790           break;
791         end;
792       end;
793     end;
794   end;
795   
796   procedure TfrmTemplateDialog.btnOKClick(Sender: TObject);
797   begin
798     FCheck4Required := TRUE;
799   end;
800   
801   procedure TfrmTemplateDialog.btnPreviewClick(Sender: TObject);
802   var
803     TmpSL: TStringList;
804   
805   begin
806     TmpSL := TStringList.Create;
807     try
808       FastAssign(SL, TmpSL);
809       GetText(TmpSL, FALSE);  {FALSE = Do not include embedded fields}
810       StripScreenReaderCodes(TmpSL);
811       ReportBox(TmpSL, 'Dialog Preview', FALSE);
812     finally
813       TmpSL.Free;
814     end;
815   end;
816   
817   procedure TfrmTemplateDialog.EntryDestroyed(Sender: TObject);
818   var
819     idx: integer;
820   
821   begin
822     idx := Entries.IndexOf(TTemplateDialogEntry(Sender).ID);
823     if idx >= 0 then
824       Entries.delete(idx);
825   end;
826   
827   procedure TfrmTemplateDialog.FormClose(Sender: TObject;
828     var Action: TCloseAction);
829   begin
830     Application.OnShowHint := FOldHintEvent;
831     SaveUserBounds(Self);
832   end;
833   
834   procedure TfrmTemplateDialog.SizeFormToCancelBtn;
835   const
836     RIGHT_MARGIN = 12;
837   var
838     minWidth : integer;
839   begin
840     minWidth := btnCancel.Left + btnCancel.Width + RIGHT_MARGIN;
841     if minWidth > Self.Width then
842       Self.Width := minWidth;
843   end;
844   
845   procedure TfrmTemplateDialog.UMScreenReaderInit(var Message: TMessage);
846   var
847     ctrl: TWinControl;
848     item: TVA508AccessibilityItem;
849   begin
850     ctrl := TWinControl(Message.WParam);
851     // Refresh the accessibility manager entry -
852     // fixes bug where first focusable check boxes weren't working correctly  
853     if ctrl is TCPRSDialogParentCheckBox then
854     begin
855       item := amgrMain.AccessData.FindItem(ctrl, FALSE);
856       if assigned(item) then
857         item.free;
858       amgrMain.AccessData.EnsureItemExists(ctrl);
859     end;
860   end;
861   
862   end.

Module Calls (2 levels)


fTemplateDialog
 ├uTemplates
 │ ├uTIU
 │ ├uDCSumm
 │ ├rTemplates
 │ ├uCore
 │ ├dShared
 │ ├fTemplateDialog...
 │ ├uTemplateFields
 │ ├fTemplateImport
 │ ├rCore
 │ ├uConst
 │ ├uEventHooks
 │ ├fReminderDialog
 │ └rODBase
 ├fBase508Form
 │ ├uConst
 │ └uHelpManager
 ├uConst
 ├dShared...
 ├uTemplateFields...
 ├fRptBox
 │ ├fFrame
 │ ├fBase508Form...
 │ ├uReports
 │ └rReports
 ├uInit
 │ └fTimeout
 ├rMisc
 │ └fOrders
 └uDlgComponents
   └uCore...

Module Called-By (2 levels)


            fTemplateDialog
                  fODBase┤ 
                uOrders┤ │ 
                rODBase┤ │ 
                fOrders┤ │ 
                  fMeds┤ │ 
             uSignItems┤ │ 
              fODDietLT┤ │ 
                fODDiet┤ │ 
                fODMisc┤ │ 
                 fODGen┤ │ 
               fODMedIn┤ │ 
              fODMedOut┤ │ 
          fODMedComplex┤ │ 
                fODText┤ │ 
             fODConsult┤ │ 
                fODProc┤ │ 
                 fODRad┤ │ 
                 fODLab┤ │ 
               fODBBank┤ │ 
                fODMeds┤ │ 
               fODMedIV┤ │ 
              fODVitals┤ │ 
                fODAuto┤ │ 
                fOMNavA┤ │ 
        fOrderSaveQuick┤ │ 
                 fOMSet┤ │ 
              fODMedNVA┤ │ 
            fOrdersCopy┤ │ 
               fMedCopy┤ │ 
               fODAllgy┘ │ 
               uTemplates┤ 
             fODBase...┤ │ 
                dShared┤ │ 
               fDrawers┤ │ 
     fTemplateDialog...┤ │ 
                 fNotes┤ │ 
              fConsults┤ │ 
                fDCSumm┤ │ 
        fTemplateEditor┤ │ 
        fReminderDialog┤ │ 
               fSurgery┤ │ 
          fODConsult...┤ │ 
             fODProc...┤ │ 
             fODAuto...┤ │ 
      fFindingTemplates┤ │ 
       fTemplateObjects┤ │ 
       fTemplateAutoGen┘ │ 
              fDrawers...┤ 
                fNotes...┤ 
             fConsults...┤ 
               fDCSumm...┤ 
            fTemplateView┤ 
            fDrawers...┤ │ 
     fTemplateEditor...┘ │ 
       fReminderDialog...┤ 
              fSurgery...┤ 
     fTemplateFieldEditor┤ 
              fNotes...┤ │ 
           fConsults...┤ │ 
             fDCSumm...┤ │ 
     fTemplateEditor...┤ │ 
            fSurgery...┘ │ 
          fTemplateFields┤ 
     fTemplateEditor...┤ │ 
fTemplateFieldEditor...┘ │ 
               fODAuto...┘