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

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

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