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

Last change on this file since 1672 was 829, checked in by Kevin Toppenberg, 14 years ago

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