Context Navigation

source: cprs/branches/tmg-cprs/CPRS-Chart/Templates/uTemplateFields.pas@ 699

Last change on this file since 699 was 694, checked in by Kevin Toppenberg, 15 years ago
Fixed HTML Template line feed issue
File size: 77.1 KB

Line
1	//kt -- Modified with SourceScanner on 8/8/2007
2	unit uTemplateFields;
3
4	interface
5
6	uses
7	Forms, SysUtils, StrUtils, Classes, Dialogs, StdCtrls, ExtCtrls, Controls, Contnrs,
8	Graphics, ORClasses, ComCtrls, ORDtTm;
9
10	type
11	TTemplateFieldType = (dftUnknown, dftEditBox, dftComboBox, dftButton, dftCheckBoxes,
12	dftRadioButtons, dftDate, dftNumber, dftHyperlink, dftWP, dftText);
13
14	TTmplFldDateType = (dtUnknown, dtDate, dtDateTime, dtDateReqTime,
15	dtCombo, dtYear, dtYearMonth);
16
17	const
18	FldItemTypes = [dftComboBox, dftButton, dftCheckBoxes, dftRadioButtons, dftWP, dftText];
19	SepLinesTypes = [dftCheckBoxes, dftRadioButtons];
20	EditLenTypes = [dftEditBox, dftComboBox, dftWP];
21	EditDfltTypes = [dftEditBox, dftHyperlink];
22	EditDfltType2 = [dftEditBox, dftHyperlink, dftDate];
23	ItemDfltTypes = [dftComboBox, dftButton, dftCheckBoxes, dftRadioButtons];
24	NoRequired = [dftHyperlink, dftText];
25	ExcludeText = [dftHyperlink, dftText];
26	DateComboTypes = [dtCombo, dtYear, dtYearMonth];
27
28	type
29	TTemplateDialogEntry = class(TObject)
30	private
31	FID: string;
32	FFont: TFont;
33	FPanel: TPanel;
34	FControls: TStringList;
35	FIndents: TStringList;
36	FFirstBuild: boolean;
37	FOnChange: TNotifyEvent;
38	FText: string;
39	FInternalID: string;
40	FObj: TObject;
41	FFieldValues: string;
42	FUpdating: boolean;
43	FAutoDestroyOnPanelFree: boolean;
44	FPanelDying: boolean;
45	FOnDestroy: TNotifyEvent;
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 KillLabels;
50	function GetFieldValues: string;
51	procedure SetFieldValues(const Value: string);
52	procedure SetAutoDestroyOnPanelFree(const Value: boolean);
53	procedure SetAnswerHTMLTag(Value : string); //kt 12/28/09
54
55	protected
56	procedure UpDownChange(Sender: TObject);
57	procedure DoChange(Sender: TObject);
58	function GetControlText(CtrlID: integer; NoCommas: boolean;
59	var FoundEntry: boolean; AutoWrap: boolean;
60	emField: string = ''): string;
61	procedure SetControlText(CtrlID: integer; AText: string);
62	public
63	constructor Create(AParent: TWinControl; AID, Text: string);
64	destructor Destroy; override;
65	function GetPanel(MaxLen: integer; AParent: TWinControl): TPanel;
66	function GetText: string;
67	property Text: string read FText write FText;
68	property InternalID: string read FInternalID write FInternalID;
69	property ID: string read FID;
70	property Obj: TObject read FObj write FObj;
71	property OnChange: TNotifyEvent read FOnChange write FOnChange;
72	property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
73	property FieldValues: string read GetFieldValues write SetFieldValues;
74	property HTMLMode : boolean read FHTMLMode write FHTMLMode; //kt added 12/28/09
75	property AnswerHTMLTag : string read FAnswerOpenTag write SetAnswerHTMLTag; //kt added 12/28/09
76	property AutoDestroyOnPanelFree: boolean read FAutoDestroyOnPanelFree
77	write SetAutoDestroyOnPanelFree;
78	end;
79
80	TTemplateField = class(TObject)
81	private
82	FMaxLen: integer;
83	FFldName: string;
84	FNameChanged: boolean;
85	FLMText: string;
86	FEditDefault: string;
87	FNotes: string;
88	FItems: string;
89	FInactive: boolean;
90	FItemDefault: string;
91	FFldType: TTemplateFieldType;
92	FRequired: boolean;
93	FSepLines: boolean;
94	FTextLen: integer;
95	FIndent: integer;
96	FPad: integer;
97	FMinVal: integer;
98	FMaxVal: integer;
99	FIncrement: integer;
100	FURL: string;
101	FDateType: TTmplFldDateType;
102	FModified: boolean;
103	FID: string;
104	FLocked: boolean;
105	procedure SetEditDefault(const Value: string);
106	procedure SetFldName(const Value: string);
107	procedure SetFldType(const Value: TTemplateFieldType);
108	procedure SetInactive(const Value: boolean);
109	procedure SetRequired(const Value: boolean);
110	procedure SetSepLines(const Value: boolean);
111	procedure SetItemDefault(const Value: string);
112	procedure SetItems(const Value: string);
113	procedure SetLMText(const Value: string);
114	procedure SetMaxLen(const Value: integer);
115	procedure SetNotes(const Value: string);
116	procedure SetID(const Value: string);
117	procedure SetIncrement(const Value: integer);
118	procedure SetIndent(const Value: integer);
119	procedure SetMaxVal(const Value: integer);
120	procedure SetMinVal(const Value: integer);
121	procedure SetPad(const Value: integer);
122	procedure SetTextLen(const Value: integer);
123	procedure SetURL(const Value: string);
124	function GetTemplateFieldDefault: string;
125	procedure CreateDialogControls(Entry: TTemplateDialogEntry;
126	var Index: Integer; CtrlID: integer);
127	function SaveError: string;
128	function Width: integer;
129	function GetRequired: boolean;
130	procedure SetDateType(const Value: TTmplFldDateType);
131	public
132	constructor Create(AData: TStrings);
133	destructor Destroy; override;
134	procedure Assign(AFld: TTemplateField);
135	function NewField: boolean;
136	function CanModify: boolean;
137	property ID: string read FID write SetID;
138	property FldName: string read FFldName write SetFldName;
139	property NameChanged: boolean read FNameChanged;
140	property FldType: TTemplateFieldType read FFldType write SetFldType;
141	property MaxLen: integer read FMaxLen write SetMaxLen;
142	property EditDefault: string read FEditDefault write SetEditDefault;
143	property Items: string read FItems write SetItems;
144	property ItemDefault: string read FItemDefault write SetItemDefault;
145	property LMText: string read FLMText write SetLMText;
146	property Inactive: boolean read FInactive write SetInactive;
147	property Required: boolean read GetRequired write SetRequired;
148	property SepLines: boolean read FSepLines write SetSepLines;
149	property TextLen: integer read FTextLen write SetTextLen;
150	property Indent: integer read FIndent write SetIndent;
151	property Pad: integer read FPad write SetPad;
152	property MinVal: integer read FMinVal write SetMinVal;
153	property MaxVal: integer read FMaxVal write SetMaxVal;
154	property Increment: integer read FIncrement write SetIncrement;
155	property URL: string read FURL write SetURL;
156	property DateType: TTmplFldDateType read FDateType write SetDateType;
157	property Notes: string read FNotes write SetNotes;
158	property TemplateFieldDefault: string read GetTemplateFieldDefault;
159	end;
160
161	TIntStruc = class(TObject)
162	public
163	x: integer;
164	end;
165
166	function GetDialogEntry(AParent: TWinControl; AID, AText: string): TTemplateDialogEntry;
167	procedure FreeEntries(SL: TStrings);
168	procedure AssignFieldIDs(var Txt: string); overload;
169	procedure AssignFieldIDs(SL: TStrings); overload;
170	//kt 12/28/09 originial --> function ResolveTemplateFields(Text: string; AutoWrap: boolean; Hidden: boolean = FALSE; IncludeEmbedded: boolean = FALSE): string;
171	function ResolveTemplateFields(Text: string;
172	AutoWrap: boolean;
173	Hidden: boolean = FALSE;
174	IncludeEmbedded: boolean = FALSE;
175	HTMLMode : boolean = FALSE; //kt added 12/28/09
176	HTMLAnswerOpenTag : string = ''; //kt added 12/28/09
177	HTMLAnswerCloseTag : string = '' //kt added 12/28/09
178	): string;
179	function AreTemplateFieldsRequired(const Text: string; FldValues: TORStringList = nil): boolean;
180	function HasTemplateField(txt: string): boolean;
181
182	function GetTemplateField(ATemplateField: string; ByIEN: boolean): TTemplateField;
183	function TemplateFieldNameProblem(Fld: TTemplateField): boolean;
184	function SaveTemplateFieldErrors: string;
185	procedure ClearModifiedTemplateFields;
186	function AnyTemplateFieldsModified: boolean;
187	procedure ListTemplateFields(const AText: string; AList: TStrings; ListErrors: boolean = FALSE);
188	function BoilerplateTemplateFieldsOK(const AText: string; Msg: string = ''): boolean;
189	procedure EnsureText(edt: TEdit; ud: TUpDown);
190	procedure ConvertCodes2Text(sl: TStrings; Short: boolean);
191	function StripEmbedded(iItems: string): string;
192
193	const
194	TemplateFieldBeginSignature = '{FLD:';
195	TemplateFieldEndSignature = '}';
196	HTMLBEGINNINGTAG = '{HTML:';
197	HTMLENDINGTAG = '}';
198	HTMLBEGINNINGTAGLEN = length(HTMLBEGINNINGTAG);
199	HTMLENDINGTAGLEN = length(HTMLENDINGTAG);
200	//MissingFieldsTxt = 'One or more required fields must still be entered.'; <-- original line. //kt 8/8/2007
201	function MissingFieldsTxt : string; //kt added
202
203	Const
204	TemplateFieldTypeCodes: array[TTemplateFieldType] of string[1] =
205	{ dftUnknown } ('',
206	{ dftEditBox } 'E',
207	{ dftComboBox } 'C',
208	{ dftButton } 'B',
209	{ dftCheckBoxes } 'X',
210	{ dftRadioButtons } 'R',
211	{ dftDate } 'D',
212	{ dftNumber } 'N',
213	{ dftHyperlink } 'H',
214	{ dftWP } 'W',
215	{ dftText } 'T');
216
217	function TemplateFieldTypeDesc(index: TTemplateFieldType; short : boolean) : string;
218	(* //kt replaced with function below
219	TemplateFieldTypeDesc: array[TTemplateFieldType, boolean] of string =
220	{ dftUnknown } (('',''),
221	{ dftEditBox } ('Edit Box', 'Edit'),
222	{ dftComboBox } ('Combo Box', 'Combo'),
223	{ dftButton } ('Button', 'Button'),
224	{ dftCheckBoxes } ('Check Boxes', 'Check'),
225	{ dftRadioButtons } ('Radio Buttons', 'Radio'),
226	{ dftDate } ('Date', 'Date'),
227	{ dftNumber } ('Number', 'Num'),
228	{ dftHyperlink } ('Hyperlink', 'Link'),
229	{ dftWP } ('Word Processing','WP'),
230	{ dftWP } ('Display Text', 'Text'));
231	*)
232
233	function TemplateDateTypeDesc(index: TTmplFldDateType; Short : boolean) : string;
234	(* //kt replaced with function below
235	TemplateDateTypeDesc: array[TTmplFldDateType, boolean] of string =
236	{ dtUnknown } (('',''),
237	// { dtDate } ('Date', 'Date'), <-- original line. //kt 8/8/2007
238	// { dtDateTime } ('Date & Time', 'Time'), <-- original line. //kt 8/8/2007
239	// { dtDateReqTime } ('Date & Req Time','R.Time'), <-- original line. //kt 8/8/2007
240	// { dtCombo } ('Date Combo', 'C.Date'), <-- original line. //kt 8/8/2007
241	// { dtYear } ('Year', 'Year'), <-- original line. //kt 8/8/2007
242	// { dtYearMonth } ('Year & Month', 'Month')); <-- original line. //kt 8/8/2007
243	*)
244
245	Const
246	FldNames: array[TTemplateFieldType] of string =
247	{ dftUnknown } ('',
248	{ dftEditBox } 'EDIT',
249	{ dftComboBox } 'LIST',
250	{ dftButton } 'BTTN',
251	{ dftCheckBoxes } 'CBOX',
252	{ dftRadioButtons } 'RBTN',
253	{ dftDate } 'DATE',
254	{ dftNumber } 'NUMB',
255	{ dftHyperlink } 'LINK',
256	{ dftWP } 'WRDP',
257	{ dftTExt } 'TEXT');
258
259	TemplateFieldDateCodes: array[TTmplFldDateType] of string[1] =
260	{ dtUnknown } ('',
261	{ dtDate } 'D',
262	{ dtDateTime } 'T',
263	{ dtDateReqTime } 'R',
264	{ dtCombo } 'C',
265	{ dtYear } 'Y',
266	{ dtYearMonth } 'M');
267
268	MaxTFWPLines = 20;
269	MaxTFEdtLen = 70;
270
271	type
272	TFieldPanel = class(TPanel) {This is the panel associated with the child}
273	private {dialog checkboxes in reminders dialogs}
274	FOnDestroy: TNotifyEvent;
275	FCanvas: TControlCanvas; {used to draw focus rect}
276	function GetFocus: boolean;
277	procedure SetTheFocus(const Value: boolean);
278	protected {used to draw focus rect}
279	procedure Paint; override; {used to draw focus rect}
280	public
281	destructor Destroy; override;
282	property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
283	property Focus: boolean read GetFocus write SetTheFocus; {to draw focus rect}
284	property OnKeyPress; {to click the checkbox when spacebar is pressed}
285	end;
286
287	implementation
288
289	uses
290	ORFn, rTemplates, ORCtrls, mTemplateFieldButton, dShared, uConst, uCore, rCore, Windows,
291	DKLang; //kt
292
293	const
294	NewTemplateField = 'NEW TEMPLATE FIELD';
295	TemplateFieldSignatureLen = length(TemplateFieldBeginSignature);
296	TemplateFieldSignatureEndLen = length(TemplateFieldEndSignature);
297
298
299	var
300	uTmplFlds: TList = nil;
301	uEntries: TStringList = nil;
302
303	uNewTemplateFieldIDCnt: longint = 0;
304	uRadioGroupIndex: integer = 0;
305
306	uInternalFieldIDCount: integer = 0;
307
308	const
309	FieldIDDelim = '`';
310	FieldIDLen = 6;
311	NewLine = 'NL';
312
313	type
314	TFieldLabel = class(TLabel)
315	private
316	FExclude: boolean;
317	public
318	property Exclude: boolean read FExclude;
319	end;
320
321	TWebLabel = class(TFieldLabel)
322	private
323	FAddr: string;
324	procedure Clicked(Sender: TObject);
325	public
326	procedure Init(Addr: string);
327	end;
328
329	function MissingFieldsTxt : string;
330	begin Result := DKLangConstW('uTemplateFields_One_or_more_required_fields_must_still_be_enteredx');
331	end;
332
333	//kt 8-17-07 Added to replace constant with function
334	function TemplateFieldTypeDesc(index: TTemplateFieldType; Short : boolean) : string;
335	begin
336	Result := '';
337	case index of
338	dftUnknown : Result := '';
339	dftEditBox : if not Short then Result := DKLangConstW('uTemplateFields_Edit_Box') else Result := DKLangConstW('uTemplateFields_Edit');
340	dftComboBox : if not Short then Result := DKLangConstW('uTemplateFields_Combo_Box') else Result := DKLangConstW('uTemplateFields_Combo');
341	dftButton : if not Short then Result := DKLangConstW('uTemplateFields_Button') else Result := DKLangConstW('uTemplateFields_Button');
342	dftCheckBoxes : if not Short then Result := DKLangConstW('uTemplateFields_Check_Boxes') else Result := DKLangConstW('uTemplateFields_Check');
343	dftRadioButtons : if not Short then Result := DKLangConstW('uTemplateFields_Radio_Buttons') else Result := DKLangConstW('uTemplateFields_Radio');
344	dftDate : if not Short then Result := DKLangConstW('uTemplateFields_Date') else Result := DKLangConstW('uTemplateFields_Date');
345	dftNumber : if not Short then Result := DKLangConstW('uTemplateFields_Number') else Result := DKLangConstW('uTemplateFields_Num');
346	dftHyperlink : if not Short then Result := DKLangConstW('uTemplateFields_Hyperlink') else Result := DKLangConstW('uTemplateFields_Link');
347	dftWP : if not Short then Result := DKLangConstW('uTemplateFields_Word_Processing') else Result := DKLangConstW('uTemplateFields_WP');
348	dftText : if not Short then Result := DKLangConstW('uTemplateFields_Display_Text') else Result := DKLangConstW('uTemplateFields_Text');
349	end; {case}
350	end;
351
352	//kt 8-17-07 Added to replace constant with function
353	function TemplateDateTypeDesc(index: TTmplFldDateType; Short : boolean) : string;
354	begin
355	Result := '';
356	case index of
357	dtUnknown : Result := '';
358	dtDate : if not Short then Result := DKLangConstW('uTemplateFields_Date') else Result := DKLangConstW('uTemplateFields_Date');
359	dtDateTime : if not Short then Result := DKLangConstW('uTemplateFields_Date_x_Time') else Result := DKLangConstW('uTemplateFields_Time');
360	dtDateReqTime : if not Short then Result := DKLangConstW('uTemplateFields_Date_x_Req_Time') else Result := DKLangConstW('uTemplateFields_RxTime');
361	dtCombo : if not Short then Result := DKLangConstW('uTemplateFields_Date_Combo') else Result := DKLangConstW('uTemplateFields_CxDate');
362	dtYear : if not Short then Result := DKLangConstW('uTemplateFields_Year') else Result := DKLangConstW('uTemplateFields_Year');
363	dtYearMonth : if not Short then Result := DKLangConstW('uTemplateFields_Year_x_Month') else Result := DKLangConstW('uTemplateFields_Month');
364	end; {case}
365	end;
366
367	function GetNewFieldID: string;
368	begin
369	inc(uInternalFieldIDCount);
370	Result := IntToStr(uInternalFieldIDCount);
371	Result := FieldIDDelim +
372	copy(StringOfChar('0', FieldIDLen-2) + Result, length(Result), FieldIDLen-1);
373	end;
374
375	function GetDialogEntry(AParent: TWinControl; AID, AText: string): TTemplateDialogEntry;
376	var
377	idx: integer;
378
379	begin
380	Result := nil;
381	if AID = '' then exit;
382	if(not assigned(uEntries)) then
383	uEntries := TStringList.Create;
384	idx := uEntries.IndexOf(AID);
385	if(idx < 0) then
386	begin
387	Result := TTemplateDialogEntry.Create(AParent, AID, AText);
388	uEntries.AddObject(AID, Result);
389	end
390	else
391	Result := TTemplateDialogEntry(uEntries.Objects[idx]);
392	end;
393
394	procedure FreeEntries(SL: TStrings);
395	var
396	i, idx, cnt: integer;
397
398	begin
399	if(assigned(uEntries)) then
400	begin
401	for i := SL.Count-1 downto 0 do
402	begin
403	idx := uEntries.IndexOf(SL[i]);
404	if(idx >= 0) then
405	begin
406	cnt := uEntries.Count;
407	if(assigned(uEntries.Objects[idx])) then
408	begin
409	TTemplateDialogEntry(uEntries.Objects[idx]).AutoDestroyOnPanelFree := FALSE;
410	uEntries.Objects[idx].Free;
411	end;
412	if cnt = uEntries.Count then
413	uEntries.Delete(idx);
414	end;
415	end;
416	if(uEntries.Count = 0) then
417	uInternalFieldIDCount := 0;
418	end;
419	end;
420
421	procedure AssignFieldIDs(var Txt: string);
422	var
423	i: integer;
424
425	begin
426	i := 0;
427	while (i < length(Txt)) do
428	begin
429	inc(i);
430	if(copy(Txt,i,TemplateFieldSignatureLen) = TemplateFieldBeginSignature) then
431	begin
432	inc(i,TemplateFieldSignatureLen);
433	if(i < length(Txt)) and (copy(Txt,i,1) <> FieldIDDelim) then
434	begin
435	insert(GetNewFieldID, Txt, i);
436	inc(i, FieldIDLen);
437	end;
438	end;
439	end;
440	end;
441
442	procedure AssignFieldIDs(SL: TStrings);
443	var
444	i: integer;
445	txt: string;
446
447	begin
448	for i := 0 to SL.Count-1 do
449	begin
450	txt := SL[i];
451	AssignFieldIDs(txt);
452	SL[i] := txt;
453	end;
454	end;
455
456	procedure WordWrapText(var Txt: string; HTMLMode : boolean);
457	var
458	TmpSL: TStringList;
459	i: integer;
460
461	function WrappedText(const Str: string; boolHTMLMode : boolean): string;
462	var
463	i, i2, j, k, m: integer;
464	HTMLStrLen : integer;
465	Temp, Temp1, Temp2: string;
466
467	begin
468	Temp := Str;
469	Result := '';
470	i2 := 0;
471
472	repeat
473	i := pos(TemplateFieldBeginSignature, Temp);
474
475	if i>0 then
476	j := pos(TemplateFieldEndSignature, copy(Temp, i, MaxInt))
477	else
478	j := 0;
479
480	if (j > 0) then
481	begin
482	i2 := pos(TemplateFieldBeginSignature, copy(Temp, i+TemplateFieldSignatureLen, MaxInt));
483	if (i2 = 0) then
484	i2 := MaxInt
485	else
486	i2 := i + TemplateFieldSignatureLen + i2 - 1;
487	end;
488
489	if (i>0) and (j=0) then
490	i := 0;
491
492	if (i>0) and (j>0) then
493	if (j > i2) then
494	begin
495	Result := Result + copy(Temp, 1, i2-1);
496	delete(Temp, 1, i2-1);
497	end
498	else
499	begin
500	for k := (i+TemplateFieldSignatureLen) to (i+j-2) do
501	if Temp[k]=' ' then
502	Temp[k]:= #1;
503	i := i + j - 1;
504	Result := Result + copy(Temp,1,i);
505	delete(Temp,1,i);
506	end;
507
508	until (i = 0);
509
510	Result := Result + Temp;
511
512	//Count the HTML tag length and add to MAX_ENTRY WIDTH elh 1-29-10
513	HTMLStrLen := 0;
514	if boolHTMLMode = True then begin
515	temp1 := Result;
516	while (pos('<',temp1)>0) and (pos('>',temp1)>0) do
517	begin
518	temp2 := MidStr(temp1,pos('<',temp1),pos('>',temp1)-pos('<',temp1)+1);
519	HTMLStrLen := HTMLStrLen + strlen(PChar(temp2));
520	temp1 := Rightstr(temp1,strlen(PChar(temp1))-pos('>',temp1));
521	end;
522	end;
523
524	Result := WrapText(Result, #13#10, [' '], MAX_ENTRY_WIDTH+HTMLStrLen); //added +HTMLStrLen elh 1-29-10
525	repeat
526	i := pos(#1, Result);
527	if i > 0 then
528	Result[i] := ' ';
529	until i = 0;
530	end;
531
532	begin
533	if length(Txt) > MAX_ENTRY_WIDTH then
534	begin
535	TmpSL := TStringList.Create;
536	try
537	TmpSL.Text := Txt;
538	Txt := '';
539	for i := 0 to TmpSL.Count-1 do
540	begin
541	if Txt <> '' then
542	Txt := Txt + CRLF;
543	Txt := Txt + WrappedText(TmpSL[i],HTMLMode);
544	end;
545	finally
546	TmpSL.Free;
547	end;
548	end;
549	end;
550
551	function ResolveTemplateFields(Text: string;
552	AutoWrap: boolean;
553	Hidden: boolean = FALSE;
554	IncludeEmbedded: boolean = FALSE;
555	HTMLMode : boolean = FALSE; //kt added 12/28/09
556	HTMLAnswerOpenTag : string = ''; //kt added 12/28/09
557	HTMLAnswerCloseTag : string = '' //kt added 12/28/09
558	): string;
559	var
560	flen, CtrlID, i, j: integer;
561	Entry: TTemplateDialogEntry;
562	iField, Temp, NewTxt, Fld: string;
563	FoundEntry: boolean;
564	TmplFld: TTemplateField;
565	tempSL : TStringList;
566
567	procedure AddNewTxt;
568	begin
569	if(NewTxt <> '') then
570	begin
571	insert(StringOfChar('x',length(NewTxt)), Temp, i);
572	insert(NewTxt, Result, i);
573	inc(i, length(NewTxt));
574	end;
575	end;
576
577	begin
578	if(not assigned(uEntries)) then
579	uEntries := TStringList.Create;
580	Result := Text;
581	Temp := Text; // Use Temp to allow template fields to contain other template field references
582	repeat
583	i := pos(TemplateFieldBeginSignature, Temp);
584	if(i > 0) then
585	begin
586	CtrlID := 0;
587	if(copy(Temp, i + TemplateFieldSignatureLen, 1) = FieldIDDelim) then
588	begin
589	CtrlID := StrToIntDef(copy(Temp, i + TemplateFieldSignatureLen + 1, FieldIDLen-1), 0);
590	delete(Temp,i + TemplateFieldSignatureLen, FieldIDLen);
591	delete(Result,i + TemplateFieldSignatureLen, FieldIDLen);
592	end;
593	j := pos(TemplateFieldEndSignature, copy(Temp, i + TemplateFieldSignatureLen, MaxInt));
594	Fld := '';
595	if(j > 0) then
596	begin
597	inc(j, i + TemplateFieldSignatureLen - 1);
598	flen := j - i - TemplateFieldSignatureLen;
599	Fld := copy(Temp,i + TemplateFieldSignatureLen, flen);
600	delete(Temp,i,flen + TemplateFieldSignatureLen + 1);
601	delete(Result,i,flen + TemplateFieldSignatureLen + 1);
602	end
603	else
604	begin
605	delete(Temp,i,TemplateFieldSignatureLen);
606	delete(Result,i,TemplateFieldSignatureLen);
607	end;
608	if(CtrlID > 0) then
609	begin
610	FoundEntry := FALSE;
611	for j := 0 to uEntries.Count-1 do
612	begin
613	Entry := TTemplateDialogEntry(uEntries.Objects[j]);
614	if(assigned(Entry)) then
615	begin
616	if IncludeEmbedded then
617	iField := Fld
618	else
619	iField := '';
620	NewTxt := Entry.GetControlText(CtrlID, FALSE, FoundEntry, AutoWrap, iField);
621	TmplFld := GetTemplateField(Fld, FALSE);
622	if (assigned(TmplFld)) and (TmplFld.DateType in DateComboTypes) then {if this is a TORDateBox}
623	NewTxt := Piece(NewTxt,':',1); {we only want the first piece of NewTxt}
624	//kt 12/28/09 --- Start mod to wrap answers in custom HTML tag ---
625	if (HTMLMode=true) and (NewTxt <> '') then begin
626	NewTxt := HTMLAnswerOpenTag + NewTxt + HTMLAnswerCloseTag; //kt 12/29/09
627	end;
628	//kt --- End mod to wrap answers in custom HTML tag ---
629	AddNewTxt;
630	end;
631	if FoundEntry then break;
632	end;
633	if Hidden and (not FoundEntry) and (Fld <> '') then
634	begin
635	NewTxt := TemplateFieldBeginSignature + Fld + TemplateFieldEndSignature;
636	AddNewTxt;
637	end;
638	end;
639	end else begin
640	if HTMLMode=true then begin
641	tempSL := TStringList.create;
642	tempSL.Text := Result;
643	if tempSL.Count < 3 then begin
644	Result := HTMLAnswerOpenTag + Result + HTMLAnswerCloseTag;
645	end;
646	tempSL.Free;
647	end;
648	end;
649	until(i = 0);
650	if not AutoWrap then
651	WordWrapText(Result,HTMLMode);
652
653	end;
654
655	function AreTemplateFieldsRequired(const Text: string; FldValues: TORStringList = nil): boolean;
656	var
657	flen, CtrlID, i, j: integer;
658	Entry: TTemplateDialogEntry;
659	Fld: TTemplateField;
660	Temp, NewTxt, FldName: string;
661	FoundEntry: boolean;
662
663	begin
664	if(not assigned(uEntries)) then
665	uEntries := TStringList.Create;
666	Temp := Text;
667	Result := FALSE;
668	repeat
669	i := pos(TemplateFieldBeginSignature, Temp);
670	if(i > 0) then
671	begin
672	CtrlID := 0;
673	if(copy(Temp, i + TemplateFieldSignatureLen, 1) = FieldIDDelim) then
674	begin
675	CtrlID := StrToIntDef(copy(Temp, i + TemplateFieldSignatureLen + 1, FieldIDLen-1), 0);
676	delete(Temp,i + TemplateFieldSignatureLen, FieldIDLen);
677	end;
678	j := pos(TemplateFieldEndSignature, copy(Temp, i + TemplateFieldSignatureLen, MaxInt));
679	if(j > 0) then
680	begin
681	inc(j, i + TemplateFieldSignatureLen - 1);
682	flen := j - i - TemplateFieldSignatureLen;
683	FldName := copy(Temp, i + TemplateFieldSignatureLen, flen);
684	Fld := GetTemplateField(FldName, FALSE);
685	delete(Temp,i,flen + TemplateFieldSignatureLen + 1);
686	end
687	else
688	begin
689	delete(Temp,i,TemplateFieldSignatureLen);
690	Fld := nil;
691	end;
692	if(CtrlID > 0) and (assigned(Fld)) and (Fld.Required) then
693	begin
694	FoundEntry := FALSE;
695	for j := 0 to uEntries.Count-1 do
696	begin
697	Entry := TTemplateDialogEntry(uEntries.Objects[j]);
698	if(assigned(Entry)) then
699	begin
700	NewTxt := Entry.GetControlText(CtrlID, TRUE, FoundEntry, FALSE);
701	if FoundEntry and (NewTxt = '') then
702	Result := TRUE;
703	end;
704	if FoundEntry then break;
705	end;
706	if (not FoundEntry) and assigned(FldValues) then
707	begin
708	j := FldValues.IndexOfPiece(IntToStr(CtrlID));
709	if(j < 0) or (Piece(FldValues[j],U,2) = '') then
710	Result := TRUE;
711	end;
712	end;
713	end;
714	until((i = 0) or Result);
715	end;
716
717	function HasTemplateField(txt: string): boolean;
718	begin
719	Result := (pos(TemplateFieldBeginSignature, txt) > 0);
720	end;
721
722	function GetTemplateField(ATemplateField: string; ByIEN: boolean): TTemplateField;
723	var
724	i, idx: integer;
725	AData: TStrings;
726
727	begin
728	Result := nil;
729	if(not assigned(uTmplFlds)) then
730	uTmplFlds := TList.Create;
731	idx := -1;
732	for i := 0 to uTmplFlds.Count-1 do
733	begin
734	if(ByIEN) then
735	begin
736	if(TTemplateField(uTmplFlds[i]).FID = ATemplateField) then
737	begin
738	idx := i;
739	break;
740	end;
741	end
742	else
743	begin
744	if(TTemplateField(uTmplFlds[i]).FFldName = ATemplateField) then
745	begin
746	idx := i;
747	break;
748	end;
749	end;
750	end;
751	if(idx < 0) then
752	begin
753	if(ByIEN) then
754	AData := LoadTemplateFieldByIEN(ATemplateField)
755	else
756	AData := LoadTemplateField(ATemplateField);
757	if(AData.Count > 1) then
758	Result := TTemplateField.Create(AData);
759	end
760	else
761	Result := TTemplateField(uTmplFlds[idx]);
762	end;
763
764	function TemplateFieldNameProblem(Fld: TTemplateField): boolean;
765	//const
766	//DUPFLD = 'Field Name is not unique'; <-- original line. //kt 8/8/2007
767
768	var
769	i: integer;
770	msg: string;
771	DUPFLD : string; //kt
772
773	begin
774	DUPFLD := DKLangConstW('uTemplateFields_Field_Name_is_not_unique'); //kt added 8/8/2007
775	msg := '';
776	if(Fld.FldName = NewTemplateField) then
777	// msg := 'Field Name can not be ' + NewTemplateField <-- original line. //kt 8/8/2007
778	msg := DKLangConstW('uTemplateFields_Field_Name_can_not_be') + NewTemplateField //kt added 8/8/2007
779	else
780	if(length(Fld.FldName) < 3) then
781	// msg := 'Field Name must be at least three characters in length' <-- original line. //kt 8/8/2007
782	msg := DKLangConstW('uTemplateFields_Field_Name_must_be_at_least_three_characters_in_length') //kt added 8/8/2007
783	else
784	if(not (Fld.FldName[1] in ['A'..'Z','0'..'9'])) then
785	// msg := 'First Field Name character must be "A" - "Z", or "0" - "9"' <-- original line. //kt 8/8/2007
786	msg := DKLangConstW('uTemplateFields_First_Field_Name_character_must_be_xAx_x_xZxx_or_x0x_x_x9x') //kt added 8/8/2007
787	else
788	if(assigned(uTmplFlds)) then
789	begin
790	for i := 0 to uTmplFlds.Count-1 do
791	begin
792	if(Fld <> uTmplFlds[i]) and
793	(CompareText(TTemplateField(uTmplFlds[i]).FFldName, Fld.FFldName) = 0) then
794	begin
795	msg := DUPFLD;
796	break;
797	end;
798	end;
799	end;
800	if(msg = '') and (not IsTemplateFieldNameUnique(Fld.FFldName, Fld.ID)) then
801	msg := DUPFLD;
802	Result := (msg <> '');
803	if(Result) then
804	ShowMessage(msg);
805	end;
806
807	function SaveTemplateFieldErrors: string;
808	var
809	i: integer;
810	Errors: TStringList;
811	Fld: TTemplateField;
812	msg: string;
813
814	begin
815	Result := '';
816	if(assigned(uTmplFlds)) then
817	begin
818	Errors := nil;
819	try
820	for i := 0 to uTmplFlds.Count-1 do
821	begin
822	Fld := TTemplateField(uTmplFlds[i]);
823	if(Fld.FModified) then
824	begin
825	msg := Fld.SaveError;
826	if(msg <> '') then
827	begin
828	if(not assigned(Errors)) then
829	begin
830	Errors := TStringList.Create;
831	// Errors.Add('The following template field save errors have occurred:'); <-- original line. //kt 8/8/2007
832	Errors.Add(DKLangConstW('uTemplateFields_The_following_template_field_save_errors_have_occurredx')); //kt added 8/8/2007
833	Errors.Add('');
834	end;
835	Errors.Add(' ' + Fld.FldName + ': ' + msg);
836	end;
837	end;
838	end;
839	finally
840	if(assigned(Errors)) then
841	begin
842	Result := Errors.Text;
843	Errors.Free;
844	end;
845	end;
846	end;
847	end;
848
849	procedure ClearModifiedTemplateFields;
850	var
851	i: integer;
852	Fld: TTemplateField;
853
854	begin
855	if(assigned(uTmplFlds)) then
856	begin
857	for i := uTmplFlds.Count-1 downto 0 do
858	begin
859	Fld := TTemplateField(uTmplFlds[i]);
860	if(assigned(Fld)) and (Fld.FModified) then
861	begin
862	if Fld.FLocked then
863	UnlockTemplateField(Fld.FID);
864	Fld.Free;
865	end;
866	end;
867	end;
868	end;
869
870	function AnyTemplateFieldsModified: boolean;
871	var
872	i: integer;
873
874	begin
875	Result := FALSE;
876	if(assigned(uTmplFlds)) then
877	begin
878	for i := 0 to uTmplFlds.Count-1 do
879	begin
880	if(TTemplateField(uTmplFlds[i]).FModified) then
881	begin
882	Result := TRUE;
883	break;
884	end;
885	end;
886	end;
887	end;
888
889	procedure ListTemplateFields(const AText: string; AList: TStrings; ListErrors: boolean = FALSE);
890	var
891	i, j, k, flen, BadCount: integer;
892	flddesc, tmp, fld: string;
893	TmpList: TStringList;
894	InactiveList: TStringList;
895	FldObj: TTemplateField;
896
897	begin
898	if(AText = '') then exit;
899	BadCount := 0;
900	InactiveList := TStringList.Create;
901	try
902	TmpList := TStringList.Create;
903	try
904	TmpList.Text := AText;
905	for k := 0 to TmpList.Count-1 do
906	begin
907	tmp := TmpList[k];
908	repeat
909	i := pos(TemplateFieldBeginSignature, tmp);
910	if(i > 0) then
911	begin
912	fld := '';
913	j := pos(TemplateFieldEndSignature, copy(tmp, i + TemplateFieldSignatureLen, MaxInt));
914	if(j > 0) then
915	begin
916	inc(j, i + TemplateFieldSignatureLen - 1);
917	flen := j - i - TemplateFieldSignatureLen;
918	fld := copy(tmp,i + TemplateFieldSignatureLen, flen);
919	delete(tmp, i, flen + TemplateFieldSignatureLen + 1);
920	end
921	else
922	begin
923	delete(tmp,i,TemplateFieldSignatureLen);
924	inc(BadCount);
925	end;
926	if(fld <> '') then
927	begin
928	if ListErrors then
929	begin
930	FldObj := GetTemplateField(fld, FALSE);
931	if assigned(FldObj) then
932	begin
933	if FldObj.Inactive then
934	InactiveList.Add(' "' + fld + '"');
935	flddesc := '';
936	end
937	else
938	flddesc := ' "' + fld + '"';
939	end
940	else
941	flddesc := fld;
942	if(flddesc <> '') and (AList.IndexOf(flddesc) < 0) then
943	AList.Add(flddesc)
944	end;
945	end;
946	until (i = 0);
947	end;
948	finally
949	TmpList.Free;
950	end;
951	if ListErrors then
952	begin
953	if(AList.Count > 0) then
954	// AList.Insert(0, 'The following template fields were not found:'); <-- original line. //kt 8/8/2007
955	AList.Insert(0, DKLangConstW('uTemplateFields_The_following_template_fields_were_not_foundx')); //kt added 8/8/2007
956	if (BadCount > 0) then
957	begin
958	if(BadCount = 1) then
959	// tmp := 'A template field marker "' + TemplateFieldBeginSignature + <-- original line. //kt 8/8/2007
960	tmp := DKLangConstW('uTemplateFields_A_template_field_marker_x') + TemplateFieldBeginSignature + //kt added 8/8/2007
961	// '" was found without a' <-- original line. //kt 8/8/2007
962	DKLangConstW('uTemplateFields_x_was_found_without_a') //kt added 8/8/2007
963	else
964	// tmp := IntToStr(BadCount) + ' template field markers "' + TemplateFieldBeginSignature + <-- original line. //kt 8/8/2007
965	tmp := IntToStr(BadCount) + DKLangConstW('uTemplateFields_template_field_markers_x') + TemplateFieldBeginSignature + //kt added 8/8/2007
966	// '" were found without'; <-- original line. //kt 8/8/2007
967	DKLangConstW('uTemplateFields_x_were_found_without'); //kt added 8/8/2007
968	if(AList.Count > 0) then
969	AList.Add('');
970	// AList.Add(tmp + ' matching "' + TemplateFieldEndSignature + '"'); <-- original line. //kt 8/8/2007
971	AList.Add(tmp + DKLangConstW('uTemplateFields_matching_x') + TemplateFieldEndSignature + '"'); //kt added 8/8/2007
972	end;
973	if(InactiveList.Count > 0) then
974	begin
975	if(AList.Count > 0) then
976	AList.Add('');
977	// AList.Add('The following inactive template fields were found:'); <-- original line. //kt 8/8/2007
978	AList.Add(DKLangConstW('uTemplateFields_The_following_inactive_template_fields_were_foundx')); //kt added 8/8/2007
979	AList.AddStrings(InactiveList);
980	end;
981	if(AList.Count > 0) then
982	begin
983	// AList.Insert(0, 'Text contains template field errors:'); <-- original line. //kt 8/8/2007
984	AList.Insert(0, DKLangConstW('uTemplateFields_Text_contains_template_field_errorsx')); //kt added 8/8/2007
985	AList.Insert(1, '');
986	end;
987	end;
988	finally
989	InactiveList.Free;
990	end;
991	end;
992
993	function BoilerplateTemplateFieldsOK(const AText: string; Msg: string = ''): boolean;
994	var
995	Errors: TStringList;
996	btns: TMsgDlgButtons;
997
998	begin
999	Result := TRUE;
1000	Errors := TStringList.Create;
1001	try
1002	ListTemplateFields(AText, Errors, TRUE);
1003	if(Errors.Count > 0) then
1004	begin
1005	if(Msg = 'OK') then
1006	btns := [mbOK]
1007	else
1008	begin
1009	btns := [mbAbort, mbIgnore];
1010	Errors.Add('');
1011	if(Msg = '') then
1012	// Msg := 'text insertion'; <-- original line. //kt 8/8/2007
1013	Msg := DKLangConstW('uTemplateFields_text_insertion'); //kt added 8/8/2007
1014	// Errors.Add('Do you want to Abort ' + Msg + ', or Ignore the error and continue?'); <-- original line. //kt 8/8/2007
1015	Errors.Add(DKLangConstW('uTemplateFields_Do_you_want_to_Abort')+' ' + Msg + DKLangConstW('uTemplateFields_x_or_Ignore_the_error_and_continuex')); //kt added 8/8/2007
1016	end;
1017	Result := (MessageDlg(Errors.Text, mtError, btns, 0) = mrIgnore);
1018	end;
1019	finally
1020	Errors.Free;
1021	end;
1022	end;
1023
1024	procedure EnsureText(edt: TEdit; ud: TUpDown);
1025	var
1026	v: integer;
1027	s: string;
1028
1029	begin
1030	if assigned(ud.Associate) then
1031	begin
1032	v := StrToIntDef(edt.Text, ud.Position);
1033	if (v < ud.Min) or (v > ud.Max) then
1034	v := ud.Position;
1035	s := IntToStr(v);
1036	if edt.Text <> s then
1037	edt.Text := s;
1038	end;
1039	edt.SelStart := edt.GetTextLen;
1040	end;
1041
1042	function TemplateFieldCode2Field(const Code: string): TTemplateFieldType;
1043	var
1044	typ: TTemplateFieldType;
1045
1046	begin
1047	Result := dftUnknown;
1048	for typ := low(TTemplateFieldType) to high(TTemplateFieldType) do
1049	if Code = TemplateFieldTypeCodes[typ] then
1050	begin
1051	Result := typ;
1052	break;
1053	end;
1054	end;
1055
1056	function TemplateDateCode2DateType(const Code: string): TTmplFldDateType;
1057	var
1058	typ: TTmplFldDateType;
1059
1060	begin
1061	Result := dtUnknown;
1062	for typ := low(TTmplFldDateType) to high(TTmplFldDateType) do
1063	if Code = TemplateFieldDateCodes[typ] then
1064	begin
1065	Result := typ;
1066	break;
1067	end;
1068	end;
1069
1070	procedure ConvertCodes2Text(sl: TStrings; Short: boolean);
1071	var
1072	i: integer;
1073	tmp, output: string;
1074	ftype: TTemplateFieldType;
1075	dtype: TTmplFldDateType;
1076
1077	begin
1078	for i := 0 to sl.Count-1 do
1079	begin
1080	tmp := sl[i];
1081	if piece(tmp,U,4) = BOOLCHAR[TRUE] then
1082	output := '* '
1083	else
1084	output := ' ';
1085	ftype := TemplateFieldCode2Field(Piece(tmp, U, 3));
1086	if ftype = dftDate then
1087	begin
1088	dtype := TemplateDateCode2DateType(Piece(tmp, U, 5));
1089	//kt output := output + TemplateDateTypeDesc[dtype, short];
1090	output := output + TemplateDateTypeDesc(dtype, short);
1091	end
1092	else
1093	//kt output := output + TemplateFieldTypeDesc[ftype, short];
1094	output := output + TemplateFieldTypeDesc(ftype, short);
1095	SetPiece(tmp, U, 3, output);
1096	sl[i] := tmp;
1097	end;
1098	end;
1099
1100	{ TTemplateField }
1101
1102	constructor TTemplateField.Create(AData: TStrings);
1103	var
1104	tmp, p1: string;
1105	AFID, i,idx,cnt: integer;
1106
1107	begin
1108	AFID := 0;
1109	if(assigned(AData)) then
1110	begin
1111	if AData.Count > 0 then
1112	AFID := StrToIntDef(AData[0],0);
1113	if(AFID > 0) and (AData.Count > 1) then
1114	begin
1115	FID := IntToStr(AFID);
1116	FFldName := Piece(AData[1],U,1);
1117	FFldType := TemplateFieldCode2Field(Piece(AData[1],U,2));
1118	FInactive := (Piece(AData[1],U,3) = '1');
1119	FMaxLen := StrToIntDef(Piece(AData[1],U,4),0);
1120	FEditDefault := Piece(AData[1],U,5);
1121	FLMText := Piece(AData[1],U,6);
1122	idx := StrToIntDef(Piece(AData[1],U,7),0);
1123	cnt := 0;
1124	for i := 2 to AData.Count-1 do
1125	begin
1126	tmp := AData[i];
1127	p1 := Piece(tmp,U,1);
1128	tmp := Piece(tmp,U,2);
1129	if(p1 = 'D') then
1130	FNotes := FNotes + tmp + CRLF
1131	else
1132	if(p1 = 'U') then
1133	FURL := tmp
1134	else
1135	if(p1 = 'I') then
1136	begin
1137	inc(cnt);
1138	FItems := FItems + tmp + CRLF;
1139	if(cnt=idx) then
1140	FItemDefault := tmp;
1141	end;
1142	end;
1143	FRequired := (Piece(AData[1],U,8) = '1');
1144	FSepLines := (Piece(AData[1],U,9) = '1');
1145	FTextLen := StrToIntDef(Piece(AData[1],U,10),0);
1146	FIndent := StrToIntDef(Piece(AData[1],U,11),0);
1147	FPad := StrToIntDef(Piece(AData[1],U,12),0);
1148	FMinVal := StrToIntDef(Piece(AData[1],U,13),0);
1149	FMaxVal := StrToIntDef(Piece(AData[1],U,14),0);
1150	FIncrement := StrToIntDef(Piece(AData[1],U,15),0);
1151	FDateType := TemplateDateCode2DateType(Piece(AData[1],U,16));
1152	FModified := FALSE;
1153	FNameChanged := FALSE;
1154	end;
1155	end;
1156	if(AFID = 0) then
1157	begin
1158	inc(uNewTemplateFieldIDCnt);
1159	FID := IntToStr(-uNewTemplateFieldIDCnt);
1160	FFldName := NewTemplateField;
1161	FModified := TRUE;
1162	end;
1163	if(not assigned(uTmplFlds)) then
1164	uTmplFlds := TList.Create;
1165	uTmplFlds.Add(Self);
1166	end;
1167
1168	function TTemplateField.GetTemplateFieldDefault: string;
1169	begin
1170	case FFldType of
1171	dftEditBox, dftNumber: Result := FEditDefault;
1172
1173	dftComboBox,
1174	dftButton,
1175	dftCheckBoxes, {Clear out embedded fields}
1176	dftRadioButtons: Result := StripEmbedded(FItemDefault);
1177
1178	dftDate: if FEditDefault <> '' then Result := FEditDefault;
1179
1180	dftHyperlink, dftText: if FEditDefault <> '' then
1181	Result := StripEmbedded(FEditDefault)
1182	else
1183	Result := URL;
1184
1185	dftWP: Result := Items;
1186	end;
1187	end;
1188
1189	procedure TTemplateField.CreateDialogControls(Entry: TTemplateDialogEntry;
1190	var Index: Integer; CtrlID: integer);
1191
1192	var
1193	i, Aht, w, tmp, AWdth: integer;
1194	STmp: string;
1195	TmpSL: TStringList;
1196	edt: TEdit;
1197	cbo: TORComboBox;
1198	cb: TORCheckBox;
1199	btn: TfraTemplateFieldButton;
1200	dbox: TORDateBox;
1201	dcbo: TORDateCombo;
1202	lbl: TFieldLabel;
1203	re: TRichEdit;
1204	pnl: TPanel;
1205	ud: TUpDown;
1206	DefDate: TFMDateTime;
1207	ctrl: TControl;
1208
1209	function wdth: integer;
1210	begin
1211	if(Awdth < 0) then
1212	Awdth := FontWidthPixel(Entry.FFont.Handle);
1213	Result := Awdth;
1214	end;
1215
1216	function ht: integer;
1217	begin
1218	if(Aht < 0) then
1219	Aht := FontHeightPixel(Entry.FFont.Handle);
1220	Result := Aht;
1221	end;
1222
1223	procedure UpdateIndents(AControl: TControl);
1224	var
1225	idx: integer;
1226
1227	begin
1228	if (FIndent > 0) or (FPad > 0) then
1229	begin
1230	idx := Entry.FIndents.IndexOfObject(AControl);
1231	if idx < 0 then
1232	Entry.FIndents.AddObject(IntToStr(FIndent * wdth) + U + IntToStr(FPad), AControl);
1233	end;
1234	end;
1235
1236	begin
1237	if(not FInactive) and (FFldType <> dftUnknown) then
1238	begin
1239	AWdth := -1;
1240	Aht := -1;
1241	ctrl := nil;
1242
1243	case FFldType of
1244	dftEditBox:
1245	begin
1246	edt := TEdit.Create(nil);
1247	edt.Parent := Entry.FPanel;
1248	edt.BorderStyle := bsNone;
1249	edt.Height := ht;
1250	edt.Width := (wdth * Width + 4);
1251	if FTextLen > 0 then
1252	edt.MaxLength := FTextLen
1253	else
1254	edt.MaxLength := FMaxLen;
1255	edt.Text := FEditDefault;
1256	edt.Tag := CtrlID;
1257	edt.OnChange := Entry.DoChange;
1258	ctrl := edt;
1259	end;
1260
1261	dftComboBox:
1262	begin
1263	cbo := TORComboBox.Create(nil);
1264	cbo.Parent := Entry.FPanel;
1265	cbo.TemplateField := TRUE;
1266	w := Width;
1267	cbo.MaxLength := w;
1268	if FTextLen > 0 then
1269	cbo.MaxLength := FTextLen
1270	else
1271	cbo.ListItemsOnly := TRUE;
1272	{Clear out embedded fields}
1273	cbo.Items.Text := StripEmbedded(Items);
1274	cbo.SelectByID(StripEmbedded(FItemDefault));
1275	cbo.Tag := CtrlID;
1276	cbo.OnClick := Entry.DoChange;
1277
1278	if cbo.Items.Count > 12 then
1279	begin
1280	cbo.Width := (wdth * w) + ScrollBarWidth + 8;
1281	cbo.DropDownCount := 12;
1282	end
1283	else
1284	begin
1285	cbo.Width := (wdth * w) + 18;
1286	cbo.DropDownCount := cbo.Items.Count;
1287	end;
1288	ctrl := cbo;
1289	end;
1290
1291	dftButton:
1292	begin
1293	btn := TfraTemplateFieldButton.Create(nil);
1294	btn.Parent := Entry.FPanel;
1295	{Clear out embedded fields}
1296	btn.Items.Text := StripEmbedded(Items);
1297	btn.ButtonText := StripEmbedded(FItemDefault);
1298	btn.Height := ht;
1299	btn.Width := (wdth * Width) + 6;
1300	btn.Tag := CtrlID;
1301	btn.OnChange := Entry.DoChange;
1302	ctrl := btn;
1303	end;
1304
1305	dftCheckBoxes, dftRadioButtons:
1306	begin
1307	if FFldType = dftRadioButtons then
1308	inc(uRadioGroupIndex);
1309	TmpSL := TStringList.Create;
1310	try
1311	{Clear out embedded fields}
1312	TmpSL.Text := StripEmbedded(Items);
1313	for i := 0 to TmpSL.Count-1 do
1314	begin
1315	cb := TORCheckBox.Create(nil);
1316	cb.Parent := Entry.FPanel;
1317	cb.Caption := TmpSL[i];
1318	cb.AutoSize := TRUE;
1319	cb.AutoAdjustSize;
1320	// cb.AutoSize := FALSE;
1321	// cb.Height := ht;
1322	if FFldType = dftRadioButtons then
1323	begin
1324	cb.GroupIndex := uRadioGroupIndex;
1325	cb.RadioStyle := TRUE;
1326	end;
1327	if(TmpSL[i] = StripEmbedded(FItemDefault)) then
1328	cb.Checked := TRUE;
1329	cb.Tag := CtrlID;
1330	if FSepLines and (FFldType in SepLinesTypes) then
1331	cb.StringData := NewLine;
1332	cb.OnClick := Entry.DoChange;
1333	inc(Index);
1334	Entry.FControls.InsertObject(Index, '', cb);
1335	if (i=0) or FSepLines then
1336	UpdateIndents(cb);
1337	end;
1338	finally
1339	TmpSL.Free;
1340	end;
1341	end;
1342
1343	dftDate:
1344	begin
1345	if FEditDefault <> '' then
1346	DefDate := StrToFMDateTime(FEditDefault)
1347	else
1348	DefDate := 0;
1349	if FDateType in DateComboTypes then
1350	begin
1351	dcbo := TORDateCombo.Create(nil);
1352	dcbo.Parent := Entry.FPanel;
1353	dcbo.Tag := CtrlID;
1354	dcbo.IncludeBtn := (FDateType = dtCombo);
1355	dcbo.IncludeDay := (FDateType = dtCombo);
1356	dcbo.IncludeMonth := (FDateType <> dtYear);
1357	dcbo.FMDate := DefDate;
1358	dcbo.TemplateField := TRUE;
1359	dcbo.OnChange := Entry.DoChange;
1360	ctrl := dcbo;
1361	end
1362	else
1363	begin
1364	dbox := TORDateBox.Create(nil);
1365	dbox.Parent := Entry.FPanel;
1366	dbox.Tag := CtrlID;
1367	dbox.DateOnly := (FDateType = dtDate);
1368	dbox.RequireTime := (FDateType = dtDateReqTime);
1369	dbox.TemplateField := TRUE;
1370	dbox.FMDateTime := DefDate;
1371	if (FDateType = dtDate) then
1372	tmp := 11
1373	else
1374	tmp := 17;
1375	dbox.Width := (wdth * tmp) + 18;
1376	dbox.OnChange := Entry.DoChange;
1377	ctrl := dbox;
1378	end;
1379	end;
1380
1381	dftNumber:
1382	begin
1383	pnl := TPanel.Create(nil);
1384	pnl.Parent := Entry.FPanel;
1385	pnl.BevelOuter := bvNone;
1386	pnl.Tag := CtrlID;
1387	edt := TEdit.Create(pnl);
1388	edt.Parent := pnl;
1389	edt.BorderStyle := bsNone;
1390	edt.Height := ht;
1391	edt.Width := (wdth * 5 + 4);
1392	edt.Top := 0;
1393	edt.Left := 0;
1394	edt.AutoSelect := True;
1395	ud := TUpDown.Create(pnl);
1396	ud.Parent := pnl;
1397	ud.Associate := edt;
1398	ud.Min := MinVal;
1399	ud.Max := MaxVal;
1400	ud.Min := MinVal; // Both ud.Min settings are needeed!
1401	i := Increment;
1402	if i < 1 then i := 1;
1403	ud.Increment := i;
1404	ud.Thousands := FALSE;
1405	ud.Position := StrToIntDef(EditDefault, 0);
1406	edt.Tag := Integer(ud);
1407	edt.OnChange := Entry.UpDownChange;
1408	pnl.Height := edt.Height;
1409	pnl.Width := edt.Width + ud.Width;
1410	ctrl := pnl;
1411	end;
1412
1413	dftHyperlink, dftText:
1414	begin
1415	if (FFldType = dftHyperlink) and User.WebAccess then
1416	lbl := TWebLabel.Create(nil)
1417	else
1418	lbl := TFieldLabel.Create(nil);
1419	lbl.Parent := Entry.FPanel;
1420	lbl.ShowAccelChar := FALSE;
1421	lbl.FExclude := FSepLines;
1422	if (FFldType = dftHyperlink) then
1423	begin
1424	if FEditDefault <> '' then
1425	lbl.Caption := StripEmbedded(FEditDefault)
1426	else
1427	lbl.Caption := URL;
1428	end
1429	else
1430	begin
1431	STmp := StripEmbedded(Items);
1432	if copy(STmp,length(STmp)-1,2) = CRLF then
1433	delete(STmp,length(STmp)-1,2);
1434	lbl.Caption := STmp;
1435	end;
1436	if lbl is TWebLabel then
1437	TWebLabel(lbl).Init(FURL);
1438	lbl.Tag := CtrlID;
1439	ctrl := lbl;
1440	end;
1441
1442	dftWP:
1443	begin
1444	re := TRichEdit.Create(nil);
1445	re.Parent := Entry.FPanel;
1446	re.Tag := CtrlID;
1447	tmp := FMaxLen;
1448	if tmp < 5 then
1449	tmp := 5;
1450	re.Width := wdth * tmp;
1451	tmp := FTextLen;
1452	if tmp < 2 then
1453	tmp := 2
1454	else
1455	if tmp > MaxTFWPLines then
1456	tmp := MaxTFWPLines;
1457	re.Height := ht * tmp;
1458	re.BorderStyle := bsNone;
1459	re.ScrollBars := ssVertical;
1460	re.Lines.Text := Items;
1461	re.OnChange := Entry.DoChange;
1462	ctrl := re;
1463	end;
1464	end;
1465	if assigned(ctrl) then
1466	begin
1467	inc(Index);
1468	Entry.FControls.InsertObject(Index, '', ctrl);
1469	UpdateIndents(ctrl);
1470	end;
1471	end;
1472	end;
1473
1474	function TTemplateField.CanModify: boolean;
1475	begin
1476	if((not FModified) and (not FLocked) and (StrToIntDef(FID,0) > 0)) then
1477	begin
1478	FLocked := LockTemplateField(FID);
1479	Result := FLocked;
1480	if(not FLocked) then
1481	// ShowMessage('Template Field ' + FFldName + ' is currently being edited by another user.'); <-- original line. //kt 8/8/2007
1482	ShowMessage(DKLangConstW('uTemplateFields_Template_Field')+' ' + FFldName + DKLangConstW('uTemplateFields_is_currently_being_edited_by_another_userx')); //kt added 8/8/2007
1483	end
1484	else
1485	Result := TRUE;
1486	if(Result) then FModified := TRUE;
1487	end;
1488
1489	procedure TTemplateField.SetEditDefault(const Value: string);
1490	begin
1491	if(FEditDefault <> Value) and CanModify then
1492	FEditDefault := Value;
1493	end;
1494
1495	procedure TTemplateField.SetFldName(const Value: string);
1496	begin
1497	if(FFldName <> Value) and CanModify then
1498	begin
1499	FFldName := Value;
1500	FNameChanged := TRUE;
1501	end;
1502	end;
1503
1504	procedure TTemplateField.SetFldType(const Value: TTemplateFieldType);
1505	begin
1506	if(FFldType <> Value) and CanModify then
1507	begin
1508	FFldType := Value;
1509	if(Value = dftEditBox) then
1510	begin
1511	if (FMaxLen < 1) then
1512	FMaxLen := 1;
1513	if FTextLen < FMaxLen then
1514	FTextLen := FMaxLen;
1515	end
1516	else
1517	if(Value = dftHyperlink) and (FURL = '') then
1518	FURL := 'http://'
1519	else
1520	if(Value = dftComboBox) and (FMaxLen < 1) then
1521	begin
1522	FMaxLen := Width;
1523	if FMaxLen < 1 then
1524	FMaxLen := 1;
1525	end
1526	else
1527	if(Value = dftWP) then
1528	begin
1529	if (FMaxLen = 0) then
1530	FMaxLen := MAX_ENTRY_WIDTH
1531	else
1532	if (FMaxLen < 5) then
1533	FMaxLen := 5;
1534	if FTextLen < 2 then
1535	FTextLen := 2;
1536	end
1537	else
1538	if(Value = dftDate) and (FDateType = dtUnknown) then
1539	FDateType := dtDate;
1540	end;
1541	end;
1542
1543	procedure TTemplateField.SetID(const Value: string);
1544	begin
1545	// if(FID <> Value) and CanModify then
1546	FID := Value;
1547	end;
1548
1549	procedure TTemplateField.SetInactive(const Value: boolean);
1550	begin
1551	if(FInactive <> Value) and CanModify then
1552	FInactive := Value;
1553	end;
1554
1555	procedure TTemplateField.SetItemDefault(const Value: string);
1556	begin
1557	if(FItemDefault <> Value) and CanModify then
1558	FItemDefault := Value;
1559	end;
1560
1561	procedure TTemplateField.SetItems(const Value: string);
1562	begin
1563	if(FItems <> Value) and CanModify then
1564	FItems := Value;
1565	end;
1566
1567	procedure TTemplateField.SetLMText(const Value: string);
1568	begin
1569	if(FLMText <> Value) and CanModify then
1570	FLMText := Value;
1571	end;
1572
1573	procedure TTemplateField.SetMaxLen(const Value: integer);
1574	begin
1575	if(FMaxLen <> Value) and CanModify then
1576	FMaxLen := Value;
1577	end;
1578
1579	procedure TTemplateField.SetNotes(const Value: string);
1580	begin
1581	if(FNotes <> Value) and CanModify then
1582	FNotes := Value;
1583	end;
1584
1585	function TTemplateField.SaveError: string;
1586	var
1587	TmpSL, FldSL: TStringList;
1588	AID,Res: string;
1589	idx, i: integer;
1590	IEN64: Int64;
1591	NewRec: boolean;
1592
1593	begin
1594	if(FFldName = NewTemplateField) then
1595	begin
1596	// Result := 'Template Field can not be named "' + NewTemplateField + '"'; <-- original line. //kt 8/8/2007
1597	Result := DKLangConstW('uTemplateFields_Template_Field_can_not_be_named_x') + NewTemplateField + '"'; //kt added 8/8/2007
1598	exit;
1599	end;
1600	Result := '';
1601	NewRec := (StrToIntDef(FID,0) < 0);
1602	if(FModified or NewRec) then
1603	begin
1604	TmpSL := TStringList.Create;
1605	try
1606	FldSL := TStringList.Create;
1607	try
1608	if(StrToIntDef(FID,0) > 0) then
1609	AID := FID
1610	else
1611	AID := '0';
1612	FldSL.Add('.01='+FFldName);
1613	FldSL.Add('.02='+TemplateFieldTypeCodes[FFldType]);
1614	FldSL.Add('.03='+BOOLCHAR[FInactive]);
1615	FldSL.Add('.04='+IntToStr(FMaxLen));
1616	FldSL.Add('.05='+FEditDefault);
1617	FldSL.Add('.06='+FLMText);
1618	idx := -1;
1619	if(FItems <> '') and (FItemDefault <> '') then
1620	begin
1621	TmpSL.Text := FItems;
1622	for i := 0 to TmpSL.Count-1 do
1623	if(FItemDefault = TmpSL[i]) then
1624	begin
1625	idx := i;
1626	break;
1627	end;
1628	end;
1629	FldSL.Add('.07='+IntToStr(Idx+1));
1630	FldSL.Add('.08='+BOOLCHAR[fRequired]);
1631	FldSL.Add('.09='+BOOLCHAR[fSepLines]);
1632	FldSL.Add('.1=' +IntToStr(FTextLen));
1633	FldSL.Add('.11='+IntToStr(FIndent));
1634	FldSL.Add('.12='+IntToStr(FPad));
1635	FldSL.Add('.13='+IntToStr(FMinVal));
1636	FldSL.Add('.14='+IntToStr(FMaxVal));
1637	FldSL.Add('.15='+IntToStr(FIncrement));
1638	if FDateType = dtUnknown then
1639	FldSL.Add('.16=@')
1640	else
1641	FldSL.Add('.16='+TemplateFieldDateCodes[FDateType]);
1642
1643	if FURL='' then
1644	FldSL.Add('3=@')
1645	else
1646	FldSL.Add('3='+FURL);
1647
1648	if(FNotes <> '') or (not NewRec) then
1649	begin
1650	if(FNotes = '') then
1651	FldSL.Add('2,1=@')
1652	else
1653	begin
1654	TmpSL.Text := FNotes;
1655	for i := 0 to TmpSL.Count-1 do
1656	FldSL.Add('2,'+IntToStr(i+1)+',0='+TmpSL[i]);
1657	end;
1658	end;
1659	if((FItems <> '') or (not NewRec)) then
1660	begin
1661	if(FItems = '') then
1662	FldSL.Add('10,1=@')
1663	else
1664	begin
1665	TmpSL.Text := FItems;
1666	for i := 0 to TmpSL.Count-1 do
1667	FldSL.Add('10,'+IntToStr(i+1)+',0='+TmpSL[i]);
1668	end;
1669	end;
1670
1671	Res := UpdateTemplateField(AID, FldSL);
1672	IEN64 := StrToInt64Def(Piece(Res,U,1),0);
1673	if(IEN64 > 0) then
1674	begin
1675	if(NewRec) then
1676	FID := IntToStr(IEN64)
1677	else
1678	UnlockTemplateField(FID);
1679	FModified := FALSE;
1680	FNameChanged := FALSE;
1681	FLocked := FALSE;
1682	end
1683	else
1684	Result := Piece(Res, U, 2);
1685	finally
1686	FldSL.Free;
1687	end;
1688	finally
1689	TmpSL.Free;
1690	end;
1691	end;
1692	end;
1693
1694	procedure TTemplateField.Assign(AFld: TTemplateField);
1695	begin
1696	FMaxLen := AFld.FMaxLen;
1697	FFldName := AFld.FFldName;
1698	FLMText := AFld.FLMText;
1699	FEditDefault := AFld.FEditDefault;
1700	FNotes := AFld.FNotes;
1701	FItems := AFld.FItems;
1702	FInactive := AFld.FInactive;
1703	FItemDefault := AFld.FItemDefault;
1704	FFldType := AFld.FFldType;
1705	FRequired := AFld.FRequired;
1706	FSepLines := AFld.FSepLines;
1707	FTextLen := AFld.FTextLen;
1708	FIndent := AFld.FIndent;
1709	FPad := AFld.FPad;
1710	FMinVal := AFld.FMinVal;
1711	FMaxVal := AFld.FMaxVal;
1712	FIncrement := AFld.FIncrement;
1713	FDateType := AFld.FDateType;
1714	FURL := AFld.FURL;
1715	end;
1716
1717	function TTemplateField.Width: integer;
1718	var
1719	i, ilen: integer;
1720	TmpSL: TStringList;
1721
1722	begin
1723	if(FFldType = dftEditBox) then
1724	Result := FMaxLen
1725	else
1726	begin
1727	if FMaxLen > 0 then
1728	Result := FMaxLen
1729	else
1730	begin
1731	Result := -1;
1732	TmpSL := TStringList.Create;
1733	try
1734	TmpSL.Text := StripEmbedded(FItems);
1735	for i := 0 to TmpSL.Count-1 do
1736	begin
1737	ilen := length(TmpSL[i]);
1738	if(Result < ilen) then
1739	Result := ilen;
1740	end;
1741	finally
1742	TmpSL.Free;
1743	end;
1744	end;
1745	end;
1746	if Result > MaxTFEdtLen then
1747	Result := MaxTFEdtLen;
1748	end;
1749
1750	destructor TTemplateField.Destroy;
1751	begin
1752	uTmplFlds.Remove(Self);
1753	inherited;
1754	end;
1755
1756	procedure TTemplateField.SetRequired(const Value: boolean);
1757	begin
1758	if(FRequired <> Value) and CanModify then
1759	FRequired := Value;
1760	end;
1761
1762	function TTemplateField.NewField: boolean;
1763	begin
1764	Result := (StrToIntDef(FID,0) <= 0);
1765	end;
1766
1767	procedure TTemplateField.SetSepLines(const Value: boolean);
1768	begin
1769	if(FSepLines <> Value) and CanModify then
1770	FSepLines := Value
1771	end;
1772
1773	procedure TTemplateField.SetIncrement(const Value: integer);
1774	begin
1775	if(FIncrement <> Value) and CanModify then
1776	FIncrement := Value;
1777	end;
1778
1779	procedure TTemplateField.SetIndent(const Value: integer);
1780	begin
1781	if(FIndent <> Value) and CanModify then
1782	FIndent := Value;
1783	end;
1784
1785	procedure TTemplateField.SetMaxVal(const Value: integer);
1786	begin
1787	if(FMaxVal <> Value) and CanModify then
1788	FMaxVal := Value;
1789	end;
1790
1791	procedure TTemplateField.SetMinVal(const Value: integer);
1792	begin
1793	if(FMinVal <> Value) and CanModify then
1794	FMinVal := Value;
1795	end;
1796
1797	procedure TTemplateField.SetPad(const Value: integer);
1798	begin
1799	if(FPad <> Value) and CanModify then
1800	FPad := Value;
1801	end;
1802
1803	procedure TTemplateField.SetTextLen(const Value: integer);
1804	begin
1805	if(FTextLen <> Value) and CanModify then
1806	FTextLen := Value;
1807	end;
1808
1809	procedure TTemplateField.SetURL(const Value: string);
1810	begin
1811	if(FURL <> Value) and CanModify then
1812	FURL := Value;
1813	end;
1814
1815	function TTemplateField.GetRequired: boolean;
1816	begin
1817	if FFldType in NoRequired then
1818	Result := FALSE
1819	else
1820	Result := FRequired;
1821	end;
1822
1823	procedure TTemplateField.SetDateType(const Value: TTmplFldDateType);
1824	begin
1825	if(FDateType <> Value) and CanModify then
1826	FDateType := Value;
1827	end;
1828
1829	{ TTemplateDialogEntry }
1830	const
1831	EOL_MARKER = #182;
1832
1833	procedure PanelDestroy(AData: Pointer; Sender: TObject);
1834	var
1835	idx: integer;
1836	dlg: TTemplateDialogEntry;
1837
1838	begin
1839	dlg := TTemplateDialogEntry(AData);
1840	idx := uEntries.IndexOf(dlg.FID);
1841	if(idx >= 0) then
1842	uEntries.Delete(idx);
1843	dlg.FPanelDying := TRUE;
1844	dlg.Free;
1845	end;
1846
1847	constructor TTemplateDialogEntry.Create(AParent: TWinControl; AID, Text: string);
1848	var
1849	CtrlID, idx, i, j, flen: integer;
1850	txt, FldName: string;
1851	Fld: TTemplateField;
1852
1853	begin
1854	FID := AID;
1855	FText := Text;
1856	FHTMLMode := false; //kt added 12/28/09
1857	FControls := TStringList.Create;
1858	FIndents := TStringList.Create;
1859	FFont := TFont.Create;
1860	FFont.Assign(TORExposedControl(AParent).Font);
1861	FControls.Text := Text;
1862	if(FControls.Count > 1) then
1863	for i := 1 to FControls.Count-1 do
1864	FControls[i] := EOL_MARKER + FControls[i];
1865	FFirstBuild := TRUE;
1866	FPanel := TFieldPanel.Create(AParent.Owner);
1867	FPanel.Parent := AParent;
1868	FPanel.BevelOuter := bvNone;
1869	FPanel.Caption := '';
1870	FPanel.Font.Assign(FFont);
1871	idx := 0;
1872	while (idx < FControls.Count) do
1873	begin
1874	txt := FControls[idx];
1875	i := pos(TemplateFieldBeginSignature, txt);
1876	if(i > 0) then
1877	begin
1878	if(copy(txt, i + TemplateFieldSignatureLen, 1) = FieldIDDelim) then
1879	begin
1880	CtrlID := StrToIntDef(copy(txt, i + TemplateFieldSignatureLen + 1, FieldIDLen-1), 0);
1881	delete(txt,i + TemplateFieldSignatureLen, FieldIDLen);
1882	end
1883	else
1884	CtrlID := 0;
1885	j := pos(TemplateFieldEndSignature, copy(txt, i + TemplateFieldSignatureLen, MaxInt));
1886	if(j > 0) then
1887	begin
1888	inc(j, i + TemplateFieldSignatureLen - 1);
1889	flen := j - i - TemplateFieldSignatureLen;
1890	FldName := copy(txt, i + TemplateFieldSignatureLen, flen);
1891	Fld := GetTemplateField(FldName, FALSE);
1892	delete(txt,i,flen + TemplateFieldSignatureLen + 1);
1893	if(assigned(Fld)) then
1894	begin
1895	FControls[idx] := copy(txt,1,i-1);
1896	if(Fld.Required) then
1897	FControls[idx] := FControls[idx] + '*';
1898	Fld.CreateDialogControls(Self, idx, CtrlID);
1899	FControls.Insert(idx+1,copy(txt,i,MaxInt));
1900	end
1901	else
1902	begin
1903	FControls[idx] := txt;
1904	dec(idx);
1905	end;
1906	end
1907	else
1908	begin
1909	delete(txt,i,TemplateFieldSignatureLen);
1910	FControls[idx] := txt;
1911	dec(idx);
1912	end;
1913	end;
1914	inc(idx);
1915	end;
1916	end;
1917
1918	destructor TTemplateDialogEntry.Destroy;
1919	begin
1920	if assigned(FOnDestroy) then
1921	FOnDestroy(Self);
1922	KillLabels;
1923	KillObj(@FControls, TRUE);
1924	if FPanelDying then
1925	FPanel := nil
1926	else
1927	FreeAndNil(FPanel);
1928	FreeAndNil(FFont);
1929	FreeAndNil(FIndents);
1930	inherited;
1931	end;
1932
1933	procedure TTemplateDialogEntry.DoChange(Sender: TObject);
1934	begin
1935	if (not FUpdating) and assigned(FOnChange) then
1936	FOnChange(Self);
1937	end;
1938
1939	function TTemplateDialogEntry.GetControlText(CtrlID: integer; NoCommas: boolean;
1940	var FoundEntry: boolean; AutoWrap: boolean;
1941	emField: string = ''): string;
1942	var
1943	x, i, j, ind, idx: integer;
1944	Ctrl: TControl;
1945	Done: boolean;
1946	iString: string;
1947	iField: TTemplateField;
1948	iTemp: TStringList;
1949
1950	function GetOriginalItem(istr: string): string;
1951	begin
1952	Result := '';
1953	if emField <> '' then
1954	begin
1955	iField := GetTemplateField(emField,FALSE);
1956	iTemp := nil;
1957	if ifield <> nil then
1958	try
1959	iTemp := TStringList.Create;
1960	iTemp.Text := StripEmbedded(iField.Items);
1961	x := iTemp.IndexOf(istr);
1962	if x >= 0 then
1963	begin
1964	iTemp.Text := iField.Items;
1965	Result := iTemp.Strings[x];
1966	end;
1967	finally
1968	iTemp.Free;
1969	end;
1970	end;
1971	end;
1972
1973
1974	begin
1975	Result := '';
1976	Done := FALSE;
1977	ind := -1;
1978	for i := 0 to FControls.Count-1 do
1979	begin
1980	Ctrl := TControl(FControls.Objects[i]);
1981	if(assigned(Ctrl)) and (Ctrl.Tag = CtrlID) then
1982	begin
1983	FoundEntry := TRUE;
1984	Done := TRUE;
1985	if ind < 0 then
1986	begin
1987	idx := FIndents.IndexOfObject(Ctrl);
1988	if idx >= 0 then
1989	ind := StrToIntDef(Piece(FIndents[idx], U, 2), 0)
1990	else
1991	ind := 0;
1992	end;
1993	if(Ctrl is TFieldLabel) then
1994	begin
1995	if not TFieldLabel(Ctrl).Exclude then begin
1996	if emField <> '' then begin
1997	iField := GetTemplateField(emField,FALSE);
1998	case iField.FldType of
1999	dftHyperlink: if iField.EditDefault <> '' then
2000	Result := iField.EditDefault
2001	else
2002	Result := iField.URL;
2003	dftText: begin
2004	iString := iField.Items;
2005	if copy(iString,length(iString)-1,2) = CRLF then
2006	delete(iString,length(iString)-1,2);
2007	Result := iString;
2008	end;
2009	else {case}
2010	Result := TFieldLabel(Ctrl).Caption
2011	end; {case iField.FldType}
2012	end {if emField}
2013	else
2014	Result := TFieldLabel(Ctrl).Caption;
2015	end;
2016	end
2017	else
2018	if(Ctrl is TEdit) then
2019	Result := TEdit(Ctrl).Text
2020	else
2021	if(Ctrl is TORComboBox) then begin
2022	Result := TORComboBox(Ctrl).Text;
2023	iString := GetOriginalItem(Result);
2024	if iString <> '' then
2025	Result := iString;
2026	end
2027	else
2028	if(Ctrl is TORDateCombo) then
2029	Result := TORDateCombo(Ctrl).Text + ':' + FloatToStr(TORDateCombo(Ctrl).FMDate)
2030	else
2031	if(Ctrl is TORDateBox) then
2032	Result := TORDateBox(Ctrl).Text
2033	else
2034	if(Ctrl is TRichEdit) then
2035	begin
2036	if((ind = 0) and (not AutoWrap)) then
2037	Result := TRichEdit(Ctrl).Lines.Text
2038	else
2039	begin
2040	for j := 0 to TRichEdit(Ctrl).Lines.Count-1 do
2041	begin
2042	if AutoWrap then
2043	begin
2044	if(Result <> '') then
2045	Result := Result + ' ';
2046	Result := Result + TRichEdit(Ctrl).Lines[j];
2047	end
2048	else
2049	begin
2050	if(Result <> '') then
2051	Result := Result + CRLF;
2052	Result := Result + StringOfChar(' ', ind) + TRichEdit(Ctrl).Lines[j];
2053	end;
2054	end;
2055	ind := 0;
2056	end;
2057	end
2058	else
2059	if(Ctrl is TORCheckBox) then
2060	begin
2061	Done := FALSE;
2062	if(TORCheckBox(Ctrl).Checked) then
2063	begin
2064	if(Result <> '') then
2065	begin
2066	if NoCommas then
2067	Result := Result + '\|'
2068	else
2069	Result := Result + ', ';
2070	end;
2071	iString := GetOriginalItem(TORCheckBox(Ctrl).Caption);
2072	if iString <> '' then
2073	Result := Result + iString
2074	else
2075	Result := Result + TORCheckBox(Ctrl).Caption;
2076	end;
2077	end
2078	else
2079	if(Ctrl is TfraTemplateFieldButton) then
2080	begin
2081	Result := TfraTemplateFieldButton(Ctrl).ButtonText;
2082	iString := GetOriginalItem(Result);
2083	if iString <> '' then
2084	Result := iString;
2085	end
2086	else
2087	if(Ctrl is TPanel) then
2088	begin
2089	for j := 0 to Ctrl.ComponentCount-1 do
2090	if Ctrl.Components[j] is TUpDown then
2091	begin
2092	Result := IntToStr(TUpDown(Ctrl.Components[j]).Position);
2093	break;
2094	end;
2095	end;
2096	end;
2097	if Done then break;
2098	end;
2099	if (ind > 0) and (not NoCommas) then
2100	Result := StringOfChar(' ', ind) + Result;
2101	end;
2102
2103	function TTemplateDialogEntry.GetFieldValues: string;
2104	var
2105	i: integer;
2106	Ctrl: TControl;
2107	CtrlID: integer;
2108	TmpIDs: TList;
2109	TmpSL: TStringList;
2110	Dummy: boolean;
2111
2112	begin
2113	Result := '';
2114	TmpIDs := TList.Create;
2115	try
2116	TmpSL := TStringList.Create;
2117	try
2118	for i := 0 to FControls.Count-1 do
2119	begin
2120	Ctrl := TControl(FControls.Objects[i]);
2121	if(assigned(Ctrl)) then
2122	begin
2123	CtrlID := Ctrl.Tag;
2124	if(TmpIDs.IndexOf(Pointer(CtrlID)) < 0) then
2125	begin
2126	TmpSL.Add(IntToStr(CtrlID) + U + GetControlText(CtrlID, TRUE, Dummy, FALSE));
2127	TmpIDs.Add(Pointer(CtrlID));
2128	end;
2129	end;
2130	end;
2131	Result := TmpSL.CommaText;
2132	finally
2133	TmpSL.Free;
2134	end;
2135	finally
2136	TmpIDs.Free;
2137	end;
2138	end;
2139
2140	function TTemplateDialogEntry.GetPanel(MaxLen: integer; AParent: TWinControl): TPanel;
2141	var
2142	i, x, y, cnt, idx, ind, yinc, ybase, MaxX: integer;
2143	MaxTextLen: integer; {Max num of chars per line in pixels}
2144	MaxChars: integer; {Max num of chars per line}
2145	txt: string;
2146	ctrl: TControl;
2147	LastLineBlank: boolean;
2148	const
2149	FOCUS_RECT_MARGIN = 2; {The margin around the panel so the label won't
2150	overlay the focus rect on its parent panel.}
2151	procedure DoLabel(Atxt: string);
2152	var
2153	lbl: TLabel;
2154
2155	begin
2156	lbl := TLabel.Create(nil);
2157	lbl.Parent := FPanel;
2158	lbl.ShowAccelChar := FALSE;
2159	lbl.Caption := Atxt;
2160	lbl.Left := x;
2161	lbl.Top := y;
2162	inc(x, lbl.Width);
2163	end;
2164
2165	procedure NextLine;
2166	begin
2167	if(MaxX < x) then
2168	MaxX := x;
2169	x := FOCUS_RECT_MARGIN; {leave two pixels on the left for the Focus Rect}
2170	inc(y, yinc);
2171	yinc := ybase;
2172	end;
2173
2174	begin
2175	MaxTextLen := MaxLen - (FOCUS_RECT_MARGIN * 2);{save room for the focus rectangle on the panel}
2176	if(FFirstBuild or (FPanel.Width <> MaxLen)) then
2177	begin
2178	if(FFirstBuild) then
2179	FFirstBuild := FALSE
2180	else
2181	KillLabels;
2182	y := FOCUS_RECT_MARGIN; {placement of labels on panel so they don't cover the}
2183	x := FOCUS_RECT_MARGIN; {focus rectangle}
2184	MaxX := 0;
2185	//ybase := FontHeightPixel(FFont.Handle) + 1 + (FOCUS_RECT_MARGIN * 2); AGP commentout line for
2186	//reminder spacing
2187	ybase := FontHeightPixel(FFont.Handle);
2188	yinc := ybase;
2189	LastLineBlank := FALSE;
2190	for i := 0 to FControls.Count-1 do
2191	begin
2192	txt := FControls[i];
2193	if(copy(txt,1,1) = EOL_MARKER) then
2194	begin
2195	if((x <> 0) or LastLineBlank) then
2196	NextLine;
2197	delete(txt,1,1);
2198	LastLineBlank := (txt = '');
2199	end;
2200	if(txt <> '') then
2201	begin
2202	while(txt <> '') do
2203	begin
2204	cnt := NumCharsFitInWidth(FFont.Handle, txt, MaxTextLen-x);
2205	MaxChars := cnt;
2206	if(cnt >= length(txt)) then
2207	begin
2208	DoLabel(txt);
2209	txt := '';
2210	end
2211	else
2212	if(cnt < 1) then
2213	NextLine
2214	else
2215	begin
2216	repeat
2217	if(txt[cnt+1] = ' ') then
2218	begin
2219	DoLabel(copy(txt,1,cnt));
2220	NextLine;
2221	txt := copy(txt, cnt + 1, MaxInt);
2222	break;
2223	end
2224	else
2225	dec(cnt);
2226	until(cnt = 0);
2227	if(cnt = 0) then
2228	begin
2229	if(x = FOCUS_RECT_MARGIN) then {If x is at the far left margin...}
2230	begin
2231	DoLabel(Copy(txt,1,MaxChars));
2232	NextLine;
2233	txt := copy(txt, MaxChars + 1, MaxInt);
2234	end
2235	else
2236	NextLine;
2237	end;
2238	end;
2239	end;
2240	end
2241	else
2242	begin
2243	ctrl := TControl(FControls.Objects[i]);
2244	if(assigned(ctrl)) then
2245	begin
2246	idx := FIndents.IndexOfObject(Ctrl);
2247	if idx >= 0 then
2248	ind := StrToIntDef(Piece(FIndents[idx], U, 1), 0)
2249	else
2250	ind := 0;
2251	if(x > 0) then
2252	begin
2253	if (x < MaxLen) and (Ctrl is TORCheckBox) and (TORCheckBox(Ctrl).StringData = NewLine) then
2254	x := MaxLen;
2255	if((ctrl.Width + x + ind) > MaxLen) then
2256	NextLine;
2257	end;
2258	inc(x,ind);
2259	Ctrl.Left := x;
2260	Ctrl.Top := y;
2261	inc(x, Ctrl.Width + 4);
2262	if yinc <= Ctrl.Height then
2263	yinc := Ctrl.Height + 1;
2264	if (x < MaxLen) and ((Ctrl is TRichEdit) or
2265	((Ctrl is TLabel) and (pos(CRLF, TLabel(Ctrl).Caption) > 0))) then
2266	x := MaxLen;
2267	end;
2268	end;
2269	end;
2270	NextLine;
2271	FPanel.Height := (y-1) + (FOCUS_RECT_MARGIN * 2); //AGP added Focus_rect_margin for Reminder spacing
2272	FPanel.Width := MaxX + FOCUS_RECT_MARGIN;
2273	end;
2274	if(FFieldValues <> '') then
2275	SetFieldValues(FFieldValues);
2276	Result := FPanel;
2277	end;
2278
2279	procedure TTemplateDialogEntry.SetAnswerHTMLTag(Value : string);
2280	//kt 12/28/09 Added entire function
2281	begin
2282	if Value='' then begin
2283	FAnswerOpenTag :='';
2284	FAnswerCloseTag := '';
2285	end else begin
2286	if Pos('<',Value)>0 then Value := Piece(Value,'<',2);
2287	if Pos('>',Value)>0 then Value := Piece(Value,'>',1);
2288	FAnswerOpenTag :='<'+Value+'>';
2289	FAnswerCloseTag := '</' + Value + '>';
2290	end;
2291	end;
2292
2293	function TTemplateDialogEntry.GetText: string;
2294	begin
2295	//kt Result := ResolveTemplateFields(FText, FALSE);
2296	Result := ResolveTemplateFields(FText, FALSE, FALSE, FALSE, FHTMLMode, FAnswerOpenTag, FAnswerCloseTag); //kt 12/29/09
2297	end;
2298
2299	procedure TTemplateDialogEntry.KillLabels;
2300	var
2301	i, idx: integer;
2302	obj: TObject;
2303
2304	begin
2305	if(assigned(FPanel)) then
2306	begin
2307	for i := FPanel.ControlCount-1 downto 0 do
2308	if(FPanel.Controls[i] is TLabel) then
2309	begin
2310	obj := FPanel.Controls[i];
2311	idx := FControls.IndexOfObject(obj);
2312	if idx < 0 then
2313	obj.Free;
2314	end;
2315	end;
2316	end;
2317
2318	procedure TTemplateDialogEntry.SetAutoDestroyOnPanelFree(
2319	const Value: boolean);
2320	var
2321	M: TMethod;
2322
2323	begin
2324	FAutoDestroyOnPanelFree := Value;
2325	if(Value) then
2326	begin
2327	M.Data := Self;
2328	M.Code := @PanelDestroy;
2329	TFieldPanel(FPanel).OnDestroy := TNotifyEvent(M);
2330	end
2331	else
2332	TFieldPanel(FPanel).OnDestroy := nil;
2333	end;
2334
2335	procedure TTemplateDialogEntry.SetControlText(CtrlID: integer; AText: string);
2336	var
2337	cnt, i, j: integer;
2338	Ctrl: TControl;
2339	Done: boolean;
2340
2341	begin
2342	FUpdating := TRUE;
2343	try
2344	Done := FALSE;
2345	cnt := 0;
2346	for i := 0 to FControls.Count-1 do
2347	begin
2348	Ctrl := TControl(FControls.Objects[i]);
2349	if(assigned(Ctrl)) and (Ctrl.Tag = CtrlID) then
2350	begin
2351	Done := TRUE;
2352	if(Ctrl is TLabel) then
2353	TLabel(Ctrl).Caption := AText
2354	else
2355	if(Ctrl is TEdit) then
2356	TEdit(Ctrl).Text := AText
2357	else
2358	if(Ctrl is TORComboBox) then
2359	TORComboBox(Ctrl).SelectByID(AText)
2360	else
2361	if(Ctrl is TRichEdit) then
2362	TRichEdit(Ctrl).Lines.Text := AText
2363	else
2364	if(Ctrl is TORDateCombo) then
2365	TORDateCombo(Ctrl).FMDate := MakeFMDateTime(piece(AText,':',2))
2366	else
2367	if(Ctrl is TORDateBox) then
2368	TORDateBox(Ctrl).Text := AText
2369	else
2370	if(Ctrl is TORCheckBox) then
2371	begin
2372	Done := FALSE;
2373	if(cnt = 0) then
2374	cnt := DelimCount(AText, '\|') + 1;
2375	for j := 1 to cnt do
2376	begin
2377	if(TORCheckBox(Ctrl).Caption = piece(AText,'\|',j)) then
2378	TORCheckBox(Ctrl).Checked := TRUE;
2379	end;
2380	end
2381	else
2382	if(Ctrl is TfraTemplateFieldButton) then
2383	TfraTemplateFieldButton(Ctrl).ButtonText := AText
2384	else
2385	if(Ctrl is TPanel) then
2386	begin
2387	for j := 0 to Ctrl.ComponentCount-1 do
2388	if Ctrl.Components[j] is TUpDown then
2389	begin
2390	TUpDown(Ctrl.Components[j]).Position := StrToIntDef(AText,0);
2391	break;
2392	end;
2393	end;
2394	end;
2395	if Done then break;
2396	end;
2397	finally
2398	FUpdating := FALSE;
2399	end;
2400	end;
2401
2402	procedure TTemplateDialogEntry.SetFieldValues(const Value: string);
2403	var
2404	i: integer;
2405	TmpSL: TStringList;
2406
2407	begin
2408	FFieldValues := Value;
2409	TmpSL := TStringList.Create;
2410	try
2411	TmpSL.CommaText := Value;
2412	for i := 0 to TmpSL.Count-1 do
2413	SetControlText(StrToIntDef(Piece(TmpSL[i], U, 1), 0), Piece(TmpSL[i], U, 2));
2414	finally
2415	TmpSL.Free;
2416	end;
2417	end;
2418
2419	procedure TTemplateDialogEntry.UpDownChange(Sender: TObject);
2420	begin
2421	EnsureText(TEdit(Sender), TUpDown(TEdit(Sender).Tag));
2422	DoChange(Sender);
2423	end;
2424
2425	{ TFieldPanel }
2426
2427	destructor TFieldPanel.Destroy;
2428	begin
2429	if(assigned(FOnDestroy)) then
2430	FOnDestroy(Self);
2431	inherited;
2432	end;
2433
2434	{intercept the paint event to draw the focus rect if FFocused is true}
2435	function TFieldPanel.GetFocus: boolean;
2436	begin
2437	result := Focused;
2438	end;
2439
2440	procedure TFieldPanel.Paint;
2441	var
2442	DC: HDC;
2443	R: TRect;
2444
2445	begin
2446	inherited;
2447	if(Focused) then
2448	begin
2449	if(not assigned(FCanvas)) then
2450	FCanvas := TControlCanvas.Create;
2451	DC := GetWindowDC(Handle);
2452	try
2453	FCanvas.Handle := DC;
2454	R := ClientRect;
2455	InflateRect(R, -1, -1);
2456	FCanvas.DrawFocusRect(R);
2457	finally
2458	ReleaseDC(Handle, DC);
2459	end;
2460	end;
2461	end;
2462
2463	procedure TFieldPanel.SetTheFocus(const Value: boolean);
2464	begin
2465	if Value then
2466	SetFocus;
2467	end;
2468
2469	{ TWebLabel }
2470
2471	procedure TWebLabel.Clicked(Sender: TObject);
2472	begin
2473	GotoWebPage(FAddr);
2474	end;
2475
2476	procedure TWebLabel.Init(Addr: string);
2477	begin
2478	FAddr := Addr;
2479	OnClick := Clicked;
2480	Font.Assign(TORExposedControl(Parent).Font);
2481	Font.Color := clActiveCaption;
2482	Font.Style := Font.Style + [fsUnderline];
2483	AdjustBounds; // make sure we have the right width
2484	AutoSize := FALSE;
2485	Height := Height + 1; // Courier New doesn't support underline unless it's higher
2486	Cursor := crHandPoint;
2487	end;
2488
2489	function StripEmbedded(iItems: string): string;
2490	{7/26/01 S Monson
2491	Returns the field will all embedded fields removed}
2492	var
2493	p1, p2, icur: integer;
2494	Begin
2495	p1 := pos(TemplateFieldBeginSignature,iItems);
2496	icur := 0;
2497	while p1 > 0 do
2498	begin
2499	p2 := pos(TemplateFieldEndSignature,copy(iItems,icur+p1+TemplateFieldSignatureLen,maxint));
2500	if p2 > 0 then
2501	begin
2502	delete(iItems,p1+icur,TemplateFieldSignatureLen+p2+TemplateFieldSignatureEndLen-1);
2503	icur := icur + p1 - 1;
2504	p1 := pos(TemplateFieldBeginSignature,copy(iItems,icur+1,maxint));
2505	end
2506	else
2507	p1 := 0;
2508	end;
2509	Result := iItems;
2510	end;
2511
2512	initialization
2513
2514	finalization
2515	KillObj(@uTmplFlds, TRUE);
2516	KillObj(@uEntries, TRUE);
2517
2518	end.

Note: See TracBrowser for help on using the repository browser.

Download in other formats: