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

Last change on this file since 697 was 686, checked in by Kevin Toppenberg, 15 years ago

Fixed HTML Linked Template-Note Issue

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