source: cprs/branches/tmg-cprs/CPRS-Chart/Templates/fTemplateDialog.pas

Last change on this file was 735, checked in by Kevin Toppenberg, 14 years ago

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