Context Navigation

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

Last change on this file since 654 was 654, checked in by Kevin Toppenberg, 14 years ago
Added HTML templating
File size: 76.4 KB

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

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

Download in other formats: