source: cprs/trunk/CPRS-Chart/Templates/fTemplateDialog.pas@ 1797

Last change on this file since 1797 was 1679, checked in by healthsevak, 10 years ago

Updating the working copy to CPRS version 28
File size: 23.6 KB
RevLine 
[456]1unit fTemplateDialog;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
[829]7 StdCtrls, ExtCtrls, ORCtrls, ORFn, AppEvnts, uTemplates, fBase508Form, uConst,
8 VA508AccessibilityManager;
[456]9
10type
[829]11 TfrmTemplateDialog = class(TfrmBase508Form)
[456]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);
[829]29 procedure FormShow(Sender: TObject);
[1679]30 procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
31 WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
[456]32 private
[829]33 FFirstBuild: boolean;
[456]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);
[829]64 procedure UMScreenReaderInit(var Message: TMessage); message UM_MISC;
65 procedure InitScreenReaderSetup;
[456]66 public
67 property Silent: boolean read FSilent write FSilent ;
68 published
69 end;
70
71// Returns True if Cancel button is pressed
72function DoTemplateDialog(SL: TStrings; const CaptionText: string; PreviewMode: boolean = FALSE): boolean;
73procedure CheckBoilerplate4Fields(SL: TStrings; const CaptionText: string = ''; PreviewMode: boolean = FALSE); overload;
74procedure CheckBoilerplate4Fields(var AText: string; const CaptionText: string = ''; PreviewMode: boolean = FALSE); overload;
[1679]75procedure ShutdownTemplateDialog;
[456]76
77var
78 frmTemplateDialog: TfrmTemplateDialog;
79
80implementation
81
[829]82uses dShared, uTemplateFields, fRptBox, uInit, rMisc, uDlgComponents,
83 VA508AccessibilityRouter, VAUtils;
[456]84
85{$R *.DFM}
86
[1679]87var
88 uTemplateDialogRunning: boolean = false;
89
[456]90const
91 Gap = 4;
92 IndentGap = 18;
93
94
95procedure GetText(SL: TStrings; IncludeEmbeddedFields: Boolean);
96var
97 i, p1, p2: integer;
98 Txt, tmp: string;
99 Save, Hidden: boolean;
100 TmpCtrl: TStringList;
101
102begin
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;
135end;
136
137// Returns True if Cancel button is pressed
138function DoTemplateDialog(SL: TStrings; const CaptionText: string; PreviewMode: boolean = FALSE): boolean;
139var
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
198begin
199 Result := FALSE;
200 CancelDlg := FALSE;
[829]201 SetTemplateDialogCanceled(FALSE);
[456]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
[829]287 if Result then
288 SetTemplateDialogCanceled(TRUE)
289 else
290 begin
291 SetTemplateDialogCanceled(FALSE);
[456]292 CheckBoilerplate4Fields(SL, CaptionText, PreviewMode);
[829]293 end;
294
[456]295end;
296
[1679]297procedure ShutdownTemplateDialog;
298begin
299 if uTemplateDialogRunning and assigned(frmTemplateDialog) then
300 begin
301 frmTemplateDialog.Silent := True;
302 frmTemplateDialog.ModalResult := mrCancel;
303 end;
304end;
305
[456]306procedure CheckBoilerplate4Fields(SL: TStrings; const CaptionText: string = ''; PreviewMode: boolean = FALSE);
307begin
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;
[829]318 StripScreenReaderCodes(SL);
[456]319end;
320
321procedure CheckBoilerplate4Fields(var AText: string; const CaptionText: string = ''; PreviewMode: boolean = FALSE);
322var
323 tmp: TStringList;
324
325begin
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;
334end;
335
336procedure TfrmTemplateDialog.ChkAll(Chk: boolean);
337var
338 i: integer;
339
340begin
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;
346end;
347
348procedure TfrmTemplateDialog.btnAllClick(Sender: TObject);
349begin
350 ChkAll(TRUE);
351end;
352
353procedure TfrmTemplateDialog.btnNoneClick(Sender: TObject);
354begin
355 ChkAll(FALSE);
356end;
357
358function TfrmTemplateDialog.GetObjectID( Control: TControl): string;
359var
360 idx, idx2: integer;
361begin
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;
375end;
376
377function TfrmTemplateDialog.GetParentID( Control: TControl): string;
378var
379 idx: integer;
380begin
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;
388end;
389
390function TfrmTemplateDialog.FindObjectByID( id: string): TControl;
391var
392 i: integer;
393 ObjID: string;
394begin
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;
408end;
409
[829]410procedure TfrmTemplateDialog.InitScreenReaderSetup;
411var
412 ctrl: TWinControl;
413 list: TList;
414begin
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;
429end;
430
[456]431function TfrmTemplateDialog.IsAncestor( OldID: string; NewID: string): boolean;
432begin
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)));
439end;
440
441procedure TfrmTemplateDialog.BuildCB(CBidx: integer; var Y: integer; FirstTime: boolean);
442var
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;
[829]449// StringIn, StringOut: string;
450 cb: TCPRSDialogParentCheckBox;
[456]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
461begin
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
[829]563 if(dsp or OneOnly) then
564 cb := nil
565 else
566 cb := TCPRSDialogParentCheckBox.Create(Self);
567
568 pnl := Entry.GetPanel(FMaxPnlWidth, sbMain, cb);
[456]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;
[829]578 if not assigned(cb) then
[456]579 ctrl := pnl
580 else
581 begin
[829]582 ctrl := cb;
[456]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;
[829]596 pnl.Tag := Integer(ctrl);
[456]597 tmpID := copy(ID, 1, (pos('.', ID) - 1)); {copy the ID without the decimal place}
[829]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);
[456]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);
637end;
638
639procedure TfrmTemplateDialog.ParentCBEnter(Sender: TObject);
640begin
641 (Sender as TORCheckbox).FocusOnBox := true;
642end;
643
644procedure TfrmTemplateDialog.ParentCBExit(Sender: TObject);
645begin
646 (Sender as TORCheckbox).FocusOnBox := false;
647
648end;
649
650procedure TfrmTemplateDialog.ItemChecked(Sender: TObject);
651begin
652 if(copy(TORCheckBox(Sender).StringData,4,1) = '1') then
653 begin
654 RepaintBuild := TRUE;
655 Invalidate;
656 end;
657end;
658
659procedure TfrmTemplateDialog.BuildAllControls;
660var
661 i, Y: integer;
662 FirstTime: boolean;
663
664begin
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);
[829]674 if ScreenReaderSystemActive then
675 begin
676 amgrMain.RefreshComponents;
677 Application.ProcessMessages;
678 end;
[456]679 finally
680 FBuilding := FALSE;
681 end;
682end;
683
684procedure TfrmTemplateDialog.FormPaint(Sender: TObject);
685begin
686 if RepaintBuild then
687 begin
688 RepaintBuild := FALSE;
689 BuildAllControls;
[829]690 InitScreenReaderSetup;
[456]691 end;
692end;
693
[829]694procedure TfrmTemplateDialog.FormShow(Sender: TObject);
695begin
696 inherited;
697 if FFirstBuild then
698 begin
699 FFirstBuild := FALSE;
700 InitScreenReaderSetup;
701 end;
702end;
703
[456]704procedure TfrmTemplateDialog.FormCreate(Sender: TObject);
705begin
[1679]706 uTemplateDialogRunning := True;
[829]707 FFirstBuild := TRUE;
[456]708 BuildIdx := TStringList.Create;
709 Entries := TStringList.Create;
710 NoTextID := TStringList.Create;
711 FOldHintEvent := Application.OnShowHint;
712 Application.OnShowHint := AppShowHint;
[1679]713 //ResizeAnchoredFormToFont(Self);
[456]714 FMaxPnlWidth := FontWidthPixel(sbMain.Font.Handle) * MAX_ENTRY_WIDTH; //AGP change Template Dialog to wrap at 80 instead of 74
715 SetFormPosition(Self);
[1679]716 ResizeAnchoredFormToFont(Self);
[456]717 SizeFormToCancelBtn();
718end;
719
720procedure TfrmTemplateDialog.AppShowHint(var HintStr: string;
721 var CanShow: Boolean; var HintInfo: THintInfo);
722const
723 HistHintDelay = 1200000; // 20 minutes
724
725begin
726// if(HintInfo.HintControl.Parent = sbMain) then
727 HintInfo.HideTimeout := HistHintDelay;
728 if(assigned(FOldHintEvent)) then
729 FOldHintEvent(HintStr, CanShow, HintInfo);
730end;
731
732procedure TfrmTemplateDialog.FormDestroy(Sender: TObject);
733begin
734 //Application.OnShowHint := FOldHintEvent; v22.11f - RV - moved to OnClose
735 NoTextID.Free;
736 FreeEntries(Entries);
737 Entries.Free;
738 BuildIdx.Free;
[1679]739 uTemplateDialogRunning := False;
[456]740end;
741
[1679]742procedure TfrmTemplateDialog.FormMouseWheel(Sender: TObject; Shift: TShiftState;
743 WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
744begin
745 If RectContains(sbMain.BoundsRect, SbMain.ScreenToClient(MousePos)) then
746 begin
747 ScrollControl(sbMain, (WheelDelta > 0));
748 Handled := True;
749 end;
750end;
751
[456]752procedure TfrmTemplateDialog.FieldChanged(Sender: TObject);
753begin
754 with TTemplateDialogEntry(Sender) do
755 TPanel(Obj).hint := GetText;
756end;
757
758procedure TfrmTemplateDialog.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
759var
760 Txt, tmp: string;
761 i, p1, p2: integer;
762 Save: boolean;
763
764begin
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
[829]789 ShowMsg(MissingFieldsTxt);
[456]790 break;
791 end;
792 end;
793 end;
794end;
795
796procedure TfrmTemplateDialog.btnOKClick(Sender: TObject);
797begin
798 FCheck4Required := TRUE;
799end;
800
801procedure TfrmTemplateDialog.btnPreviewClick(Sender: TObject);
802var
803 TmpSL: TStringList;
804
805begin
806 TmpSL := TStringList.Create;
807 try
[829]808 FastAssign(SL, TmpSL);
[456]809 GetText(TmpSL, FALSE); {FALSE = Do not include embedded fields}
[829]810 StripScreenReaderCodes(TmpSL);
[456]811 ReportBox(TmpSL, 'Dialog Preview', FALSE);
812 finally
813 TmpSL.Free;
814 end;
815end;
816
817procedure TfrmTemplateDialog.EntryDestroyed(Sender: TObject);
818var
819 idx: integer;
820
821begin
822 idx := Entries.IndexOf(TTemplateDialogEntry(Sender).ID);
823 if idx >= 0 then
824 Entries.delete(idx);
825end;
826
827procedure TfrmTemplateDialog.FormClose(Sender: TObject;
828 var Action: TCloseAction);
829begin
830 Application.OnShowHint := FOldHintEvent;
831 SaveUserBounds(Self);
832end;
833
834procedure TfrmTemplateDialog.SizeFormToCancelBtn;
835const
836 RIGHT_MARGIN = 12;
837var
838 minWidth : integer;
839begin
840 minWidth := btnCancel.Left + btnCancel.Width + RIGHT_MARGIN;
841 if minWidth > Self.Width then
842 Self.Width := minWidth;
843end;
844
[829]845procedure TfrmTemplateDialog.UMScreenReaderInit(var Message: TMessage);
846var
847 ctrl: TWinControl;
848 item: TVA508AccessibilityItem;
849begin
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;
860end;
861
[456]862end.
863
Note: See TracBrowser for help on using the repository browser.