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

Last change on this file since 1388 was 735, checked in by Kevin Toppenberg, 16 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.